diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/define.boot | 15 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 19 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 8 |
4 files changed, 33 insertions, 21 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 48402b85..60fd33dd 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,6 +1,16 @@ 2011-08-25 Gabriel Dos Reis <gdr@cs.tamu.edu> - * interp/lisplib.boot (autoLoad): Lose first parameter. + Remove $lisplibAttributes. + * interp/define.boot (compDefineFunctor1): Tidy. + (compCapsuleInner): Add a DB first parameter. Adjust callers. + * interp/lisplib.boot (NRTgenInitialAttributeAlist): Likewise. + (simplifyAttributeAlist): Likewise. + * interp/nruncomp.boot (changeDirectoryInSlot1): Likewise. + (buildFunctor): Change first parameter to DB. Adjust caller. + +2011-08-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/lisplib.boot (autoLoad): Lose first parameter. Adjust callers. (unloadOneConstructor): Likewise. * interp/category.boot (isCategoryForm): Rewrite. diff --git a/src/interp/define.boot b/src/interp/define.boot index ef251ab9..70800868 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1337,11 +1337,12 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $genSDVar: local:= 0 originale:= $e [$op,:argl]:= form - dbConstructorForm(constructorDB $op) := form + db := constructorDB $op + dbConstructorForm(db) := form $formalArgList:= [:argl,:$formalArgList] $pairlis: local := pairList(argl,$FormalMapVariableList) -- all defaulting packages should have caching turned off - dbInstanceCache(constructorDB $op) := not isCategoryPackageName $op + dbInstanceCache(db) := not isCategoryPackageName $op signature':= [signature.target,:[getArgumentModeOrMoan(a,form,$e) for a in argl]] $functorForm := $form := [$op,:argl] @@ -1360,7 +1361,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $condAlist: local := nil $uncondAlist: local := nil $NRTslot1PredicateList: local := predicatesFromAttributes attributeList - $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList + $NRTattributeAlist: local := NRTgenInitialAttributeAlist(db,attributeList) $NRTslot1Info: local := nil --set in NRTmakeSlot1Info --this is used below to set $lisplibSlot1 global $NRTaddForm: local := nil -- see compAdd @@ -1404,7 +1405,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], body':= T.expr lamOrSlam := - dbInstanceCache constructorDB $op = nil => 'LAM + dbInstanceCache db = nil => 'LAM 'SPADSLAM fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']]) --The above statement stops substitutions gettting in one another's way @@ -2145,7 +2146,7 @@ compCapsule(['CAPSULE,:itemList],m,e) == $useRepresentationHack := true clearCapsuleFunctionTable() e := checkRepresentation($addFormLhs,itemList,e) - compCapsuleInner(itemList,m,addDomain('_$,e)) + compCapsuleInner(constructorDB $form.op,itemList,m,addDomain('_$,e)) compSubDomain(["SubDomain",domainForm,predicate],m,e) == $addFormLhs: local:= domainForm @@ -2168,7 +2169,7 @@ compSubDomain1(domainForm,predicate,m,e) == emitSubdomainInfo($form,domainForm,pred) [domainForm,m,e] -compCapsuleInner(itemList,m,e) == +compCapsuleInner(db,itemList,m,e) == e:= addInformation(m,e) --puts a new 'special' property of $Information data := ["PROGN",:itemList] @@ -2179,7 +2180,7 @@ compCapsuleInner(itemList,m,e) == data := ['add,$addForm,data] code := $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data - buildFunctor($form,$signature,data,localParList,e) + buildFunctor(db,$signature,data,localParList,e) [MKPF([:$getDomainCode,code],"PROGN"),m,e] --% PROCESS FUNCTOR CODE diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 97571ddc..679bda4a 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -47,21 +47,21 @@ $functionLocations := [] --======================================================================= -- Generate Slot 2 Attribute Alist --======================================================================= -NRTgenInitialAttributeAlist attributeList == +NRTgenInitialAttributeAlist(db,attributeList) == --alist has form ((item pred)...) where some items are constructor forms alist := [x for x in attributeList | -- throw out constructors not symbolMember?(opOf first x,allConstructors())] - $lisplibAttributes := simplifyAttributeAlist - [[a,:b] for [a,b] in applySubst($pairlis,alist) | a isnt 'nothing] + dbAttributes(db) := simplifyAttributeAlist(db, + [[a,:b] for [a,b] in applySubst($pairlis,alist) | a isnt 'nothing]) -simplifyAttributeAlist al == +simplifyAttributeAlist(db,al) == al is [[a,:b],:r] => u := [x for x in r | x is [=a,:b]] - null u => [first al,:simplifyAttributeAlist rest al] + null u => [first al,:simplifyAttributeAlist(db,rest al)] pred := simpBool makePrefixForm([b,:ASSOCRIGHT u],'OR) $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList) s := [x for x in r | x isnt [=a,:b]] - [[a,:pred],:simplifyAttributeAlist s] + [[a,:pred],:simplifyAttributeAlist(db,s)] nil NRTgenFinalAttributeAlist e == @@ -442,7 +442,6 @@ compileConstructorLib(l,op,editFlag,traceFlag) == compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == $PrettyPrint: local := 'T $LISPLIB: local := 'T - $lisplibAttributes: local := nil $lisplibPredicates: local := nil $lisplibParents: local := nil $lisplibAncestors: local := nil @@ -470,7 +469,6 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == sayMSG fillerSpaces(72,char "-") $LISPLIB: local := 'T $op: local := op - $lisplibAttributes: local := nil $lisplibPredicates: local := nil -- set by makePredicateBitVector $lisplibParents: local := nil $lisplibAncestors: local := nil @@ -574,6 +572,7 @@ leaveIfErrors(libName,kind) == ++ Finalize `libName' compilation; returns true if everything is OK. finalizeLisplib(ctor,libName) == + db := constructorDB ctor kind := dbConstructorKind constructorDB ctor form := dbConstructorForm constructorDB ctor mm := getConstructorModemap ctor @@ -593,12 +592,12 @@ finalizeLisplib(ctor,libName) == if kind='category then $pairlis : local := pairList(form,$FormalMapVariableList) $NRTslot1PredicateList : local := [] - NRTgenInitialAttributeAlist rest opsAndAtts + NRTgenInitialAttributeAlist(db,rest opsAndAtts) writeSuperDomain(ctor,dbSuperDomain constructorDB ctor,$libFile) lisplibWrite('"signaturesAndLocals", removeZeroOne mergeSignatureAndLocalVarAlists($lisplibSignatureAlist, $lisplibVariableAlist),$libFile) - lisplibWrite('"attributes",removeZeroOne $lisplibAttributes,$libFile) + lisplibWrite('"attributes",removeZeroOne dbAttributes db,$libFile) lisplibWrite('"predicates",removeZeroOne $lisplibPredicates,$libFile) lisplibWrite('"abbreviation",dbAbbreviation constructorDB ctor,$libFile) lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 3070bd71..545d6ac3 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -448,7 +448,7 @@ makeSpadConstant [fn,dollar,slot] == u.rest := val val -buildFunctor($definition is [name,:args],sig,code,$locals,$e) == +buildFunctor(db,sig,code,$locals,$e) == --PARAMETERS -- $definition: constructor form, e.g. (SquareMatrix 10 (RationalNumber)) -- sig: signature of constructor form @@ -464,10 +464,12 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == --GLOBAL VARIABLES REFERENCED: -- $domainShell: passed in from compDefineFunctor1 -- $QuickCode: compilation flag + $definition: local := dbConstructorForm db + [name,:args] := $definition if code is ['add,.,newstuff] then code := newstuff - changeDirectoryInSlot1() --this extends $NRTslot1PredicateList + changeDirectoryInSlot1 db --this extends $NRTslot1PredicateList --LOCAL BOUND FLUID VARIABLES: $GENNO: local:= 0 --bound in compDefineFunctor1, then as parameter here @@ -665,7 +667,7 @@ NRTaddToSlam([name,:argnames],shell) == args := ['%list,:ASSOCRIGHT $devaluateList] addToConstructorCache(name,args,shell) -changeDirectoryInSlot1() == --called by buildFunctor +changeDirectoryInSlot1 db == --called by buildFunctor --3 cases: -- if called inside buildFunctor, $NRTdeltaLength gives different locs -- otherwise called from compFunctorBody (all lookups are forwarded): |