diff options
author | dos-reis <gdr@axiomatics.org> | 2011-02-22 20:06:03 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-02-22 20:06:03 +0000 |
commit | a886a6f8ac9b0bfd65611631875a119693f6c84a (patch) | |
tree | f831563f180ae375afafcba9e355afd29ba57eda /src/interp | |
parent | 063103a398ab7b1fdef378a2128fa1c9da2f070e (diff) | |
download | open-axiom-a886a6f8ac9b0bfd65611631875a119693f6c84a.tar.gz |
* boot/tokens.boot: mmSource is a new selector for modemap datatype.
* interp/wi1.boot: Likewise.
* interp/br-data.boot: Various cleanups.
* interp/c-util.boot: Likewise.
* interp/compiler.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/guess.boot: Likewise.
* interp/i-util.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/msgdb.boot: Likewise.
* interp/topics.boot: Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/br-data.boot | 4 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 4 | ||||
-rw-r--r-- | src/interp/compiler.boot | 109 | ||||
-rw-r--r-- | src/interp/functor.boot | 2 | ||||
-rw-r--r-- | src/interp/g-util.boot | 4 | ||||
-rw-r--r-- | src/interp/guess.boot | 6 | ||||
-rw-r--r-- | src/interp/i-output.boot | 4 | ||||
-rw-r--r-- | src/interp/i-util.boot | 2 | ||||
-rw-r--r-- | src/interp/mark.boot | 8 | ||||
-rw-r--r-- | src/interp/msgdb.boot | 4 | ||||
-rw-r--r-- | src/interp/topics.boot | 2 | ||||
-rw-r--r-- | src/interp/wi1.boot | 2 | ||||
-rw-r--r-- | src/interp/wi2.boot | 2 |
13 files changed, 75 insertions, 78 deletions
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index b63560da..ef6a6972 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -745,7 +745,7 @@ sublisFormal(args,exp,:options) == main where y := rest y r := nreverse acc if y then - nd := LASTNODE r + nd := lastNode r nd.rest := sublisFormal1(args,y,n) r IDENTP x => diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 734c4936..1a49bd7c 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -505,9 +505,9 @@ checkGetStringBeforeRightBrace u == -- nreverse acc appendOver [head,:tail] == - acc := LASTNODE head + acc := lastNode head for x in tail repeat - end := LASTNODE x + end := lastNode x acc.rest := x acc := end head diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index b3e48cf7..f9e4256f 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -376,7 +376,7 @@ extractCodeAndConstructTriple(u, m, oldE) == compExpression(x,m,e) == $insideExpressionIfTrue: local:= true -- special forms have dedicated compilers. - (op := x.op) and IDENTP op and (fn := GET(op,"SPECIAL")) => + (op := x.op) and IDENTP op and (fn := property(op,'SPECIAL)) => FUNCALL(fn,x,m,e) compForm(x,m,e) @@ -385,8 +385,8 @@ compExpression(x,m,e) == compAtomWithModemap: (%Symbol,%Mode,%Env,%List) -> %Maybe %Triple compAtomWithModemap(x,m,e,mmList) == -- 1. Get out of here f `x' cannot possibly be a constant. - mmList := [mm for mm in mmList | second mm is [.,["CONST",:.]]] - null mmList => nil + mmList := [mm for mm in mmList | mm.mmImplementation is ['CONST,:.]] + mmList = nil => nil -- 2. If the context is not specified, give up on ambigiuity. $compUniquelyIfTrue: local := m = $EmptyMode or m = $NoValueMode CATCH("compUniquely", compForm3([x],m,e,mmList)) @@ -504,9 +504,9 @@ compForm1(form is [op,:argl],m,e) == -- since addDomain refuses to add modemaps from Mapping (domain is ['Mapping,:.]) and (ans := compForm2([op',:argl],m,e:= augModemapsFromDomain1(domain,domain,e), - [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]])) => ans + [x for x in getFormModemaps([op',:argl],e) | x.mmDC = domain])) => ans ans := compForm2([op',:argl],m,e:= addDomain(domain,e), - [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]]) => ans + [x for x in getFormModemaps([op',:argl],e) | x.mmDC = domain]) => ans (op'="construct") and coerceable(domain,m,e) => (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m)) nil @@ -515,10 +515,9 @@ compForm1(form is [op,:argl],m,e) == compToApply(op,argl,m,e) compForm2(form is [op,:argl],m,e,modemapList) == - sargl:= TAKE(# argl, $TriangleVariableList) - aList:= [[sa,:a] for a in argl for sa in sargl] - modemapList:= SUBLIS(aList,modemapList) - deleteList:=[] + aList := pairList($TriangleVariableList,argl) + modemapList := SUBLIS(aList,modemapList) + deleteList := [] newList := [] -- now delete any modemaps that are subsumed by something else, -- provided the conditions are right (i.e. subsumer true @@ -526,10 +525,10 @@ compForm2(form is [op,:argl],m,e,modemapList) == for u in modemapList repeat if u is [[dc,:.],[cond,["Subsumed",.,nsig]]] and (v:=assoc([dc,:nsig],modemapList)) and v is [.,[ncond,:.]] then - deleteList:=[u,:deleteList] + deleteList := [u,:deleteList] if not PredImplies(ncond,cond) then newList := [[first u,[cond,['ELT,dc,nil]]],:newList] - if deleteList then + if deleteList ~= nil then modemapList := [u for u in modemapList | not MEMQ(u,deleteList)] -- We can use MEMQ since deleteList was built out of members of modemapList -- its important that subsumed ops (newList) be considered last @@ -539,16 +538,17 @@ compForm2(form is [op,:argl],m,e,modemapList) == -- The calling convention vector is used to determine when it is -- appropriate to infer type by compiling the argument vs. just -- looking up the parameter type for flag arguments. - cc := checkCallingConvention([sig for [[.,:sig],:.] in modemapList], #argl) - Tl:= - [[.,.,e]:= T for x in argl for i in 0.. + cc := checkCallingConvention([mm.mmSignature for mm in modemapList], #argl) + Tl := + [[.,.,e] := T for x in argl for i in 0.. while (T := inferMode(x,cc.i > 0,e))] where inferMode(x,flag,e) == flag => [x,quasiquote x,e] - isSimple x and compUniquely(x,$EmptyMode,e) + isSimple x => compUniquely(x,$EmptyMode,e) + nil or/[x for x in Tl] => - partialModeList:= [(x => x.mode; nil) for x in Tl] + partialModeList := [(x => x.mode; nil) for x in Tl] compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) or compForm3(form,m,e,modemapList) compForm3(form,m,e,modemapList) @@ -558,19 +558,20 @@ compForm2(form is [op,:argl],m,e,modemapList) == ++ corresponding expected type in the callee's modemap. compFormMatch(mm,partialModeList) == main where main() == - mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) - or wantArgumentsAsTuple(partialModeList,argModeList) + match(mm.mmSource,partialModeList) + or wantArgumentsAsTuple(partialModeList,mm.mmSource) match(a,b) == - null b => true - null first b => match(rest a,rest b) + b = nil => true + first b = nil => match(rest a,rest b) first a=first b and match(rest a,rest b) compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) == - mmList:= [mm for mm in modemapList | compFormMatch(mm,partialModeList)] => + mmList := [mm for mm in modemapList | compFormMatch(mm,partialModeList)] => compForm3(form,m,e,mmList) + nil compForm3(form is [op,:argl],m,e,modemapList) == - T:= + T := or/ [compFormWithModemap(form,m,e,first (mml:= ml)) for ml in tails modemapList] @@ -587,7 +588,7 @@ compFormWithModemap(form,m,e,modemap) == if isCategoryForm(target,e) and isFunctor op then [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil [map:= [.,target,:.],:cexpr]:= modemap - sv:=listOfSharpVars map + sv := listOfSharpVars map if sv then -- SAY [ "compiling ", op, " in compFormWithModemap, -- mode= ",map," sharp vars=",sv] @@ -596,17 +597,17 @@ compFormWithModemap(form,m,e,modemap) == [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap) -- SAY ["new map is",map] not coerceable(target,m,e) => nil - [f,Tl]:= compApplyModemap(form,modemap,e) or return nil + [f,Tl] := compApplyModemap(form,modemap,e) or return nil --generate code; return - T:= + T := [x',target,e'] where x':= form':= [f,:[t.expr for t in Tl]] target=$Category or isCategoryForm(target,e) => form' -- try to deal with new-style Unions where we know the conditions op = "elt" and f is ['XLAM,:.] and IDENTP(z := first argl) and - (c:=get(z,'condition,e)) and + (c := get(z,'condition,e)) and c is [["case",=z,c1]] and (c1 is [":",=(second argl),=m] or EQ(c1,second argl) ) => -- first is a full tag, as placed by getInverseEnvironment @@ -614,7 +615,7 @@ compFormWithModemap(form,m,e,modemap) == ['%tail,z] ['%call,:form'] e':= - Tl => (LAST Tl).env + Tl ~= nil => last(Tl).env e convert(T,m) @@ -625,21 +626,21 @@ compFormWithModemap(form,m,e,modemap) == ++ In that case, it matches any number of supplied arguments. getFormModemaps(form is [op,:argl],e) == op is ["elt",domain,op1] => - [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]] + [x for x in getFormModemaps([op1,:argl],e) | x.mmDC = domain] cons? op => nil modemapList:= get(op,"modemap",e) -- Within default implementations, modemaps cannot mention the -- current domain. if $insideCategoryPackageIfTrue then - modemapList := [x for x in modemapList | x is [[dom,:.],:.] and dom ~= '$] + modemapList := [x for x in modemapList | x.mmDC isnt '$] if op="elt" - then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil + then modemapList:= eltModemapFilter(last argl,modemapList,e) or return nil else if op="setelt" then modemapList:= seteltModemapFilter(second argl,modemapList,e) or return nil - nargs:= #argl - finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList - | enoughArguments(argl,sig)] + nargs := #argl + finalModemapList:= [mm for mm in modemapList + | enoughArguments(argl,mm.mmSource)] modemapList and null finalModemapList => stackMessage('"no modemap for %1b with %2 arguments", [op,nargs]) finalModemapList @@ -668,7 +669,7 @@ checkCallingConvention(sigs,nargs) == eltModemapFilter(name,mmList,e) == isConstantId(name,e) => - l:= [mm for mm in mmList | mm is [[.,.,.,sel,:.],:.] and sel=name] => l + l:= [mm for mm in mmList | second mm.mmSource = name] => l --there are elts with extra parameters stackMessage('"selector variable: %1b is undeclared and unbound",[name]) nil @@ -676,7 +677,7 @@ eltModemapFilter(name,mmList,e) == seteltModemapFilter(name,mmList,e) == isConstantId(name,e) => - l:= [mm for (mm:= [[.,.,.,sel,:.],:.]) in mmList | sel=name] => l + l:= [mm for mm in mmList | second mm.mmSource = name] => l --there are setelts with extra parameters stackMessage('"selector variable: %1b is undeclared and unbound",[name]) nil @@ -719,12 +720,12 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) == #dc~=#sig => keyedSystemError("S2GE0016",['"substituteIntoFunctorModemap", '"Incompatible maps"]) - #argl=#rest sig => + #argl=#sig.source => --here, we actually have a functor form - sig:= EQSUBSTLIST(argl,rest dc,sig) + sig:= EQSUBSTLIST(argl,dc.args,sig) --make new modemap, subst. actual for formal parametersinto modemap Tl:= [[.,.,e]:= compOrCroak(a,m,e) for a in argl for m in rest sig] - substitutionList:= [[x,:T.expr] for x in rest dc for T in Tl] + substitutionList:= [[x,:T.expr] for x in dc.args for T in Tl] [SUBLIS(substitutionList,modemap),e] nil @@ -887,7 +888,7 @@ setqMultipleExplicit(nameList,valList,m,e) == for g in gensymList for name in nameList] reAssignList="failed" => nil [["PROGN",:[T.expr for T in assignList],:[T.expr for T in reAssignList]], - $NoValueMode, (LAST reAssignList).env] + $NoValueMode, last(reAssignList).env] --% Quasiquotation @@ -1508,13 +1509,12 @@ compCase(["case",x,m'],m,e) == nil compCase1(x,m,e) == - [x',m',e']:= comp(x,$EmptyMode,e) or return nil - u:= - [modemap - for (modemap := [map,cexpr]) in getModemapList("case",2,e') - | map is [.,=$Boolean,s,t] and modeEqual(maybeSpliceMode t,m) + [x',m',e'] := comp(x,$EmptyMode,e) or return nil + u := + [mm for mm in getModemapList("case",2,e') + | mm.mmSignature is [=$Boolean,s,t] and modeEqual(maybeSpliceMode t,m) and modeEqual(s,m')] or return nil - fn:= (or/[mm for (mm := [.,[cond,selfn]]) in u | cond=true]) or return nil + fn := (or/[mm for mm in u | mm.mmCondition = true]) or return nil fn := genDeltaEntry(["case",:fn],e) [['%call,fn,x',MKQ m],$Boolean,e'] @@ -1775,11 +1775,9 @@ compCoerce1(x,m',e) == nil coerceByModemap([x,m,e],m') == ---+ modified 6/27 for new runtime system - u:= - [modemap - for (modemap:= [map,cexpr]) in getModemapList("coerce",1,e) | map is [.,t, - s] and (modeEqual(t,m') or isSubset(t,m',e)) + u := + [mm for mm in getModemapList("coerce",1,e) + | mm.mmSignature is [t,s] and (modeEqual(t,m') or isSubset(t,m',e)) and (modeEqual(s,m) or isSubset(m,s,e))] or return nil --mm:= (or/[mm for (mm:=[.,[cond,.]]) in u | cond=true]) or return nil @@ -1788,12 +1786,11 @@ coerceByModemap([x,m,e],m') == [['%call,fn,x],m',e] autoCoerceByModemap([x,source,e],target) == - u:= - [modemap - for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e) - | map is [.,t,s] and modeEqual(t,target) - and modeEqual(s,source)] or return nil - fn:= (or/[mm for (mm := [.,[cond,selfn]]) in u | cond=true]) or return nil + u := + [mm for mm in getModemapList("autoCoerce",1,e) + | mm.mmSignature is [t,s] and modeEqual(t,target) + and modeEqual(s,source)] or return nil + fn := (or/[mm for mm in u | mm.mmCondition=true]) or return nil source is ["Union",:l] and member(target,l) => (y:= get(x,"condition",e)) and (or/[u is ["case",., =target] for u in y]) diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 073ad5d4..96622dba 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -517,7 +517,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == then [[dom,:cat],:viewAssoc] else viewAssoc,EnvToPass) for v in rest u] TruthP CAAR c => ['PROGN,:CDAR c] - while (c and (LAST c is [c1] or LAST c is [c1,[]]) and + while (c and (last c is [c1] or last c is [c1,[]]) and (c1 = '%true or c1 is ['HasAttribute,:.])) repeat --strip out some worthless junk at the end c:=nreverse rest nreverse c diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 52edaf40..bc6bf2f1 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -272,7 +272,7 @@ putIntSymTab(x,prop,val,e) == u := ASSQ(prop,pl) => u.rest := val pl - lp := LASTPAIR pl + lp := lastNode pl u := [[prop,:val]] lp.rest := u pl @@ -397,7 +397,7 @@ PUTALIST(alist,prop,val) == -- else we fall over Lucid's read-only storage feature again pair.rest := val alist - LASTPAIR(alist).rest := [[prop,:val]] + lastNode(alist).rest := [[prop,:val]] alist REMALIST(alist,prop) == diff --git a/src/interp/guess.boot b/src/interp/guess.boot index 7b59d6e4..f2b81b18 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -113,7 +113,7 @@ findWords(word,table) == $countThreshold := $countThreshold + 2 res := findApproximateWords(word,table) $lastAlist := mySort res => --- $lastMinimum := first LAST $lastAlist +-- $lastMinimum := first last $lastAlist -- $lastWords := wordSort CDAR $lastAlist -- $totalWords:= $lastWords -- $lastAlist := rest $lastAlist @@ -131,7 +131,7 @@ more() == moreWords($lastWord,$lastTable) moreWords(word,table) == $lastAlist => - $lastMinimum := first LAST pp $lastAlist + $lastMinimum := first last pp $lastAlist numberOfLastWords := #$lastWords $lastWords := "append"/(ASSOCRIGHT $lastAlist) if #$lastWords > numberOfLastWords then diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 75264e8c..26abb4d7 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -2351,7 +2351,7 @@ bracketagglist(u, start, linelength, tchr, open, close) == true => ((nextu := lastx); PREDECESSOR(lastx, u).rest := nil) for x in tails u repeat x.first := ['CONCAT, first x, tchr] - if null nextu then LAST(u).rest.rest.first := close + if null nextu then last(u).rest.rest.first := close x := ASSOCIATER('CONCAT, [ichr,:u]) charybdis(ASSOCIATER('CONCAT, u), start, linelength) newlineIfDisplaying() @@ -2424,7 +2424,7 @@ superSubApp(u, x, y, di) == stringer x == string? x => x - '_| = FETCHCHAR(s:= STRINGIMAGE x, 0) => + char "|" = stringChar(s := STRINGIMAGE x, 0) => RPLACSTR(s, 0, 1, "", nil, nil) s diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index fde45dfb..f9839d55 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -127,7 +127,7 @@ newType? t == nil -- functions used at run-time which were formerly in the compiler files Undef(:u) == - u':= LAST u + u':= last u [[domain,slot],op,sig]:= u' domain':=eval mkEvalable domain not EQ(first domain'.slot, function Undef) => diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 868cf7f5..509fd8ba 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -594,7 +594,7 @@ markRecord(source,target,u) == -- Capsule Function: Find dewey decimal path across a list --====================================================================== markPath u == --u has nested structure: u0 < u1 < u2 ... - whole := LAST u + whole := last u part := first u $path := u u is [.] => 0 --means THE WHOLE THING @@ -930,11 +930,11 @@ markPrintAttributes addForm == capsule := addForm is ['add,a,:.] => a is ['CATEGORY,:.] => a - a is ['Join,:.] => first LASTNODE a - first LASTNODE addForm + a is ['Join,:.] => first lastNode a + first lastNode addForm addForm if capsule is ['CAPSULE,:r] then - capsule := first LASTNODE r + capsule := first lastNode r capsule isnt ['CATEGORY,.,:lst] => nil for x in lst | x is ['ATTRIBUTE,att] repeat markSay(form2String att) diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index efd961b4..d4c03552 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -525,7 +525,7 @@ throwKeyedMsgCannotCoerceWithValue(val,t1,t2) == --% Some Standard Message Printing Functions -bright x == ['"%b",:(cons?(x) and null rest LASTNODE x => x; [x]),'"%d"] +bright x == ['"%b",:(cons?(x) and null rest lastNode x => x; [x]),'"%d"] --bright x == ['"%b",:(atom x => [x]; x),'"%d"] mkMessage msg == diff --git a/src/interp/topics.boot b/src/interp/topics.boot index 6d1f63a6..ebed7994 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -109,7 +109,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . --initialize table of topic classes $topicHash := hashTable 'EQ --$topicHash has keys: topic and value: index for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c) - $topicIndex := rest LAST $groupAssoc + $topicIndex := rest last $groupAssoc --replace each property list by a topic code --store under each construct an OR of all codes diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index 62e25ccf..509485b9 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -641,7 +641,7 @@ setqMultipleExplicit(nameList,valList,m,e) == for g in gensymList for name in nameList] reAssignList="failed" => nil T := [["PROGN",:[T.expr for T in assignList], - :[T.expr for T in reAssignList]], $NoValueMode, (LAST reAssignList).env] + :[T.expr for T in reAssignList]], $NoValueMode, (last reAssignList).env] markMultipleExplicit(nameList,valList,T) canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index c20dfa18..0c5d7ec5 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -474,7 +474,7 @@ compFormWithModemap1(form,m,e,modemap,Rep2Dollar?) == --generate code; return T:= e':= - Tl => (LAST Tl).env + Tl => last(Tl).env e [x',m',e'] where m':= SUBLIS(sl,map.1) |