aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog4
-rw-r--r--src/interp/define.boot32
2 files changed, 19 insertions, 17 deletions
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'.