aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-09-07 16:07:42 +0000
committerdos-reis <gdr@axiomatics.org>2011-09-07 16:07:42 +0000
commit88c6450a9068d951752e06f5ee40d63de1e95fd8 (patch)
tree2f8d3f6bc7cb5dca9151ce51363e3cbaf6691d38 /src/interp
parent80e53e21c3d0f18791ca5a4905217c1f89aa90f1 (diff)
downloadopen-axiom-88c6450a9068d951752e06f5ee40d63de1e95fd8.tar.gz
* interp/nruncomp.boot (NRTaddInner): Use the dual signature.
* interp/lisplib.boot (writeDualSignature): New. (finalizeLisplib): Likewise. * interp/define.boot (compDefineCategory2): Compute dual signature. (compDefineFunctor1): Likewise. * interp/daase.lisp (LOCALNRLIB): Juts read dual signature info; don't compute it.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot3
-rw-r--r--src/interp/daase.lisp3
-rw-r--r--src/interp/define.boot9
-rw-r--r--src/interp/lisplib.boot5
-rw-r--r--src/interp/nruncomp.boot6
5 files changed, 17 insertions, 9 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index f835a531..be49e6fc 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -802,8 +802,7 @@ isSubset(x,y,e) ==
-- Expand domain representation form
x is 'Rep and not $useRepresentationHack =>
isSubset(getRepresentation e,y,e)
- -- x is '$ and get(x,'%domain,e) = y => true
- y is '$ and get(y,'%domain,e) = x => true
+ y is '$ and get(y,'%form,e) = x => true
-- Or, if x has the Subsets property set by SubsetCategory.
pred := LASSOC(opOf x,get(opOf y,"Subsets",e)) => pred
-- Or, they are related by subdomain chain.
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index f017756e..cd43e7d8 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1124,8 +1124,7 @@
(if |$InteractiveMode|
(setq |$CategoryFrame| |$EmptyEnvironment|)))
(setf (|dbDualSignature| dbstruct)
- (cons nil (mapcar #'|categoryForm?|
- (cddar (|dbConstructorModemap| dbstruct)))))
+ (fetchdata alist in "dualSignature"))
(setf (|dbLoadPath| (|constructorDB| key)) nil)
(if (null noexpose)
(|setExposeAddConstr| (cons key nil)))
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 958f8101..81a9e6d9 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1051,7 +1051,10 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
-- 6. put modemaps into InteractiveModemapFrame
$domainShell := eval [op',:[MKQ f for f in sargl]]
- dbConstructorModemap(constructorDB op') := [[parForm,:parSignature],[true,op']]
+ dbConstructorModemap(db) := [[parForm,:parSignature],[true,$op]]
+ dbDualSignature(db) :=
+ [isCategoryForm(t,e) for t in dbConstructorModemap(db).mmSource]
+ dbDualSignature(db) := [true,:dbDualSignature db]
$lisplibCategory:= formalBody
dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList,$lisplibCategory)
dbAncestors(db) := computeAncestorsOf($form,nil)
@@ -1373,7 +1376,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
[.,.,$e] := compMakeDeclaration("$",target,$e)
if not $insideCategoryPackageIfTrue then
$e := augModemapsFromCategory('_$,'_$,target,$e)
- $e := put('$,'%domain,form,$e)
+ $e := put('$,'%form,form,$e)
$signature:= signature'
parSignature:= applySubst($pairlis,signature')
parForm:= applySubst($pairlis,form)
@@ -1381,6 +1384,8 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
-- 3. give operator a 'modemap property
modemap := [[parForm,:parSignature],[true,$op]]
dbConstructorModemap(db) := modemap
+ dbDualSignature(db) := [isCategoryForm(t,$e) for t in modemap.mmSource]
+ dbDualSignature(db) := [false,:dbDualSignature db]
-- (3.1) now make a list of the functor's local parameters; for
-- domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 598304a8..b992cc6c 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -560,6 +560,10 @@ writeAttributes(ctor,ats,file) ==
writeConstructorModemap(ctor,mm,file) ==
writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
+writeDualSignature(db,file) ==
+ writeInfo(dbConstructor db,dbDualSignature db,
+ 'dualSignature,'dbDualSignature,file)
+
writeAncestors(ctor,x,file) ==
writeInfo(ctor,x,'ancestors,'dbAncestors,file)
@@ -583,6 +587,7 @@ finalizeLisplib(ctor,libName) ==
writeConstructorForm(ctor,form,$libFile)
writeKind(ctor,kind,$libFile)
writeConstructorModemap(ctor,removeZeroOne mm,$libFile)
+ writeDualSignature(db,$libFile)
$lisplibCategory := $lisplibCategory or mm.mmTarget
-- set to target of mm for package/domain constructors;
-- to the right-hand sides (the definition) for category constructors
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 117b5946..65ada6f5 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -303,9 +303,9 @@ NRTaddInner x ==
builtinConstructor? x.op or x.op is "[||]" =>
for y in x.args repeat
NRTinnerGetLocalIndex y
- getConstructorSignature first x is [.,:ml] =>
- for y in x.args for m in ml | y isnt '$ repeat
- isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y
+ cosig := getDualSignatureFromDB x.op =>
+ for y in x.args for t in cosig.source | y isnt '$ and t repeat
+ NRTinnerGetLocalIndex y
keyedSystemError("S2NR0003",[x])
x