diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 15 | ||||
| -rw-r--r-- | src/algebra/Makefile.in | 8 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 18 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 28 | ||||
| -rw-r--r-- | src/interp/functor.boot | 2 | ||||
| -rw-r--r-- | src/interp/interop.boot | 4 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 8 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 10 |
8 files changed, 65 insertions, 28 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 1c3822e3..8a0aad99 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,18 @@ +2011-08-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/c-util.boot (instantiationArgs): New. + (domainDirectory): Likewise. + (domainLookupFunction): Likewise. + (domainOperatorTable): Likewise. + (domainAttributes): Likewise. + (domainPredicates): Likewise. + (domainData): Likewise. + * interp/buildom.boot: Use new domain accessors. + * interp/functor.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/nrunfast.boot: Likewise. + 2011-08-12 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/ast.boot (shoeCompTran1): Translate extended vector-forms. diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index bb7f11e7..6ad6e102 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -520,13 +520,17 @@ strap-1/%.$(FASLEXT): %.spad strap-1/.started $(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \ cp $*.NRLIB/code.$(FASLEXT) $@ && \ if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \ - strap-1/$*-.$(FASLEXT); else : ; fi + strap-1/$*-.$(FASLEXT); else : ; fi && \ + if test x@oa_keep_files@ = xyes; then \ + cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi strap-2/%.$(FASLEXT): %.spad strap-2/.started $(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \ cp $*.NRLIB/code.$(FASLEXT) $@ && \ if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \ - strap-2/$*-.$(FASLEXT); else : ; fi + strap-2/$*-.$(FASLEXT); else : ; fi && \ + if test x@oa_keep_files@ = xyes; then \ + cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi SPADFILES= \ diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 514a6312..dd01f4a1 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -175,7 +175,7 @@ lookupInDomainAndDefaults(op,sig,domain,dollar,useDefaults) == basicLookup(op,sig,domain,dollar) == - item := domainRef(domain,1) + item := domainDirectory domain cons? item and first item in '(lookupInDomain lookupInTable) => lookupInDomainVector(op,sig,domain,dollar) ----------new world code follows------------ @@ -332,16 +332,14 @@ Record(:args) == dom := newShell(nargs + 10) -- JHD added an extra slot to cache EQUAL methods canonicalForm(dom) := ["Record", :srcArgs] - domainRef(dom,1) := + domainDirectory(dom) := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], ["~=",[[$Boolean,"$","$"],:0]], ["hash",[[$SingleInteger,"$"],:0]], ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]] - domainRef(dom,2) := nil domainRef(dom,3) := ["RecordCategory",:instantiationArgs dom] domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors] - domainRef(dom,5) := nil for i in $FirstParamSlot.. for a in args repeat domainRef(dom,i) := third a domainRef(dom,$FirstParamSlot + nargs) := [function RecordEqual, :dom] @@ -405,16 +403,14 @@ Union(:args) == nargs := #args dom := newShell (nargs + 9) canonicalForm(dom) := ["Union", :srcArgs] - domainRef(dom,1) := + domainDirectory(dom) := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], ["~=",[[$Boolean,"$","$"],:0]], ["hash", [[$SingleInteger,"$"],:0]], ["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]] - domainRef(dom,2) := nil domainRef(dom,3) := ["UnionCategory",:instantiationArgs dom] domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors] - domainRef(dom,5) := nil for i in $FirstParamSlot.. for a in args repeat domainRef(dom,i) := a domainRef(dom,$FirstParamSlot + nargs) := [function UnionEqual, :dom] @@ -474,16 +470,14 @@ Mapping(:args) == nargs := #args dom := newShell(nargs + 9) canonicalForm(dom) := ["Mapping", :srcArgs] - domainRef(dom,1) := + domainDirectory(dom) := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], ["~=",[[$Boolean,"$","$"],:0]], ["hash", [[$SingleInteger,"$"],:0]], ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]] - domainRef(dom,2) := nil domainRef(dom,3) := $SetCategory domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors] - domainRef(dom,5) := nil for i in $FirstParamSlot.. for a in args repeat domainRef(dom,i) := a domainRef(dom,$FirstParamSlot + nargs) := [function MappingEqual, :dom] @@ -516,7 +510,7 @@ Enumeration(:"args") == dom := newShell(2 * nargs + 9) -- JHD added an extra slot to cache EQUAL methods canonicalForm(dom) := ["Enumeration",:args] - domainRef(dom,1) := + domainDirectory(dom) := ["lookupInTable",dom, [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], ["~=",[[$Boolean,"$","$"],:0]], @@ -526,10 +520,8 @@ Enumeration(:"args") == :[[arg,[["$"],:oldConstantSlodCode(nargs+3+i)]] for arg in args for i in 0..] ]] - domainRef(dom,2) := nil domainRef(dom,3) := ["EnumerationCategory",:instantiationArgs dom] domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors] - domainRef(dom,5) := nil for i in $FirstParamSlot.. for a in args repeat domainRef(dom,i) := a domainRef(dom,$FirstParamSlot + nargs) := [function EnumEqual, :dom] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index f7fd2dc4..db2c8554 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -73,6 +73,10 @@ macro instantiationCtor d == macro instantiationArgs d == canonicalForm(d).args +++ Return the number of arguments used to instantiate a domain object. +macro instantiationArity d == + # instantiationArgs d + ++ Return the list of operations exported by a category object macro categoryExports d == categoryRef(d,1) @@ -85,11 +89,33 @@ macro categoryAttributes d == macro categoryHierarchy c == categoryRef(c,4) +++ Reference a 3-list +++ [lookupFunction,thisDomain,optable] +++ necessary for function lookup in a domain: +macro domainDirectory d == + domainRef(d,1) + +++ Reference the lookup function of a domain object +macro domainLookupFunction d == + first domainDirectory d + +++ Reference the operator-code table of a domain object. +macro domainOperatorTable d == + third domainDirectory d + +++ Reference the list of (attribute, predIndex) pairs for this domain. +macro domainAttributes d == + domainRef(d,2) + ++ Return the predicate values associated with the domain object. ++ This is an integer interpreted as bit vector macro domainPredicates d == domainRef(d,3) +++ Return a 3-element dotted list of address data for a domain. +macro domainData d == + domainRef(d,4) + --% ++ List of category constructors that do not have entries in the @@ -268,7 +294,7 @@ declareUnusedParameters x == (augment x; x) where devaluate d == not vector? d => d - QVSIZE d > 5 and vectorRef(d,3) is ['Category] => canonicalForm d + categoryObject? d => canonicalForm d QVSIZE d > 0 => d' := canonicalForm d isFunctor d' => d' diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 94619b9d..8c6fc79c 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -351,7 +351,7 @@ SetDomainSlots124(vec,names,vals) == l := pairList(names,vals) vectorRef(vec,1) := sublisProp(l,vectorRef(vec,1)) vectorRef(vec,2) := sublisProp(l,vectorRef(vec,2)) - l:= [[a,:devaluate b] for a in names for b in vals] + l := [[a,:devaluate b] for a in names for b in vals] vectorRef(vec,4) := applySubst(l,vectorRef(vec,4)) vectorRef(vec,1) := applySubst(l,vectorRef(vec,1)) diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 6c009c64..28408072 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -521,7 +521,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == nil hashNewLookupInCategories(op,sig,dom,dollar) == - slot4 := vectorRef(dom,4) + slot4 := domainData dom catVec := second slot4 # catVec = 0 => nil --early exit if no categories integer? KDR catVec.0 => @@ -658,7 +658,7 @@ HasCategory(domain,catform') == catform:= devaluate catform' integer? domainRef(domain,3) => newHasCategory(domain,catform) domain0 := canonicalForm domain -- handles old style domains, Record, Union etc. - slot4 := domainRef(domain,4) + slot4 := domainData domain catlist := slot4.1 member(catform,catlist) or opOf(catform) in '(Object Type) or --temporary hack diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 873b9429..527b5bf5 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -424,10 +424,10 @@ stuffDomainSlots dollar == for i in (6 + # rest domname)..maxIndex template | item := vectorRef(template,i) repeat stuffSlot(dollar,i,item) - vectorRef(dollar,1) := LIST(lookupFunction,dollar,infovec.1) - vectorRef(dollar,2) := infovec.2 + domainDirectory(dollar) := LIST(lookupFunction,dollar,infovec.1) + domainAttributes(dollar) := infovec.2 proto4 := infovec.3 - vectorRef(dollar,4) := + domainData(dollar) := vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4] --old style bitVector := domainPredicates dollar predvec := first proto4 @@ -443,7 +443,7 @@ getLookupFun infovec == makeSpadConstant [fn,dollar,slot] == val := FUNCALL(fn,dollar) - u := vectorRef(dollar,slot) + u := domainRef(dollar,slot) u.first := function IDENTITY u.rest := val val diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 23614946..b679ec8b 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -61,12 +61,12 @@ initNewWorld() == $doNotCompressHashTableIfTrue := true getDomainByteVector dom == - CDDR domainRef(dom,4) + CDDR domainData dom ++ Return the sequence of categories `dom' belongs to, as a vector ++ of lazy category forms. getDomainCategoriesVector dom == - second domainRef(dom,4) + second domainData dom ++ Same as getDomainCategoriesVector except that we return a list of ++ input forms for the categories. @@ -266,7 +266,7 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) == -- Category Default Lookup (from goGet or lookupInAddChain) --======================================================= newLookupInCategories(op,sig,dom,dollar) == - slot4 := domainRef(dom,4) + slot4 := domainData dom catVec := second slot4 # catVec = 0 => nil --early exit if no categories integer? KDR canonicalForm catVec => @@ -338,7 +338,7 @@ newLookupInCategories1(op,sig,dom,dollar) == if $monitorNewWorld then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) predvec := domainPredicates dom - slot4 := domainRef(dom,4) + slot4 := domainData dom packageVec := first slot4 catVec := second slot4 --the next three lines can go away with new category world @@ -493,7 +493,7 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) == lookupInDomainByName(op,domain,arg) == arg isnt [.,:.] => nil - opvec := domainRef(domain,1) . 2 + opvec := domainOperatorTable domain numvec := getDomainByteVector domain predvec := domainPredicates domain max := maxIndex opvec |