diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/database.boot | 109 |
2 files changed, 49 insertions, 72 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 6dfeef52..0f6eaa62 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,17 @@ 2011-10-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/database.boot (orderPredTran): Tidy. + (interactiveModemapForm): Likewise. + (getDCFromSystemModemap): Likewise. + (getDomainFromMm): Likewise. + (getAllModemapsFromDatabase): Likewise. + (getModemapsFromDatabase): Likewise. + (getSystemModemaps): Likewise. + (getInCoreModemaps): Likewise. + (flattenSignatureList): Likewise. + +2011-10-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/define.boot ($lisplibCategory): Remove. (compDefineCategory1): Adjust. (compDefineCategory2): Likewise. diff --git a/src/interp/database.boot b/src/interp/database.boot index ffd10de7..5a0bd592 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -305,49 +305,37 @@ orderPredicateItems(pred1,sig,skip) == pred orderPredTran(oldList,sig,skip) == - lastPreds:=nil + lastPreds := nil --(1) make two kinds of predicates appear last: ----- (op *target ..) when *target does not appear later in sig ----- (isDomain *1 ..) for pred in oldList repeat ((pred is [op,pvar,.] and op in '(isDomain ofCategory) - and pvar=first sig and not symbolMember?(pvar,rest sig)) or - (not skip and pred is ['isDomain,pvar,.] and pvar is "*1")) => + and pvar = sig.target and not symbolMember?(pvar,sig.source)) or + (not skip and pred is ['isDomain,"*1",.])) => oldList := remove(oldList,pred) - lastPreds:=[pred,:lastPreds] ---sayBrightlyNT "lastPreds=" ---pp lastPreds + lastPreds := [pred,:lastPreds] --(2a) lastDependList=list of all variables that lastPred forms depend upon lastDependList := setUnion/[listOfPatternIds x for x in lastPreds] ---sayBrightlyNT "lastDependList=" ---pp lastDependList --(2b) dependList=list of all variables that isDom/ofCat forms depend upon dependList := setUnion/[listOfPatternIds y for x in oldList | x is ['isDomain,.,y] or x is ['ofCategory,.,y]] ---sayBrightlyNT "dependList=" ---pp dependList --(3a) newList= list of ofCat/isDom entries that don't depend on for x in oldList repeat if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then - indepvl:=listOfPatternIds v - depvl:=listOfPatternIds body + indepvl := listOfPatternIds v + depvl := listOfPatternIds body else indepvl := listOfPatternIds x depvl := nil setIntersection(indepvl,dependList) = nil and setIntersection(indepvl,lastDependList) => - somethingDone := true lastPreds := [:lastPreds,x] oldList := remove(oldList,x) ---if somethingDone then --- sayBrightlyNT "Again lastPreds=" --- pp lastPreds --- sayBrightlyNT "Again oldList=" --- pp oldList --(3b) newList= list of ofCat/isDom entries that don't depend on while oldList ~= nil repeat @@ -361,8 +349,6 @@ orderPredTran(oldList,sig,skip) == setIntersection(indepvl,dependList) = nil => dependList := setDifference(dependList,depvl) newList := [:newList,x] --- sayBrightlyNT "newList=" --- pp newList --(4) noldList= what is left over (noldList:= setDifference(oldList,newList)) = oldList => @@ -370,23 +356,19 @@ orderPredTran(oldList,sig,skip) == newList := [:newList,:oldList] return nil oldList:=noldList --- sayBrightlyNT "noldList=" --- pp noldList for pred in newList repeat if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then - ids:= listOfPatternIds y + ids := listOfPatternIds y if "and"/[symbolMember?(id,fullDependList) for id in ids] then fullDependList := insertWOC(x,fullDependList) fullDependList := setUnion(fullDependList,ids) - newList:=[:newList,:lastPreds] + newList := [:newList,:lastPreds] --substitute (isDomain ..) forms as completely as possible to avoid false paths newList := isDomainSubst newList - answer := [['AND,:newList],:setIntersection(fullDependList,sig)] ---sayBrightlyNT '"answer=" ---pp answer + [['AND,:newList],:setIntersection(fullDependList,sig)] isDomainSubst u == main where main() == @@ -417,20 +399,14 @@ interactiveModemapForm mm == -- replaces all specific domains mentioned in the modemap with pattern -- variables, and predicates mm := replaceVars(COPY mm,$PatternVariableList,$FormalMapVariableList) - [pattern:=[dc,:sig],pred] := mm + [pattern := [dc,:sig],pred] := mm pred := [fn x for x in pred] where fn x == x is [a,b,c] and a isnt 'isFreeFunction and c isnt [.,:.] => [a,b,[c]] x ---pp pred - [mmpat, patternAlist, partial, patvars] := - modemapPattern(pattern,sig) ---pp [pattern, mmpat, patternAlist, partial, patvars] - [pred,domainPredicateList] := - substVars(pred,patternAlist,patvars) ---pp [pred,domainPredicateList] - [pred,:dependList]:= + [mmpat, patternAlist, partial, patvars] := modemapPattern(pattern,sig) + [pred,domainPredicateList] := substVars(pred,patternAlist,patvars) + [pred,:dependList] := fixUpPredicate(pred,domainPredicateList,partial,rest mmpat) ---pp [pred,dependList] [cond, :.] := pred [mmpat, cond] @@ -480,7 +456,6 @@ fixUpPredicate(predClause, domainPreds, partial, sig) == if first predicate = "AND" then predicates := append(domainPreds,rest predicate) else if predicate ~= MKQ "T" ---was->then predicates:= reverse [predicate, :domainPreds] then predicates:= [predicate, :domainPreds] else predicates := domainPreds or [predicate] if #predicates > 1 then @@ -521,18 +496,15 @@ getConditionListFromMm mm == ++ to be confused with `getDomainFromMm' below, which can also return ++ a category. getDCFromSystemModemap mm == - for cond in getConditionListFromMm mm repeat - cond is ["isDomain","*1",dom] => return dom + or/[dom for cond in getConditionListFromMm mm | + cond is ["isDomain","*1",dom]] getDomainFromMm mm == -- Returns the Domain (or package or category) of origin from a pattern -- modemap - condList := getConditionListFromMm mm - val := - for condition in condList repeat - condition is ['isDomain, "*1", dom] => return opOf dom - condition is ['ofCategory, "*1", cat] => return opOf cat - null val => + val := or/[opOf t for cond in getConditionListFromMm mm | + cond is ['isDomain,"*1",t] or cond is ['ofCategory,"*1",t]] + val = nil => keyedSystemError("S2GE0016", ['"getDomainFromMm",'"Can't find domain in modemap condition"]) val @@ -574,23 +546,22 @@ isFreeFunctionFromMmCond cond == getAllModemapsFromDatabase(op,nargs) == $getUnexposedOperations: local := true - startTimingProcess 'diskread - ans := getSystemModemaps(op,nargs) - stopTimingProcess 'diskread - ans + try + startTimingProcess 'diskread + getSystemModemaps(op,nargs) + finally stopTimingProcess 'diskread getModemapsFromDatabase(op,nargs) == $getUnexposedOperations: local := false - startTimingProcess 'diskread - ans := getSystemModemaps(op,nargs) - stopTimingProcess 'diskread - ans + try + startTimingProcess 'diskread + getSystemModemaps(op,nargs) + finally stopTimingProcess 'diskread getSystemModemaps(op,nargs) == - mml:= getOperationFromDB op => + mml := getOperationFromDB op => mms := nil - for (x := [[.,:sig],.]) in mml repeat - (integer? nargs) and (nargs ~= # sig.source) => 'iterate + for x in mml | not integer? nargs or nargs = #x.mmSource repeat $getUnexposedOperations or isFreeFunctionFromMm(x) or isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms] 'iterate @@ -598,10 +569,10 @@ getSystemModemaps(op,nargs) == nil getInCoreModemaps(modemapList,op,nargs) == - mml:= LASSOC (op,modemapList) => - mml:= first mml - [x for (x:= [[dc,:sig],.]) in mml | - (integer? nargs => nargs=#rest sig; true) and + mml := LASSOC (op,modemapList) => + mml := first mml + [x for x in mml | + (not integer? nargs or nargs = #x.mmSource) and (cfn := abbreviate (domName := getDomainFromMm x)) and ($getUnexposedOperations or isExposedConstructor(domName))] nil @@ -612,16 +583,10 @@ mkAlistOfExplicitCategoryOps target == target is ['Join,:l] => "union"/[mkAlistOfExplicitCategoryOps cat for cat in l] target is ['CATEGORY,.,:l] => - l:= flattenSignatureList ['PROGN,:l] - u:= - [[atomizeOp op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]] - where - atomizeOp op == - op isnt [.,:.] => op - op is [a] => a - keyedSystemError("S2GE0016", - ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) - opList:= removeDuplicates ASSOCLEFT u + l := flattenSignatureList ['PROGN,:l] + u := + [[op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]] + opList := removeDuplicates ASSOCLEFT u [[x,:fn(x,u)] for x in opList] where fn(op,u) == u is [[a,:b],:c] => (a=op => [b,:fn(op,c)]; fn(op,c)) @@ -633,7 +598,7 @@ flattenSignatureList(x) == x isnt [.,:.] => nil x is ['SIGNATURE,:.] => [x] x is ['IF,cond,b1,b2] => - append(flattenSignatureList b1, flattenSignatureList b2) + [:flattenSignatureList b1,:flattenSignatureList b2] x is ['PROGN,:l] => ll:= [] for x in l repeat |