aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog5
-rw-r--r--src/interp/Makefile.in74
-rw-r--r--src/interp/br-con.boot2
-rw-r--r--src/interp/br-data.boot4
-rw-r--r--src/interp/br-prof.boot2
-rw-r--r--src/interp/br-saturn.boot1
-rw-r--r--src/interp/br-search.boot2
-rw-r--r--src/interp/br-util.boot2
-rw-r--r--src/interp/buildom.boot50
-rw-r--r--src/interp/c-util.boot32
-rw-r--r--src/interp/category.boot8
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/i-object.boot2
-rw-r--r--src/interp/i-output.boot5
-rw-r--r--src/interp/i-util.boot2
-rw-r--r--src/interp/incl.boot3
-rw-r--r--src/interp/newfort.boot2
-rw-r--r--src/interp/nrunfast.boot12
-rw-r--r--src/interp/showimp.boot13
19 files changed, 117 insertions, 110 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index a6f84486..1a6c0202 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/c-util.boot (categoryRef, domainRef, canonicalForm)
+ (instantiatorCtor, instantiatorArgs, categoryExports): New.
+
2011-05-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/parser.boot (bpDefinition): Accept macro definition
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 8ee22543..ebef3356 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -65,62 +65,48 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
union.$(FASLEXT) sys-macros.$(FASLEXT) \
macros.$(FASLEXT) metalex.$(FASLEXT) \
parsing.$(FASLEXT) util.$(FASLEXT) \
- unlisp.$(FASLEXT) \
- astr.$(FASLEXT) bits.$(FASLEXT) \
+ unlisp.$(FASLEXT) g-util.$(FASLEXT) \
+ g-opt.$(FASLEXT) c-util.$(FASLEXT) \
+ astr.$(FASLEXT) bits.$(FASLEXT) \
ht-util.$(FASLEXT) bc-util.$(FASLEXT) \
- br-search.$(FASLEXT) \
- alql.$(FASLEXT) buildom.$(FASLEXT) \
- g-util.$(FASLEXT) hashcode.$(FASLEXT) \
+ br-search.$(FASLEXT) alql.$(FASLEXT) \
+ buildom.$(FASLEXT) hashcode.$(FASLEXT) \
simpbool.$(FASLEXT) g-timer.$(FASLEXT) \
cattable.$(FASLEXT) posit.$(FASLEXT) \
- cformat.$(FASLEXT) \
- clam.$(FASLEXT) \
+ cformat.$(FASLEXT) clam.$(FASLEXT) \
clammed.$(FASLEXT) nlib.$(FASLEXT) \
- comp.$(FASLEXT) foam_l.$(FASLEXT) \
- pathname.$(FASLEXT) \
- compat.$(FASLEXT) \
+ comp.$(FASLEXT) foam_l.$(FASLEXT) \
+ pathname.$(FASLEXT) compat.$(FASLEXT) \
serror.$(FASLEXT) ptrees.$(FASLEXT) \
cparse.$(FASLEXT) cstream.$(FASLEXT) \
g-cndata.$(FASLEXT) database.$(FASLEXT) \
debug.$(FASLEXT) dq.$(FASLEXT) \
fname.$(FASLEXT) format.$(FASLEXT) \
- g-error.$(FASLEXT) g-opt.$(FASLEXT) \
- ggreater.$(FASLEXT) \
- hypertex.$(FASLEXT) \
- i-object.$(FASLEXT) i-analy.$(FASLEXT) \
- i-resolv.$(FASLEXT) \
- i-coerce.$(FASLEXT) \
- i-coerfn.$(FASLEXT) i-eval.$(FASLEXT) \
- i-funsel.$(FASLEXT) \
+ g-error.$(FASLEXT) ggreater.$(FASLEXT) \
+ hypertex.$(FASLEXT) i-object.$(FASLEXT) \
+ i-analy.$(FASLEXT) i-resolv.$(FASLEXT) \
+ i-coerce.$(FASLEXT) i-coerfn.$(FASLEXT) \
+ i-eval.$(FASLEXT) i-funsel.$(FASLEXT) \
i-intern.$(FASLEXT) i-map.$(FASLEXT) \
- i-output.$(FASLEXT) \
- i-special.$(FASLEXT) \
- i-syscmd.$(FASLEXT) \
- i-toplev.$(FASLEXT) i-util.$(FASLEXT) \
- incl.$(FASLEXT) int-top.$(FASLEXT) \
- intfile.$(FASLEXT) c-util.$(FASLEXT) \
+ i-output.$(FASLEXT) i-special.$(FASLEXT) \
+ i-syscmd.$(FASLEXT) i-toplev.$(FASLEXT) \
+ i-util.$(FASLEXT) incl.$(FASLEXT) \
+ int-top.$(FASLEXT) intfile.$(FASLEXT) \
lisplib.$(FASLEXT) macex.$(FASLEXT) \
- match.$(FASLEXT) \
- monitor.$(FASLEXT) msg.$(FASLEXT) \
- msgdb.$(FASLEXT) \
+ match.$(FASLEXT) monitor.$(FASLEXT) \
+ msg.$(FASLEXT) msgdb.$(FASLEXT) \
newaux.$(FASLEXT) newfort.$(FASLEXT) \
- nrunfast.$(FASLEXT) \
- osyscmd.$(FASLEXT) \
- packtran.$(FASLEXT) \
- pf2sex.$(FASLEXT) \
+ nrunfast.$(FASLEXT) osyscmd.$(FASLEXT) \
+ packtran.$(FASLEXT) pf2sex.$(FASLEXT) \
scan.$(FASLEXT) pile.$(FASLEXT) \
- property.$(FASLEXT) \
- postpar.$(FASLEXT) parse.$(FASLEXT) \
- spad-parser.$(FASLEXT) \
- record.$(FASLEXT) \
- rulesets.$(FASLEXT) \
- server.$(FASLEXT) \
- setvars.$(FASLEXT) \
+ property.$(FASLEXT) postpar.$(FASLEXT) \
+ parse.$(FASLEXT) spad-parser.$(FASLEXT) \
+ record.$(FASLEXT) rulesets.$(FASLEXT) \
+ server.$(FASLEXT) setvars.$(FASLEXT) \
sfsfun-l.$(FASLEXT) sfsfun.$(FASLEXT) \
slam.$(FASLEXT) fnewmeta.$(FASLEXT) \
preparse.$(FASLEXT) bootlex.$(FASLEXT) \
- spad.$(FASLEXT) \
- spaderror.$(FASLEXT) \
+ spad.$(FASLEXT) spaderror.$(FASLEXT) \
termrw.$(FASLEXT) \
trace.$(FASLEXT) daase.$(FASLEXT) \
fortcall.$(FASLEXT) i-parser.$(FASLEXT) \
@@ -329,8 +315,8 @@ i-coerce.$(FASLEXT): i-analy.$(FASLEXT) i-resolv.$(FASLEXT)
i-resolv.$(FASLEXT): i-object.$(FASLEXT)
i-analy.$(FASLEXT): i-object.$(FASLEXT)
i-intern.$(FASLEXT): i-object.$(FASLEXT) ptrees.$(FASLEXT)
-i-object.$(FASLEXT): g-util.$(FASLEXT)
-i-util.$(FASLEXT): g-util.$(FASLEXT)
+i-object.$(FASLEXT): i-util.$(FASLEXT)
+i-util.$(FASLEXT): c-util.$(FASLEXT)
format.$(FASLEXT): macros.$(FASLEXT)
match.$(FASLEXT): sys-macros.$(FASLEXT)
record.$(FASLEXT): nlib.$(FASLEXT) pathname.$(FASLEXT)
@@ -346,7 +332,7 @@ define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \
database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
functor.$(FASLEXT): category.$(FASLEXT) interop.$(FASLEXT) lisplib.$(FASLEXT)
-category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
+category.$(FASLEXT): c-util.$(FASLEXT) g-cndata.$(FASLEXT)
cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
compat.$(FASLEXT): pathname.$(FASLEXT)
simpbool.$(FASLEXT): macros.$(FASLEXT)
@@ -442,7 +428,7 @@ msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
util.$(FASLEXT): parsing.$(FASLEXT)
fname.$(FASLEXT): macros.$(FASLEXT)
sys-macros.$(FASLEXT): diagnostics.$(FASLEXT) union.$(FASLEXT)
-buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT)
+buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) c-util.$(FASLEXT)
diagnostics.$(FASLEXT): sys-globals.$(FASLEXT) vmlisp.$(FASLEXT)
sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT)
sys-globals.$(FASLEXT): sys-constants.$(FASLEXT) hash.$(FASLEXT)
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index c7cfbf86..5d54af01 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -36,8 +36,6 @@ import bc_-util
namespace BOOT
---====================> WAS b-con.boot <================================
-
--=======================================================================
-- Pages Initiated from HyperDoc Pages
--=======================================================================
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 394d3d95..d6573a58 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -38,10 +38,6 @@ namespace BOOT
lefts u ==
[x for x in HKEYS _*HASCATEGORY_-HASH_* | rest x = u]
-
-
---====================> WAS b-data.boot <================================
-
--============================================================================
-- Build Library Database (libdb.text,...)
--============================================================================
diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot
index 149e63a0..dfd58e59 100644
--- a/src/interp/br-prof.boot
+++ b/src/interp/br-prof.boot
@@ -35,8 +35,6 @@
import bc_-util
namespace BOOT
---====================> WAS b-prof.boot <================================
-
--============================================================================
-- Browser Code for Profiling
--============================================================================
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index bcc85827..e636210a 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -35,7 +35,6 @@
import bc_-util
namespace BOOT
---====================> WAS b-saturn.boot <================================
-- New file as of 6/95
$aixTestSaturn := false
--These will be set in patches.lisp:
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 8dd863a6..4a6c3e9a 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -35,8 +35,6 @@
import bc_-util
namespace BOOT
---====================> WAS b-search.boot <================================
-
--=======================================================================
-- Grepping Database libdb.text
-- Redone 12/95 for Saturn; previous function grep renamed as grepFile
diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot
index 8382d0d7..89600577 100644
--- a/src/interp/br-util.boot
+++ b/src/interp/br-util.boot
@@ -35,8 +35,6 @@
import bc_-util
namespace BOOT
---====================> WAS b-util.boot <================================
-
--=======================================================================
-- AXIOM Browser
-- Initial entry is from man0.ht page to one of these functions:
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 13fda91a..f1b042c4 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -41,6 +41,7 @@
-- GDR, March 2008.
import sys_-macros
+import c_-util
namespace BOOT
$noCategoryDomains == '(Mode SubDomain)
@@ -111,7 +112,7 @@ lazyCompareSigEqual(s,tslot,dollar,domain) ==
integer? tslot and cons?(lazyt:=domain.tslot) and cons? s =>
lazyt is [.,.,.,[.,item,.]] and
item is [.,[functorName,:.]] and functorName = first s =>
- compareSigEqual(s,(evalDomain lazyt).0,dollar,domain)
+ compareSigEqual(s,canonicalForm evalDomain lazyt,dollar,domain)
nil
compareSigEqual(s,NRTreplaceLocalTypes(tslot,domain),dollar,domain)
@@ -122,8 +123,9 @@ compareSigEqual(s,t,dollar,domain) ==
u :=
t='$ => dollar
isSharpVar t =>
- vector? domain => rest(domain.0).(POSN1(t,$FormalMapVariableList))
- rest(domain).(POSN1(t,$FormalMapVariableList))
+ vector? domain =>
+ instantiationArgs(domain).(POSN1(t,$FormalMapVariableList))
+ domain.args.(POSN1(t,$FormalMapVariableList))
string? t and IDENTP s => (s := symbolName s; t)
nil
s is '$ => compareSigEqual(dollar,u,dollar,domain)
@@ -171,7 +173,7 @@ compiledLookupCheck(op,sig,dollar) ==
-- NEW COMPILER COMPATIBILITY OFF
fn = nil =>
- keyedSystemError("S2NR0001",[op,formatSignature sig,dollar.0])
+ keyedSystemError("S2NR0001",[op,formatSignature sig,canonicalForm dollar])
fn
--=======================================================
@@ -209,7 +211,7 @@ NRTreplaceLocalTypes(t,dom) ==
not integer? t => t
t:= dom.t
if cons? t then t:= evalDomain t
- t.0
+ canonicalForm t
first t in '(Mapping Union Record _:) =>
[first t,:[NRTreplaceLocalTypes(x,dom) for x in rest t]]
t
@@ -224,7 +226,7 @@ substDomainArgs(domain,object) ==
lookupInCategories(op,sig,dom,dollar) ==
catformList := dom.4.0
varList := ["$",:$FormalMapVariableList]
- nsig := MSUBST(dom.0,dollar.0,sig)
+ nsig := MSUBST(canonicalForm dom,canonicalForm dollar,sig)
-- the following lines don't need to check for predicates because
-- this code (the old runtime scheme) is used only for
-- builtin constructors -- their predicates are always true.
@@ -239,10 +241,10 @@ lookupInCategories(op,sig,dom,dollar) ==
-- Lookup Addlist (from lookupInDomainTable or lookupInDomain)
--=======================================================
defaultingFunction op ==
- not(op is [.,:dom]) => false
+ op isnt [.,:dom] => false
not vector? dom => false
not (#dom > 0) => false
- not (dom.0 is [packageName,:.]) => false
+ canonicalForm dom isnt [packageName,:.] => false
not IDENTP packageName => false
isDefaultPackageName packageName
@@ -261,10 +263,10 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
someMatch := false
while not success for [sig1,:code] in LASSQ(op,table) repeat
success :=
- not compareSig(sig,sig1,dollar.0,domain) => false
+ not compareSig(sig,sig1,canonicalForm dollar,domain) => false
code is ['subsumed,a] =>
subsumptionSig :=
- applySubst(pairList($FormalMapVariableList,vectorRef(domain,0).args),a)
+ applySubst(pairList($FormalMapVariableList,canonicalForm(domain).args),a)
someMatch := true
false
predIndex := code quo 8192
@@ -309,7 +311,7 @@ Record(:args) ==
nargs := #args
dom := newShell(nargs + 10)
-- JHD added an extra slot to cache EQUAL methods
- vectorRef(dom,0) := ["Record", :srcArgs]
+ canonicalForm(dom) := ["Record", :srcArgs]
vectorRef(dom,1) :=
["lookupInTable",dom,
[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
@@ -317,7 +319,7 @@ Record(:args) ==
["hash",[[$SingleInteger,"$"],:0]],
["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
vectorRef(dom,2) := nil
- vectorRef(dom,3) := ["RecordCategory",:rest dom.0]
+ vectorRef(dom,3) := ["RecordCategory",:instantiationArgs dom]
vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
vectorRef(dom,5) := nil
for i in $FirstParamSlot.. for a in args repeat
@@ -332,7 +334,7 @@ Record(:args) ==
dom
RecordEqual(x,y,dom) ==
- nargs := #rest(dom.0)
+ nargs := #instantiationArgs dom
cons? x =>
b:=
SPADCALL(first x, first y, first(dom.(nargs + 9)) or
@@ -381,7 +383,7 @@ Union(:args) ==
for a in args]
nargs := #args
dom := newShell (nargs + 9)
- vectorRef(dom,0) := ["Union", :srcArgs]
+ canonicalForm(dom) := ["Union", :srcArgs]
vectorRef(dom,1) :=
["lookupInTable",dom,
[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
@@ -389,7 +391,7 @@ Union(:args) ==
["hash", [[$SingleInteger,"$"],:0]],
["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]]
vectorRef(dom,2) := nil
- vectorRef(dom,3) := ["UnionCategory",:rest dom.0]
+ vectorRef(dom,3) := ["UnionCategory",:instantiationArgs dom]
vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
vectorRef(dom,5) := nil
for i in $FirstParamSlot.. for a in args repeat
@@ -400,7 +402,7 @@ Union(:args) ==
dom
UnionEqual(x, y, dom) ==
- ["Union",:branches] := vectorRef(dom,0)
+ ["Union",:branches] := canonicalForm dom
predlist := mkPredList branches
same := false
for b in stripUnionTags branches for p in predlist while not same repeat
@@ -411,7 +413,7 @@ UnionEqual(x, y, dom) ==
same := SPADCALL(x, y, findEqualFun(evalDomain b))
same
-UnionPrint(x, dom) == coerceUn2E(x, dom.0)
+UnionPrint(x, dom) == coerceUn2E(x, canonicalForm dom)
coerceUn2E(x,source) ==
["Union",:branches] := source
@@ -442,14 +444,14 @@ MappingCategory(:"sig") ==
['mkCategory,quoteForm 'domain,
quoteForm [[['elt,[first sig,'$,:rest sig]],true]],
[], [], nil]]
- vectorRef(cat,0) := ['MappingCategory,:sig]
+ canonicalForm(cat) := ['MappingCategory,:sig]
cat
Mapping(:args) ==
srcArgs := [devaluate a for a in args]
nargs := #args
dom := newShell(nargs + 9)
- vectorRef(dom,0) := ["Mapping", :srcArgs]
+ canonicalForm(dom) := ["Mapping", :srcArgs]
vectorRef(dom,1) :=
["lookupInTable",dom,
[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
@@ -483,7 +485,7 @@ Enumeration(:"args") ==
nargs := #args
dom := newShell(nargs + 9)
-- JHD added an extra slot to cache EQUAL methods
- vectorRef(dom,0) := ["Enumeration", :args]
+ canonicalForm(dom) := ["Enumeration", :args]
vectorRef(dom,1) :=
["lookupInTable",dom,
[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
@@ -493,7 +495,7 @@ Enumeration(:"args") ==
[["$", $Symbol], :oldSlotCode(nargs+2)]]
]]
vectorRef(dom,2) := nil
- vectorRef(dom,3) := ["EnumerationCategory",:rest dom.0]
+ vectorRef(dom,3) := ["EnumerationCategory",:instantiationArgs dom]
vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
vectorRef(dom,5) := nil
for i in $FirstParamSlot.. for a in args repeat dom.i := a
@@ -506,10 +508,10 @@ EnumEqual(e1,e2,dom) ==
e1=e2
EnumPrint(enum, dom) ==
- rest(vectorRef(dom,0)).enum
+ instantiationArgs(dom).enum
createEnum(sym, dom) ==
- args := vectorRef(dom,0).args
+ args := instantiationArgs dom
val := -1
for v in args for i in 0.. repeat
sym=v => return(val:=i)
@@ -532,7 +534,7 @@ constructorCategory (title is [op,:.]) ==
cat:=
JoinInner([eval $SetCategory,mkCategory("domain",oplist,nil,nil,nil)],
$EmptyEnvironment)
- vectorRef(cat,0) := title
+ canonicalForm(cat) := title
cat
--mkMappingFunList(nam,mapForm,e) == [[],e]
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index a96c8693..7fd42c62 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -49,6 +49,34 @@ module c_-util where
-- functor data manipulation
dbInfovec: %Constructor -> %Maybe %FunctorData
+--% Accessors of domain and category objects
+
+++ Return thr i-th part of a category object
+macro categoryRef(c,i) ==
+ vectorRef(c,i)
+
+++ Return the i-th part of a domain object.
+macro domainRef(d,i) ==
+ vectorRef(d,i)
+
+++ Return the canonical form for a domain or category object
+macro canonicalForm d ==
+ vectorRef(d,0)
+
+++ Return the constructor that instantiates to the domain
+++ or category object
+macro instantiationCtor d ==
+ canonicalForm(d).op
+
+++ Return the canonical forms of the arguments used to instantiate
+++ a domain or a category object.
+macro instantiationArgs d ==
+ canonicalForm(d).args
+
+++ Return the list of operations exported by a category object
+macro categoryExports d ==
+ categoryRef(d,1)
+
--%
$SetCategory ==
'(SetCategory)
@@ -191,9 +219,9 @@ declareUnusedParameters x == (augment x; x) where
devaluate d ==
not vector? d => d
- QVSIZE d > 5 and vectorRef(d,3) is ['Category] => vectorRef(d,0)
+ QVSIZE d > 5 and vectorRef(d,3) is ['Category] => canonicalForm d
QVSIZE d > 0 =>
- d' := vectorRef(d,0)
+ d' := canonicalForm d
isFunctor d' => d'
d
d
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 0d8ebcb1..63b4fb2e 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -32,7 +32,7 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-import g_-util
+import c_-util
import g_-cndata
namespace BOOT
@@ -65,7 +65,7 @@ isCategoryForm(x,e) ==
CategoryPrint(D,$e) ==
SAY "--------------------------------------"
SAY "Name (and arguments) of category:"
- PRETTYPRINT D.0
+ PRETTYPRINT canonicalForm D
SAY "operations:"
PRETTYPRINT D.1
SAY "attributes:"
@@ -135,7 +135,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
count := count+1
-- Build a fresh category object stuffed with all updated information
v := newShell count
- v.0 := nil
+ canonicalForm(v) := nil
v.1 := sigList
v.2 := attList
v.3 := $Category
@@ -329,7 +329,7 @@ FindFundAncs l ==
--also as two-lists with the appropriate conditions
l=nil => nil
f1:= CatEval CAAR l
- f1.0=nil => FindFundAncs rest l
+ canonicalForm f1 = nil => FindFundAncs rest l
ans:= FindFundAncs rest l
for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,second x)]
for x in second f1.4] repeat
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 896e78aa..edc5af92 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1164,9 +1164,9 @@ genDomainViewList(id,catlist) ==
mkOpVec(dom,siglist) ==
dom:= getPrincipalView dom
- substargs := [['$,:vectorRef(dom,0)],
- :pairList($FormalMapVariableList,vectorRef(dom,0).args)]
- oplist:= getConstructorOperationsFromDB opOf dom.0
+ substargs := [['$,:canonicalForm dom],
+ :pairList($FormalMapVariableList,instantiationArgs dom)]
+ oplist:= getConstructorOperationsFromDB instantiationCtor dom
--new form is (<op> <signature> <slotNumber> <condition> <kind>)
ops := newVector #siglist
for (opSig:= [op,sig]) in siglist for i in 0.. repeat
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index fed81896..882007b7 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -31,7 +31,7 @@
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-import g_-util
+import i_-util
namespace BOOT
++ true when the interpreter should evaluate forms to values, as
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 2c3ec427..c273c668 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -168,7 +168,8 @@ $plainRTspecialCharacters == [
++ Stream in lean mode.
$RecordSeparator == abstractChar 30
-makeCharacter n ==> makeSymbol(charString abstractChar n)
+macro makeCharacter n ==
+ makeSymbol(charString abstractChar n)
$RTspecialCharacters == [
makeCharacter 218, -- upper left corner (+)
@@ -1331,7 +1332,7 @@ bigopWidth(bot,top,arg,kind) ==
kindWidth := (kind = 'pi => 5; 3)
MAX(kindWidth,WIDTH bot,(top => WIDTH top; 0)) + 2 + WIDTH arg
-half x ==>
+macro half x ==
x quo 2
bigopAppAux(bot,top,arg,x,y,d,kind) ==
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index a7266f89..e51a5702 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -32,7 +32,7 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-import g_-util
+import c_-util
namespace BOOT
module i_-util
diff --git a/src/interp/incl.boot b/src/interp/incl.boot
index 7a68d933..ae32e0bf 100644
--- a/src/interp/incl.boot
+++ b/src/interp/incl.boot
@@ -257,7 +257,8 @@ xlIfSyntax(eb, str, lno,ufos,info,sts) ==
incLude(eb, ss, ln, ufos, states) ==
Delay(function incLude1,[eb, ss, ln, ufos, states])
-Rest s ==> incLude (eb,rest ss,lno,ufos,states)
+macro Rest s ==
+ incLude (eb,rest ss,lno,ufos,states)
incLude1(eb,ss,ln,ufos,states) ==
$inputLineNumber := ln
diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot
index 43ad03c0..7aba6f9e 100644
--- a/src/interp/newfort.boot
+++ b/src/interp/newfort.boot
@@ -675,7 +675,7 @@ mkParameterList l ==
apply(function strconc,[STRINGIMAGE(first u),'"(",_
:rest [:['",",:statement2Fortran(v)] for v in rest u],'")"])
-nameLen n ==>
+macro nameLen n ==
+/[1+#(u) for u in n]
fortFormatTypes(typeName,names) ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 6691b34d..cd86d3e2 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -304,7 +304,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
slot4 := vectorRef(dom,4)
catVec := second slot4
# catVec = 0 => nil --early exit if no categories
- integer? KDR vectorRef(catVec,0) =>
+ integer? KDR canonicalForm catVec =>
newLookupInCategories1(op,sig,dom,dollar) --old style
$lookupDefaults : local := nil
if $monitorNewWorld = true then sayBrightly concat('"----->",
@@ -315,7 +315,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
varList := ['$,:$FormalMapVariableList]
valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]]
valueList := [MKQ val for val in valueList]
- nsig := MSUBST(dom.0,dollar.0,sig)
+ nsig := MSUBST(canonicalForm dom,canonicalForm dollar,sig)
for i in 0..maxIndex packageVec |
(entry := vectorRef(packageVec,i)) and entry isnt 'T repeat
package :=
@@ -391,9 +391,9 @@ newLookupInCategories1(op,sig,dom,dollar) ==
catVec := second slot4
--the next three lines can go away with new category world
varList := ['$,:$FormalMapVariableList]
- valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]]
+ valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(#instantiationArgs dom)]]
valueList := [MKQ val for val in valueList]
- nsig := MSUBST(dom.0,dollar.0,sig)
+ nsig := MSUBST(canonicalForm dom,canonicalForm dollar,sig)
for i in 0..maxIndex packageVec | (entry := vectorRef(packageVec,i))
and (vector? entry or (predIndex := rest (node := catVec.i)) and
(predIndex = 0 or testBitVector(predvec,predIndex))) repeat
@@ -586,7 +586,7 @@ newExpandTypeSlot(slot, dollar, domain) ==
newExpandLocalType(lazyt,dollar,domain) ==
- vector? lazyt => lazyt.0
+ vector? lazyt => canonicalForm lazyt
atom lazyt => lazyt
lazyt is [vec,.,:lazyForm] and vector? vec => --old style
newExpandLocalTypeForm(lazyForm,dollar,domain)
@@ -611,7 +611,7 @@ newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
vectorRef(domain,u)
u is ['NRTEVAL,y] => nrtEval(y,domain)
u is ['QUOTE,y] => y
- u is "$$" => vectorRef(domain,0)
+ u is "$$" => canonicalForm domain
atom u => u --can be first, rest, etc.
newExpandLocalTypeForm(u,dollar,domain)
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 1b13836a..0b7cf13e 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -112,14 +112,12 @@ showFrom(D,:option) ==
-- Functions implementing showFrom
--=======================================================================
getDomainOps D ==
- domname := D.0
- conname := first domname
+ conname := insantiationCtor D
$predicateList: local := getConstructorPredicatesFromDB conname
removeDuplicates listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil))
getDomainSigs(D,:option) ==
- domname := D.0
- conname := first domname
+ conname := instantiationCtor D
$predicateList: local := getConstructorPredicatesFromDB conname
getDomainSigs1(D,first option)
@@ -128,8 +126,7 @@ getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where
| null ops or symbolMember?(first x,ops)]
getDomainDocs(D,:option) ==
- domname := D.0
- conname := first domname
+ conname := instantiationCtor D
$predicateList: local := getConstructorPredicatesFromDB conname
ops := KAR option
[[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)]
@@ -209,7 +206,7 @@ getDomainSeteltForm ['%store,.,form] ==
showPredicates dom ==
sayBrightly '"--------------------Predicate summary-------------------"
- conname := vectorRef(dom,0).op
+ conname := instantiationCtor dom
predvector := vectorRef(dom,3)
predicateList := getConstructorPredicatesFromDB conname
for i in 1.. for p in predicateList repeat
@@ -220,7 +217,7 @@ showPredicates dom ==
showAttributes dom ==
sayBrightly '"--------------------Attribute summary-------------------"
- conname := vectorRef(dom,0).op
+ conname := instantiationCtor dom
abb := getConstructorAbbreviation conname
predvector := vectorRef(dom,3)
for [a,:p] in vectorRef(dom,2) repeat
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 05:34:21 +0000