diff options
author | dos-reis <gdr@axiomatics.org> | 2011-09-07 16:07:42 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-09-07 16:07:42 +0000 |
commit | 88c6450a9068d951752e06f5ee40d63de1e95fd8 (patch) | |
tree | 2f8d3f6bc7cb5dca9151ce51363e3cbaf6691d38 /src/interp | |
parent | 80e53e21c3d0f18791ca5a4905217c1f89aa90f1 (diff) | |
download | open-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.boot | 3 | ||||
-rw-r--r-- | src/interp/daase.lisp | 3 | ||||
-rw-r--r-- | src/interp/define.boot | 9 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 5 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 6 |
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 |