From e694e02b3c8e9ae322df7440a29c3011a11503e7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 2 May 2011 10:53:56 +0000 Subject: More cleanups --- src/interp/Makefile.in | 2 +- src/interp/bc-util.boot | 1 + src/interp/br-op1.boot | 4 ++-- src/interp/br-op2.boot | 2 +- src/interp/c-util.boot | 5 +++++ src/interp/database.boot | 12 ++++++------ src/interp/define.boot | 4 ++-- src/interp/interop.boot | 8 ++++---- src/interp/lisplib.boot | 2 +- src/interp/nruncomp.boot | 2 +- src/interp/nrunfast.boot | 10 +++++----- src/interp/showimp.boot | 6 +++--- 12 files changed, 32 insertions(+), 26 deletions(-) (limited to 'src/interp') diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 74965ecb..707f6310 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -288,7 +288,7 @@ br-util.$(FASLEXT): bc-util.$(FASLEXT) bc-solve.$(FASLEXT): bc-matrix.$(FASLEXT) bc-matrix.$(FASLEXT): bc-util.$(FASLEXT) bc-misc.$(FASLEXT): bc-util.$(FASLEXT) -bc-util.$(FASLEXT): ht-util.$(FASLEXT) +bc-util.$(FASLEXT): ht-util.$(FASLEXT) c-util.$(FASLEXT) ht-root.$(FASLEXT): ht-util.$(FASLEXT) htcheck.$(FASLEXT): sys-driver.$(FASLEXT) macros.$(FASLEXT) ht-util.$(FASLEXT): macros.$(FASLEXT) diff --git a/src/interp/bc-util.boot b/src/interp/bc-util.boot index 38a7255b..2d8a22b6 100644 --- a/src/interp/bc-util.boot +++ b/src/interp/bc-util.boot @@ -33,6 +33,7 @@ import ht_-util +import c_-util namespace BOOT ++ diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 41409eb1..6790d805 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -393,7 +393,7 @@ dbGatherDataImplementation(htPage,opAlist) == which := '"operation" [nam,:$domainArgs] := domainForm $predicateList: local := getConstructorPredicatesFromDB nam - predVector := vectorRef(dom,3) + predVector := domainPredicates dom u := getDomainOpTable(dom,true,ASSOCLEFT opAlist) --u has form ((op,sig,:implementor)...) --sort into 4 groups: domain exports, unexports, default exports, others @@ -995,7 +995,7 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where attPredIndex := LASSOC(a,dom.2) null attPredIndex => nil attPredIndex = 0 => true - testBitVector(dom.3,attPredIndex) + testBitVector(domainPredicates dom,attPredIndex) nil pred is 'T => true systemError '"unknown atomic predicate form" diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 452a4abc..480ea00c 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -347,7 +347,7 @@ koAttrs(conform,domname) == koCatAttrs(conform,domname) $infovec: local := dbInfovec conname or return nil $predvec: local := - $domain => vectorRef($domain,3) + $domain => domainPredicares $domain getConstructorPredicatesFromDB conname u := [[a,:pred] for [a,:i] in $infovec . 2 | a isnt 'nil and (pred := sublisFormal(args,kTestPred i))] --------- CHECK for a = nil diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 6f40e699..986fbea0 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -77,6 +77,11 @@ macro instantiationArgs d == macro categoryExports d == categoryRef(d,1) +++ Return the predicate values associated with the domain object. +++ This is an integer interpreted as bit vector +macro domainPredicates d == + domainRef(d,3) + --% $SetCategory == '(SetCategory) diff --git a/src/interp/database.boot b/src/interp/database.boot index 7ce512c8..f62d2f59 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -444,21 +444,21 @@ modemapPattern(mmPattern,sig) == substVars(pred,patternAlist,patternVarList) == --make pattern variable substitutions - domainPredicates := nil + domPreds := nil for [[patVar,:value],:.] in tails patternAlist repeat pred := MSUBST(patVar,value,pred) patternAlist := nsubst(patVar,value,patternAlist) - domainPredicates := MSUBST(patVar,value,domainPredicates) + domPreds := MSUBST(patVar,value,domPreds) if not symbolMember?(value,$FormalMapVariableList) then - domainPredicates := [["isDomain",patVar,value],:domainPredicates] - everything := [pred,patternAlist,domainPredicates] + domPreds := [["isDomain",patVar,value],:domPreds] + everything := [pred,patternAlist,domPreds] for var in $FormalMapVariableList repeat CONTAINED(var,everything) => replacementVar := first patternVarList patternVarList := rest patternVarList pred := substitute(replacementVar,var,pred) - domainPredicates := substitute(replacementVar,var,domainPredicates) - [pred, domainPredicates] + domPreds := substitute(replacementVar,var,domPreds) + [pred, domPreds] fixUpPredicate(predClause, domainPreds, partial, sig) == -- merge the predicates in predClause and domainPreds into a diff --git a/src/interp/define.boot b/src/interp/define.boot index 6d3656a6..599e9ca4 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -722,7 +722,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) == x is ['DEF,y,:.] => [y,:oplist] fn(x.args,fn(x.op,oplist)) catvec := eval mkEvalableCategoryForm form - fullCatOpList := vectorRef(JoinInner([catvec],$e),1) + fullCatOpList := categoryExports JoinInner([catvec],$e) catOpList := [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList | assoc(op1,capsuleDefAlist)] @@ -930,7 +930,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], [ds,.,$e]:= compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) $compileExportsOnly => - compDefineExports(form, vectorRef(ds,1), signature',$e) + compDefineExports(form, categoryExports ds, signature',$e) $domainShell: local := COPY_-SEQ ds attributeList := vectorRef(ds,2) --see below under "loadTimeAlist" $condAlist: local := nil diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 20c4c920..847edadd 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -458,7 +458,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == '"----> searching op table for:","%l"," "),op,sig,dollar) someMatch := false numvec := getDomainByteVector domain - predvec := vectorRef(domain,3) + predvec := domainPredicates domain max := maxIndex opvec k := getOpCode(op,opvec,max) or return flag => newLookupInAddChain(op,sig,domain,dollar) @@ -529,7 +529,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) == $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) - predvec := dom.3 + predvec := domainPredicates dom packageVec := first slot4 --the next three lines can go away with new category world varList := ['$,:$FormalMapVariableList] @@ -622,7 +622,7 @@ newHasAttribute(domain,attrib) == LASSOC(attrib,domain.2) predIndex => predIndex = 0 => true - predvec := domain.3 + predvec := domainPredicates domain testBitVector(predvec,predIndex) false @@ -638,7 +638,7 @@ newHasCategory(domain,catform) == predIndex := lazyMatchAssocV1(catform,catvec,domain) null predIndex => false predIndex = 0 => true - predvec := vectorRef(domain,3) + predvec := domainPredicates domain testBitVector(predvec,predIndex) lazyMatchAssocV(catform,auxvec,catvec,domain) --new style diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 7ba8c45b..498bacfb 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -122,7 +122,7 @@ augmentPredCode(n,lastPl) == delta:=2 * delta; u) for x in pl] augmentPredVector(dollar,value) == - vectorRef(dollar,3) := value + vectorRef(dollar,3) + domainPredicates(dollar) := value + domainPredicates dollar isHasDollarPred pred == pred is [op,:r] => diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index c0c14683..7b9a7efe 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -435,7 +435,7 @@ stuffDomainSlots dollar == proto4 := infovec.3 vectorRef(dollar,4) := vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4] --old style - bitVector := dollar.3 + bitVector := domainPredicates dollar predvec := first proto4 packagevec := second proto4 auxvec := LIST2VEC [fn for i in 0..maxIndex predvec] where fn() == diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index cd86d3e2..785682e4 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -62,7 +62,7 @@ initNewWorld() == $doNotCompressHashTableIfTrue := true isNewWorldDomain domain == - integer? vectorRef(domain,3) --see HasCategory/Attribute + integer? domainRef(domain,3) --see HasCategory/Attribute getDomainByteVector dom == CDDR vectorRef(dom,4) @@ -184,7 +184,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == '"----> searching op table for:","%l"," "),op,sig,dollar) someMatch := false numvec := getDomainByteVector domain - predvec := vectorRef(domain,3) + predvec := domainPredicates domain max := maxIndex opvec k := getOpCode(op,opvec,max) or return flag => newLookupInAddChain(op,sig,domain,dollar) @@ -309,7 +309,7 @@ newLookupInCategories(op,sig,dom,dollar) == $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) - predvec := vectorRef(dom,3) + predvec := domainPredicates dom packageVec := first slot4 --the next three lines can go away with new category world varList := ['$,:$FormalMapVariableList] @@ -385,7 +385,7 @@ newLookupInCategories1(op,sig,dom,dollar) == $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) - predvec := vectorRef(dom,3) + predvec := domainPredicates dom slot4 := vectorRef(dom,4) packageVec := first slot4 catVec := second slot4 @@ -552,7 +552,7 @@ lookupInDomainByName(op,domain,arg) == atom arg => nil opvec := domain . 1 . 2 numvec := getDomainByteVector domain - predvec := vectorRef(domain,3) + predvec := domainPredicates domain max := maxIndex opvec k := getOpCode(op,opvec,max) or return nil idxmax := maxIndex numvec diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 0b7cf13e..c56e2fee 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -52,7 +52,7 @@ showImp(dom,:options) == domainForm := devaluate dom [nam,:$domainArgs] := domainForm $predicateList: local := getConstructorPredicatesFromDB nam - predVector := vectorRef(dom,3) + predVector := domainPredicates dom u := getDomainOpTable(dom,true) --sort into 4 groups: domain exports, unexports, default exports, others for (x := [.,.,:key]) in u repeat @@ -207,7 +207,7 @@ getDomainSeteltForm ['%store,.,form] == showPredicates dom == sayBrightly '"--------------------Predicate summary-------------------" conname := instantiationCtor dom - predvector := vectorRef(dom,3) + predvector := domainPredicates dom predicateList := getConstructorPredicatesFromDB conname for i in 1.. for p in predicateList repeat prefix := @@ -219,7 +219,7 @@ showAttributes dom == sayBrightly '"--------------------Attribute summary-------------------" conname := instantiationCtor dom abb := getConstructorAbbreviation conname - predvector := vectorRef(dom,3) + predvector := domainPredicates dom for [a,:p] in vectorRef(dom,2) repeat prefix := testBitVector(predvector,p) => '"true : " -- cgit v1.2.3