aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2013-06-15 09:31:31 +0000
committerdos-reis <gdr@axiomatics.org>2013-06-15 09:31:31 +0000
commitb8f356b0f9492f8a32bc1951b3b598e3ec1e9d4e (patch)
tree2275d4ea5ed7adb653835fd075775bd28e69b3aa /src/interp
parent11b080192468670b9b1a8f5cf9d5ff890195a3f2 (diff)
downloadopen-axiom-b8f356b0f9492f8a32bc1951b3b598e3ec1e9d4e.tar.gz
* interp/define.boot (makeCategoryPredicates): Tidy. Adjust caller.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/define.boot32
1 files changed, 15 insertions, 17 deletions
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'.