aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog15
-rw-r--r--src/algebra/Makefile.in8
-rw-r--r--src/interp/buildom.boot18
-rw-r--r--src/interp/c-util.boot28
-rw-r--r--src/interp/functor.boot2
-rw-r--r--src/interp/interop.boot4
-rw-r--r--src/interp/nruncomp.boot8
-rw-r--r--src/interp/nrunfast.boot10
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