diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 6 | ||||
| -rw-r--r-- | src/interp/define.boot | 4 | ||||
| -rw-r--r-- | src/interp/functor.boot | 20 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 24 |
5 files changed, 36 insertions, 27 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 980a8574..0c0562e6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2013-06-18 Gabriel Dos Reis <gdr@integrable-solutions.net> + + * interp/compiler.boot (compHasFormat): Take a DB parameter. + Adjust callers. + * interp/define.boot (ICformat): Likewise. + * interp/lisplib.boot (predicateBitIndex): Likewise. + (predicateBitRef): Likewise. + (transHasCode): Likewise. + 2013-06-17 Gabriel Dos Reis <gdr@integrable-solutions.net> * algebra/catdef.spad.pamphlet (CommutativeOperatorCategory): New. diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 1d2921eb..e070e214 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1349,12 +1349,12 @@ compElt(form,m,E) == compHas: (%Form,%Mode,%Env) -> %Maybe %Triple compHas(pred is ["has",a,b],m,e) == e := chaseInferences(pred,e) - predCode := compHasFormat(pred,e) + predCode := compHasFormat(currentDB e,pred,e) coerce([predCode,$Boolean,e],m) --used in various other places to make the discrimination -compHasFormat(pred is ["has",olda,b],e) == +compHasFormat(db,pred is ["has",olda,b],e) == argl := $form.args formals := take(#argl,$FormalMapVariableList) a := applySubst(pairList(formals,argl),olda) @@ -1365,7 +1365,7 @@ compHasFormat(pred is ["has",olda,b],e) == ["HasSignature",a, mkList [MKQ op,mkList [mkTypeForm type for type in sig]]] b is ["Join",:l] or b is ["CATEGORY",.,:l] => - ["AND",:[compHasFormat(["has",olda,c],e) for c in l]] + ["AND",:[compHasFormat(db,["has",olda,c],e) for c in l]] isCategoryForm(b,e) => ["HasCategory",a,optimize! mkTypeForm b] stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"]) diff --git a/src/interp/define.boot b/src/interp/define.boot index dfcff5e3..187c3768 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -431,7 +431,7 @@ makeCompactDirect1(db,op,items) == n is [p,:.] => p --the rest is linenumber of function definition n predCode := - s is [pred,:.] => predicateBitIndex(pred,$e) + s is [pred,:.] => predicateBitIndex(db,pred,$e) 0 --> drop items which are not present (predCode = -1) predCode = -1 => return nil @@ -490,7 +490,7 @@ makeCategoryAlist(db,e) == opcAlist := sortBy(function(x +-> LASSOC(first x,levelAlist)),pcAlist) newPairlis := [[i,:b] for [.,:b] in dbFormalSubst db for i in 6..] slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist) - | (k := predicateBitIndex(b,e)) ~= -1] + | (k := predicateBitIndex(db,b,e)) ~= -1] slot0 := [getCategoryConstructorDefault a.op for [a,:.] in slot1] sixEtc := [5 + i for i in 1..dbArity db] formals := substTarget dbFormalSubst db diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 356c66de..5aac19c4 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -500,7 +500,7 @@ ConstantCreator u == ProcessCond(db,cond,e) == ncond := dbSubstituteFormals(db,cond) - valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e) + valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(db,ncond,e) cond TryGDC cond == @@ -636,14 +636,14 @@ InvestigateConditions(db,catvecListMaker,tbl,env) == mkOr(cond2,old,tbl,env) old list2 - list:= [[sec,:ICformat(u,tbl,env)] for u in list for sec in secondaries] + list:= [[sec,:ICformat(db,u,tbl,env)] for u in list for sec in secondaries] pv:= getPossibleViews($principal,tbl) -- $HackSlot4 is used in SetVector4 to ensure that conditional -- extensions of the principal view are handles correctly -- here we build the code necessary to remove spurious extensions - ($HackSlot4:= [reshape(u,tbl,env) for u in $HackSlot4]) where - reshape(u,tbl,env) == - ['%when,[TryGDC ICformat(rest u,tbl,env)], + ($HackSlot4:= [reshape(db,u,tbl,env) for u in $HackSlot4]) where + reshape(db,u,tbl,env) == + ['%when,[TryGDC ICformat(db,rest u,tbl,env)], ['%otherwise,['RPLACA,'(CAR TrueDomain), ['delete, quote first u,'(CAAR TrueDomain)]]]] $supplementaries:= @@ -652,11 +652,11 @@ InvestigateConditions(db,catvecListMaker,tbl,env) == and not (true=rest u) and not listMember?(first u,pv)] [true,:[LASSOC(ms,list) for ms in masterSecondaries]] -ICformat(u,tbl,env) == +ICformat(db,u,tbl,env) == u isnt [.,:.] => u - u is ["has",:.] => compHasFormat(u,env) + u is ["has",:.] => compHasFormat(db,u,env) u is ['AND,:l] or u is ['and,:l] => - l:= removeDuplicates [ICformat(v,tbl,env) for [v,:l'] in tails l + l:= removeDuplicates [ICformat(db,v,tbl,env) for [v,:l'] in tails l | not listMember?(v,l')] -- we could have duplicates after, even if not before # l=1 => first l @@ -666,8 +666,8 @@ ICformat(u,tbl,env) == l1 u is ['OR,:l] => (l:= ORreduce l) - # l=1 => ICformat(first l,tbl,env) - l:= ORreduce removeDuplicates [ICformat(u,tbl,env) for u in l] + # l=1 => ICformat(db,first l,tbl,env) + l:= ORreduce removeDuplicates [ICformat(db,u,tbl,env) for u in l] --causes multiple ANDs to be squashed, etc. -- and duplicates that have been built up by tidying (l:= Hasreduce(l,tbl,env)) where diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 08b9417b..3ad3bc9b 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -60,16 +60,16 @@ simplifyAttributeAlist(db,al) == genFinalAttributeAlist(db,e) == [[a,:k] for [a,:b] in $NRTattributeAlist - | (k := predicateBitIndex(b,e)) ~= -1] + | (k := predicateBitIndex(db,b,e)) ~= -1] -predicateBitIndex(x,e) == - pn(x,false,e) where - pn(x,flag,e) == - u := simpBool transHasCode(x,e) +predicateBitIndex(db,x,e) == + pn(db,x,false,e) where + pn(db,x,flag,e) == + u := simpBool transHasCode(db,x,e) u is 'T => 0 u is false => -1 p := valuePosition(u,$NRTslot1PredicateList) => p + 1 - not flag => pn(predicateBitIndexRemop x,true,e) + not flag => pn(db,predicateBitIndexRemop x,true,e) systemError nil predicateBitIndexRemop p== @@ -79,9 +79,9 @@ predicateBitIndexRemop p== p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist) p -predicateBitRef(x,e) == +predicateBitRef(db,x,e) == x is 'T => 'T - ['testBitVector,'pv_$,predicateBitIndex(x,e)] + ['testBitVector,'pv_$,predicateBitIndex(db,x,e)] makePrefixForm(u,op) == u := MKPF(u,op) @@ -96,7 +96,7 @@ makePredicateBitVector(db,pl,e) == --called by buildFunctor pl := union(pl,$categoryPredicateList) $predGensymAlist := nil --bound by buildFunctor, used by optHas for p in removeAttributePredicates pl repeat - pred := simpBool transHasCode(p,e) + pred := simpBool transHasCode(db,p,e) pred isnt [.,:.] => 'skip --skip over T and nil if isHasDollarPred pred then lasts := insert(pred,lasts) @@ -146,12 +146,12 @@ removeAttributePredicates pl == p fnl p == [fn x for x in p] -transHasCode(x,e) == +transHasCode(db,x,e) == x isnt [.,:.] => x op := x.op op in '(HasCategory HasAttribute) => x - op="has" => compHasFormat(x,e) - [transHasCode(y,e) for y in x] + op="has" => compHasFormat(db,x,e) + [transHasCode(db,y,e) for y in x] mungeAddGensyms(u,gal) == ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) == |