From 927875aade5720ec0e0cfbe741988011a604678f Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 2 May 2011 05:07:58 +0000 Subject: * interp/c-util.boot (categoryRef, domainRef, canonicalForm) (instantiatorCtor, instantiatorArgs, categoryExports): New. --- src/ChangeLog | 5 ++++ src/interp/Makefile.in | 74 +++++++++++++++++++---------------------------- src/interp/br-con.boot | 2 -- src/interp/br-data.boot | 4 --- src/interp/br-prof.boot | 2 -- src/interp/br-saturn.boot | 1 - src/interp/br-search.boot | 2 -- src/interp/br-util.boot | 2 -- src/interp/buildom.boot | 50 +++++++++++++++++--------------- src/interp/c-util.boot | 32 ++++++++++++++++++-- src/interp/category.boot | 8 ++--- src/interp/define.boot | 6 ++-- src/interp/i-object.boot | 2 +- src/interp/i-output.boot | 5 ++-- src/interp/i-util.boot | 2 +- src/interp/incl.boot | 3 +- src/interp/newfort.boot | 2 +- src/interp/nrunfast.boot | 12 ++++---- src/interp/showimp.boot | 13 ++++----- 19 files changed, 117 insertions(+), 110 deletions(-) (limited to 'src') 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 + + * interp/c-util.boot (categoryRef, domainRef, canonicalForm) + (instantiatorCtor, instantiatorArgs, categoryExports): New. + 2011-05-01 Gabriel Dos Reis * 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 ( ) 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 -- cgit v1.2.3