aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/br-data.boot27
-rw-r--r--src/interp/define.boot34
3 files changed, 32 insertions, 37 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 58ed0d29..4f5bee7c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
2012-02-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/define.boot (getParentsFor): Lose second parameter. Tidy.
+ Adjust callers.
+ * interp/br-data.boot (getParentsForDomain): Remove.
+ (parentsOf): Call getParentsFor in lieu of getParentsForDomain.
+ (folks): Move to define.boot.
+
+2012-02-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/br-data.boot (ancestorsRecur): Tidy.
* interp/define.boot (compDefineCategory2): Likewise.
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 8d87ac04..26ca4f08 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -500,7 +500,7 @@ parentsOf con == --called by kcpPage, ancestorsRecur
if null $parentsCache then
$parentsCache := hashTable 'EQ
tableValue($parentsCache,con) or
- parents := getParentsForDomain con
+ parents := getParentsFor loadDBIfNecessary constructorDB con
tableValue($parentsCache,con) := parents
parents
@@ -510,31 +510,6 @@ parentsOfForm [op,:argl] ==
parents
applySubst(pairList(newArgl,argl),parents)
-getParentsForDomain domname == --called by parentsOf
- acc := nil
- for x in folks getConstructorCategory domname repeat
- x :=
- getConstructorKindFromDB domname = "category" =>
- sublisFormal(IFCDR getConstructorForm domname,x,$TriangleVariableList)
- sublisFormal(IFCDR getConstructorForm domname,x)
- acc := [:explodeIfs x,:acc]
- reverse! acc
-
-folks u == --called by getParents and getParentsForDomain
- u isnt [.,:.] => nil
- u is [op,:v] and op in '(Join PROGN)
- or u is ['CATEGORY,.,:v] => "append"/[folks x for x in v]
- u is ['SIGNATURE,:.] => nil
- u is ['ATTRIBUTE,a] =>
- a is [.,:.] and constructor? a.op => folks a
- nil
- u is ['IF,p,q,r] =>
- q1 := folks q
- r1 := folks r
- q1 or r1 => [['IF,p,q1,r1]]
- nil
- [u]
-
descendantsOf(conform,domform) == --called by kcdPage
"category" = getConstructorKindFromDB(conname := opOf conform) =>
cats := catsOf(conform,domform)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 0d3df568..f050037d 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -630,7 +630,22 @@ expandTypeArgs(u,template,domform) ==
u isnt [.,:.] => u
expandType(u,template,domform)
-explodeIfs x == main where --called by getParents, getParentsForDomain
+folks u == --called by getParentsFor
+ u isnt [.,:.] => nil
+ u is [op,:v] and op in '(Join PROGN)
+ or u is ['CATEGORY,.,:v] => "append"/[folks x for x in v]
+ u is ['SIGNATURE,:.] => nil
+ u is ['ATTRIBUTE,a] =>
+ a is [.,:.] and constructor? a.op => folks a
+ nil
+ u is ['IF,p,q,r] =>
+ q1 := folks q
+ r1 := folks r
+ q1 or r1 => [['IF,p,q1,r1]]
+ nil
+ [u]
+
+explodeIfs x == main where --called by getParentsFor
main() ==
x is ['IF,p,a,b] => fn(p,a,b)
[[x,:true]]
@@ -640,15 +655,12 @@ explodeIfs x == main where --called by getParents, getParentsForDomain
a is ['IF,q,b,:.] => fn(MKPF([p,q],'AND),b,nil)
[[a,:p]]
-getParentsFor(db,formalParams) ==
- acc := nil
- formals := take(#formalParams,$TriangleVariableList)
+getParentsFor db ==
constructorForm := dbConstructorForm db
- for x in folks dbCategory db repeat
- x := applySubst(pairList(formals,formalParams),x)
- x := applySubst(pairList(formalParams,constructorForm.args),x)
- acc := [:explodeIfs x,:acc]
- reverse! acc
+ n := #constructorForm.args
+ s1 := pairList(take(n,$TriangleVariableList),$FormalMapVariableList)
+ s2 := pairList($FormalMapVariableList,constructorForm.args)
+ [:explodeIfs applySubst(s2,applySubst(s1,x)) for x in folks dbCategory db]
--% Subdomains
@@ -1151,7 +1163,7 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) ==
$domainShell := eval [op',:[MKQ f for f in sargl]]
dbConstructorModemap(db) :=
[[parForm,:parSignature],[buildConstructorCondition db,$op]]
- dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList)
+ dbPrincipals(db) := getParentsFor db
dbAncestors(db) := computeAncestorsOf(form,nil)
dbModemaps(db) := modemapsFromCategory(db,[op',:sargl],formalBody,signature')
dbCompilerData(db) := nil
@@ -1487,7 +1499,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
reportOnFunctorCompilation()
-- 5.
- dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList)
+ dbPrincipals(db) := getParentsFor db
dbAncestors(db) := computeAncestorsOf($form,nil)
$insideFunctorIfTrue:= false
if not $bootStrapMode then