From b8f356b0f9492f8a32bc1951b3b598e3ec1e9d4e Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 15 Jun 2013 09:31:31 +0000
Subject: 	* interp/define.boot (makeCategoryPredicates): Tidy.  Adjust
 caller.

---
 src/ChangeLog          |  4 ++++
 src/interp/define.boot | 32 +++++++++++++++-----------------
 2 files changed, 19 insertions(+), 17 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index 4ff70a94..8ebe7f45 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,7 @@
+2013-06-15  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
+	* interp/define.boot (makeCategoryPredicates): Tidy.  Adjust caller.
+
 2013-06-14  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* interp/c-util.boot (extendsCategoryForm): Take a DB parameter.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index a17f8aa8..84c502b5 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -995,29 +995,27 @@ compDefineCategory1(db,df is ['DEF,form,sig,body],m,e,fal) ==
   [d,m,e]:= compDefineCategory2(db,form,sig,body,m,e,fal)
   if not skipCategoryPackage? categoryCapsule then [.,.,e] :=
     $insideCategoryPackageIfTrue: local := true
-    $categoryPredicateList: local := makeCategoryPredicates(form,dbCategory db)
+    $categoryPredicateList: local := makeCategoryPredicates db
     defaults := mkCategoryPackage(form,cat,categoryCapsule)
     T := compDefine1(nil,defaults,$EmptyMode,e)
            or return stackSemanticError(
                         ['"cannot compile defaults of",:bright opOf form],nil)
   [d,m,e]
 
-makeCategoryPredicates(form,u) ==
-      $tvl: local := take(#rest form,$TriangleVariableList)
-      $mvl: local := take(#rest form,rest $FormalMapVariableList)
-      fn(u,nil) where
-        fn(u,pl) ==
-          u is ['Join,:.,a] => fn(a,pl)
-          u is ["IF",p,:x] =>
-            fnl(x,insert(applySubst(pairList($tvl,$mvl),p),pl))
-          u is ["has",:.] =>
-            insert(applySubst(pairList($tvl,$mvl),u),pl)
-          u is [op,:.] and op in '(SIGNATURE ATTRIBUTE) => pl
-          u isnt [.,:.] => pl
-          fnl(u,pl)
-        fnl(u,pl) ==
-          for x in u repeat pl := fn(x,pl)
-          pl
+makeCategoryPredicates db ==
+  n := dbArity db
+  sl := pairList(take(n,$TriangleVariableList),take(n,rest $FormalMapVariableList))
+  fn(dbCategory db,sl,nil) where
+    fn(u,sl,pl) ==
+      u is ['Join,:.,a] => fn(a,sl,pl)
+      u is ["IF",p,:x] => fnl(x,sl,insert(applySubst(sl,p),pl))
+      u is ["has",:.] => insert(applySubst(sl,u),pl)
+      u is [op,:.] and op in '(SIGNATURE ATTRIBUTE) => pl
+      u isnt [.,:.] => pl
+      fnl(u,sl,pl)
+    fnl(u,sl,pl) ==
+      for x in u repeat pl := fn(x,sl,pl)
+      pl
  
 ++ Subroutine of mkCategoryPackage.
 ++ Return a category-level declaration of an operation described by `desc'.
-- 
cgit v1.2.3