diff options
| -rw-r--r-- | src/ChangeLog | 14 | ||||
| -rw-r--r-- | src/interp/database.boot | 86 | ||||
| -rw-r--r-- | src/interp/define.boot | 4 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 4 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 |
5 files changed, 66 insertions, 45 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9710f49f..e588c073 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,17 @@ +2011-10-27 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/sys-globals.boot ($lisplibModemapAlist): Remove. + * interp/lisplib.boot (compileConstructorLib): Do not bind + $lisplibModemapAlist. + (compDefineLisplib): Likewise. + * interp/database.boot (modemapsFromCategory): Rename from + augLisplibModmapsFromCategory. Tidy. Avoid use of special + variable $lisplibModemapAlist. + (modemapsFromFunctor): Rename from augmentLisplibFromFunctor. + Tidy. Avoid use of special variable $lisplibModemapAlist. + * interp/define.boot (compDefineCategory2): Adjust. + (compDefineFunctor1): Likewise. + 2011-10-26 Gabriel Dos Reis <gdr@cs.tamu.edu> * algebra/stream.spad.pamphlet (Stream): Tidy accessors. diff --git a/src/interp/database.boot b/src/interp/database.boot index bee544b0..ffd10de7 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -172,58 +172,70 @@ getConstructorKind ctor == --% Functions for manipulating MODEMAP DATABASE -augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == - sl := [["$",:"*1"],:pairList(argl,rest $PatternVariableList)] - form:= applySubst(sl,form) - body:= applySubst(sl,body) - signature:= applySubst(sl,signature) - opAlist:= applySubst(sl,categoryExports $domainShell) or return nil - nonCategorySigAlist:= +++ We are about to finish the elaboration of the category `form' with +++ given `body' and `signature'. Return the list of all modemaps +++ of operators exported by generic instantiation of the category constructor. +++ Note: The structure of the modemaps is that understood by the +++ interpreter, but that of the of the compiler. +modemapsFromCategory(form,body,signature) == + sl := [["$",:"*1"],:pairList(form.args,rest $PatternVariableList)] + form := applySubst(sl,form) + body := applySubst(sl,body) + signature := applySubst(sl,signature) + opAlist := applySubst(sl,categoryExports $domainShell) or return nil + nonCategorySigAlist := mkAlistOfExplicitCategoryOps substitute("*1","$",body) - domainList:= - [[a,m] for a in rest form for m in rest signature | + domainList := + [[a,m] for a in form.args for m in signature.source | isCategoryForm(m,$EmptyEnvironment)] - catPredList:= [['ofCategory,:u] for u in [["*1",form],:domainList]] + catPredList := [['ofCategory,:u] for u in [["*1",form],:domainList]] + op := form.op + mms := nil for (entry:= [[op,sig,:.],pred,sel]) in opAlist | listMember?(sig,LASSOC(op,nonCategorySigAlist)) repeat - pred':= MKPF([pred,:catPredList],'AND) - modemap:= [["*1",:sig],[pred',sel]] - $lisplibModemapAlist:= - [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist] - -augmentLisplibModemapsFromFunctor(form,opAlist,signature) == - form:= [formOp,:argl]:= formal2Pattern form - opAlist:= formal2Pattern opAlist - signature:= formal2Pattern signature + pred' := MKPF([pred,:catPredList],'AND) + modemap := [["*1",:sig],[pred',sel]] + mms := [[op,:interactiveModemapForm modemap],:mms] + mms + +++ We are about to finish the elaboration of the generic instantiation +++ of the function `form.op' with `signature'. Return a list of modemaps +++ for operations from `opAlist' explicitly exported by the functor. +++ Note: the structure of modemaps same as for modemapsFromCategory. +modemapsFromFunctor(form,opAlist,signature) == + form := [.,:argl] := formal2Pattern form + opAlist := formal2Pattern opAlist + signature := formal2Pattern signature for u in form for v in signature repeat if symbolMember?(u,$PatternVariableList) then -- we are going to be EVALing categories containing these -- pattern variables - $e:=put(u,'mode,v,$e) - nonCategorySigAlist:= - mkAlistOfExplicitCategoryOps first signature or return nil - for (entry:= [[op,sig,:.],pred,sel]) in opAlist | + $e := put(u,'mode,v,$e) + nonCategorySigAlist := + mkAlistOfExplicitCategoryOps signature.target or return nil + mms := nil + for (entry := [[op,sig,:.],pred,sel]) in opAlist | or/[listMember?(sig,catSig) for catSig in allLASSOCs(op,nonCategorySigAlist)] repeat - skip:= - argl and CONTAINED("$",rest sig) => 'SKIP + skip := + argl ~= nil and CONTAINED("$",sig.source) => 'SKIP nil - sel:= substitute(form,"$",sel) - patternList:= listOfPatternIds sig + sel := substitute(form,"$",sel) + patternList := listOfPatternIds sig --get relevant predicates - predList:= - [[a,m] for a in argl for m in rest signature + predList := + [[a,m] for a in argl for m in signature.source | symbolMember?(a,$PatternVariableList)] - sig:= substitute(form,"$",sig) - pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND) - l:=listOfPatternIds predList - if "OR"/[null symbolMember?(u,l) for u in argl] then + sig := substitute(form,"$",sig) + pred' := MKPF([pred,:[mkDatabasePred y for y in predList]],'AND) + l := listOfPatternIds predList + if "OR"/[not symbolMember?(u,l) for u in argl] then sayMSG ['"cannot handle modemap for",:bright op, '"by pattern match" ] - skip:= 'SKIP - modemap:= [[form,:sig],[pred',sel,:skip]] - $lisplibModemapAlist:= [[op,:interactiveModemapForm modemap], - :$lisplibModemapAlist] + skip := 'SKIP + modemap := [[form,:sig],[pred',sel,:skip]] + mms := [[op,:interactiveModemapForm modemap],:mms] + mms rebuildCDT(filemode) == clearConstructorAndLisplibCaches() diff --git a/src/interp/define.boot b/src/interp/define.boot index da7c2ed0..d135d4ef 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1076,7 +1076,7 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) == $lisplibCategory:= formalBody dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList,$lisplibCategory) dbAncestors(db) := computeAncestorsOf($form,nil) - augLisplibModemapsFromCategory([op',:sargl],formalBody,signature') + dbModemaps(db) := modemapsFromCategory([op',:sargl],formalBody,signature') dbBeingDefined?(db) := false [fun,$Category,e] @@ -1439,7 +1439,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body], fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']]) --The above statement stops substitutions gettting in one another's way operationAlist := applySubst($pairlis,$lisplibOperationAlist) - augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature) + dbModemaps(db) := modemapsFromFunctor(parForm,operationAlist,parSignature) reportOnFunctorCompilation() -- 5. diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index c7d3bfdb..f8cf0867 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -387,7 +387,6 @@ compileConstructorLib(l,op,editFlag,traceFlag) == compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == $PrettyPrint: local := 'T $lisplibPredicates: local := nil - $lisplibModemapAlist: local := nil $lisplibOperationAlist: local := nil $libFile: local := nil $lisplibVariableAlist: local := nil @@ -409,7 +408,6 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == sayMSG fillerSpaces(72,char "-") $op: local := op $lisplibPredicates: local := nil -- set by makePredicateBitVector - $lisplibModemapAlist: local := nil $lisplibOperationAlist: local := nil $lisplibSignatureAlist: local := nil $libFile: local := nil @@ -534,7 +532,7 @@ finalizeLisplib(ctor,libName) == if dbConstructorKind db = 'category then writeCategory(ctor,$lisplibCategory,$libFile) lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile) - lisplibWrite('"modemaps",$lisplibModemapAlist,$libFile) + lisplibWrite('"modemaps",dbModemaps db,$libFile) opsAndAtts := getConstructorOpsAndAtts(form,kind,mm) writeOperations(ctor,first opsAndAtts,$libFile) if kind='category then diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 31d062af..0d97305f 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -163,9 +163,6 @@ $letAssoc := false $libFile := nil ++ -$lisplibModemapAlist := [] - -++ $lisplibOperationAlist := [] ++ |