diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -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 | ||||
| -rw-r--r-- | src/share/algebra/browse.daase | 2 | ||||
| -rw-r--r-- | src/share/algebra/category.daase | 2 | ||||
| -rw-r--r-- | src/share/algebra/compress.daase | 2 | ||||
| -rw-r--r-- | src/share/algebra/interp.daase | 2 | ||||
| -rw-r--r-- | src/share/algebra/operation.daase | 2 |
11 files changed, 32 insertions, 14 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0a9f4601..78c3334f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,15 @@ 2011-09-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * 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. + +2011-09-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/define.boot (compDefineFunctor1): Augment the envionment with current instantiation. * interp/c-util.boot (isSubset): Accept values of current 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 diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase index 2601b44c..892061de 100644 --- a/src/share/algebra/browse.daase +++ b/src/share/algebra/browse.daase @@ -1,5 +1,5 @@ -(2276909 . 3524382844) +(2276909 . 3524395028) (-18 A S) ((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result."))) NIL diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase index 02bf76c7..eaa75040 100644 --- a/src/share/algebra/category.daase +++ b/src/share/algebra/category.daase @@ -1,5 +1,5 @@ -(207263 . 3524382848) +(207263 . 3524395032) ((((-877)) . T)) ((((-877)) . T)) ((((-877)) . T)) diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase index 81da52e9..22c83bd1 100644 --- a/src/share/algebra/compress.daase +++ b/src/share/algebra/compress.daase @@ -1,5 +1,5 @@ -(30 . 3524382843) +(30 . 3524395027) (4428 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain| ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join| |ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&| diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase index eea2c716..3b7ab6bc 100644 --- a/src/share/algebra/interp.daase +++ b/src/share/algebra/interp.daase @@ -1,5 +1,5 @@ -(3096904 . 3524382855) +(3096904 . 3524395039) ((-1935 (((-114) (-1 (-114) |#2| |#2|) $) 86 T ELT) (((-114) $) NIL T ELT)) (-1933 (($ (-1 (-114) |#2| |#2|) $) 18 T ELT) (($ $) NIL T ELT)) (-4218 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-1255 (-558)) |#2|) 44 T ELT)) (-2510 (($ $) 80 T ELT)) (-4272 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $) 49 T ELT)) (-3839 (((-558) (-1 (-114) |#2|) $) 27 T ELT) (((-558) |#2| $) NIL T ELT) (((-558) |#2| $ (-558)) 96 T ELT)) (-3290 (((-661 |#2|) $) 13 T ELT)) (-3938 (($ (-1 (-114) |#2| |#2|) $ $) 64 T ELT) (($ $ $) NIL T ELT)) (-2160 (($ (-1 |#2| |#2|) $) 37 T ELT)) (-4388 (($ (-1 |#2| |#2|) $) NIL T ELT) (($ (-1 |#2| |#2| |#2|) $ $) 60 T ELT)) (-2517 (($ |#2| $ (-558)) NIL T ELT) (($ $ $ (-558)) 67 T ELT)) (-1468 (((-3 |#2| "failed") (-1 (-114) |#2|) $) 29 T ELT)) (-2158 (((-114) (-1 (-114) |#2|) $) 23 T ELT)) (-4230 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-558)) NIL T ELT) (($ $ (-1255 (-558))) 66 T ELT)) (-2518 (($ $ (-558)) 76 T ELT) (($ $ (-1255 (-558))) 75 T ELT)) (-2157 (((-791) (-1 (-114) |#2|) $) 34 T ELT) (((-791) |#2| $) NIL T ELT)) (-1934 (($ $ $ (-558)) 69 T ELT)) (-3820 (($ $) 68 T ELT)) (-3950 (($ (-661 |#2|)) 73 T ELT)) (-4232 (($ $ |#2|) NIL T ELT) (($ |#2| $) NIL T ELT) (($ $ $) 87 T ELT) (($ (-661 $)) 85 T ELT)) (-4376 (((-877) $) 92 T ELT)) (-2159 (((-114) (-1 (-114) |#2|) $) 22 T ELT)) (-3454 (((-114) $ $) 95 T ELT)) (-3086 (((-114) $ $) 99 T ELT))) (((-18 |#1| |#2|) (-10 -7 (-15 -3454 ((-114) |#1| |#1|)) (-15 -4376 ((-877) |#1|)) (-15 -3086 ((-114) |#1| |#1|)) (-15 -1933 (|#1| |#1|)) (-15 -1933 (|#1| (-1 (-114) |#2| |#2|) |#1|)) (-15 -2510 (|#1| |#1|)) (-15 -1934 (|#1| |#1| |#1| (-558))) (-15 -1935 ((-114) |#1|)) (-15 -3938 (|#1| |#1| |#1|)) (-15 -3839 ((-558) |#2| |#1| (-558))) (-15 -3839 ((-558) |#2| |#1|)) (-15 -3839 ((-558) (-1 (-114) |#2|) |#1|)) (-15 -1935 ((-114) (-1 (-114) |#2| |#2|) |#1|)) (-15 -3938 (|#1| (-1 (-114) |#2| |#2|) |#1| |#1|)) (-15 -4218 (|#2| |#1| (-1255 (-558)) |#2|)) (-15 -2517 (|#1| |#1| |#1| (-558))) (-15 -2517 (|#1| |#2| |#1| (-558))) (-15 -2518 (|#1| |#1| (-1255 (-558)))) (-15 -2518 (|#1| |#1| (-558))) (-15 -4388 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -4232 (|#1| (-661 |#1|))) (-15 -4232 (|#1| |#1| |#1|)) (-15 -4232 (|#1| |#2| |#1|)) (-15 -4232 (|#1| |#1| |#2|)) (-15 -4230 (|#1| |#1| (-1255 (-558)))) (-15 -3950 (|#1| (-661 |#2|))) (-15 -1468 ((-3 |#2| "failed") (-1 (-114) |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -4230 (|#2| |#1| (-558))) (-15 -4230 (|#2| |#1| (-558) |#2|)) (-15 -4218 (|#2| |#1| (-558) |#2|)) (-15 -2157 ((-791) |#2| |#1|)) (-15 -3290 ((-661 |#2|) |#1|)) (-15 -2157 ((-791) (-1 (-114) |#2|) |#1|)) (-15 -2158 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2159 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2160 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -4388 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3820 (|#1| |#1|))) (-19 |#2|) (-1238)) (T -18)) NIL diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase index 25c8cb11..43e8ca69 100644 --- a/src/share/algebra/operation.daase +++ b/src/share/algebra/operation.daase @@ -1,5 +1,5 @@ -(719417 . 3524382845) +(719417 . 3524395030) (((*1 *2 *3 *4) (|partial| -12 (-5 *3 (-1288 *4)) (-4 *4 (-13 (-1070) (-658 (-558)))) (-5 *2 (-1288 (-419 (-558)))) (-5 *1 (-1317 *4))))) |