aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-11-15 17:21:03 +0000
committerdos-reis <gdr@axiomatics.org>2008-11-15 17:21:03 +0000
commit6c32bd875a857d1ff44ad9b8b555032c4be86cc6 (patch)
tree37a5a1eddacad06288601b464a9f6c70b329db4f /src
parent5c1ed5bae25e6950e685f384ea1440a6d539fd95 (diff)
downloadopen-axiom-6c32bd875a857d1ff44ad9b8b555032c4be86cc6.tar.gz
* interp/spad.lisp (incTimeSum): Remove.
* interp/modemap.boot ($forceAdd): Define. * interp/nruncomp.boot ($NRTderivedTargetIfTrue): Likewise. ($killOptimizeIfTrue): Likewise. * interp/i-toplev.boot (processInteractive): Tidy. * interp/c-util.boot ($compErrorMessageStack): Define. * interp/compiler.boot (compApply): Remove. ($compTimeSum): Likewise ($resolveTimeSum): Likewise. (compCompilerPredicate): Tidy. (comp3): There is no such thing as KAPPA.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog14
-rw-r--r--src/interp/c-util.boot3
-rw-r--r--src/interp/compiler.boot170
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/i-toplev.boot3
-rw-r--r--src/interp/modemap.boot4
-rw-r--r--src/interp/nruncomp.boot3
-rw-r--r--src/interp/nrungo.boot2
-rw-r--r--src/interp/spad.lisp10
-rw-r--r--src/interp/wi1.boot4
-rw-r--r--src/interp/wi2.boot2
11 files changed, 104 insertions, 113 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 042f4dd6..efd0f893 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/spad.lisp (incTimeSum): Remove.
+ * interp/modemap.boot ($forceAdd): Define.
+ * interp/nruncomp.boot ($NRTderivedTargetIfTrue): Likewise.
+ ($killOptimizeIfTrue): Likewise.
+ * interp/i-toplev.boot (processInteractive): Tidy.
+ * interp/c-util.boot ($compErrorMessageStack): Define.
+ * interp/compiler.boot (compApply): Remove.
+ ($compTimeSum): Likewise
+ ($resolveTimeSum): Likewise.
+ (compCompilerPredicate): Tidy.
+ (comp3): There is no such thing as KAPPA.
+
+2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* algebra/Makefile.pamphlet: Individual .spad files are .PRECIOUS.
2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index c0ccee94..4e91e700 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -54,6 +54,9 @@ $Representation := nil
$formalArgList := []
+
+$compErrorMessageStack := nil
+
--% Optimization control
++ true if we have to proclaim function signatures in the generated Lisp.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 7ada5375..c62d4345 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -39,6 +39,7 @@ import define
import iterator
namespace BOOT
module compiler where
+ compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple
coerce: (%Triple,%Mode) -> %Maybe %Triple
convert: (%Triple,%Mode) -> %Maybe %Triple
comp: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -69,7 +70,6 @@ compExpressionList: (%List,%Mode,%Env) -> %Maybe %Triple
compWithMappingMode: (%Form,%Mode,%List) -> %List
compFormMatch: (%Modemap,%List) -> %Boolean
compFormWithModemap: (%Form,%Mode,%Env,%Modemap) -> %Maybe %Triple
-compApply: (%List,%List,%Thing,%List,%Mode,%Env) -> %Maybe %Triple
compToApply: (%Form,%List,%Mode,%Env) -> %Maybe %Triple
compApplication: (%Form,%List,%Mode,%Env,%Triple) -> %Maybe %Triple
compApplyModemap: (%Form,%Modemap,%Env,%List) -> %Maybe %Triple
@@ -97,14 +97,11 @@ $coreDiagnosticFunctions ==
++ list of functions to compile
$compileOnlyCertainItems := []
-compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple
compTopLevel(x,m,e) ==
--+ signals that target is derived from lhs-- see NRTmakeSlot1Info
$NRTderivedTargetIfTrue: local := false
$killOptimizeIfTrue: local:= false
$forceAdd: local:= false
- $compTimeSum: local := 0
- $resolveTimeSum: local := 0
$packagesUsed: local := []
x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
([val,mode,.]:= compOrCroak(x,m,e); [val,mode,e])
@@ -124,17 +121,16 @@ compOrCroak1(x,m,e,compFn) ==
T:= CATCH("compOrCroak",FUNCALL(compFn,x,m,e)) => T
--stackAndThrow here and moan in UT LISP K does the appropriate THROW
$compStack:= [[x,m,e,$exitModeStack],:$compStack]
- $s:=
+ $s: local :=
compactify $compStack where
compactify al ==
null al => nil
LASSOC(first first al,rest al) => compactify rest al
[first al,:compactify rest al]
- $level:= #$s
+ $level: local := #$s
errorMessage:=
- if $compErrorMessageStack
- then first $compErrorMessageStack
- else "unspecified error"
+ $compErrorMessageStack ^= nil => first $compErrorMessageStack
+ "unspecified error"
$scanIfTrue =>
stackSemanticError(errorMessage,mkErrorExpr $level)
["failedCompilation",m,e]
@@ -143,19 +139,12 @@ compOrCroak1(x,m,e,compFn) ==
displayComp $level
userError errorMessage
-tc() ==
- comp($x,$m,$f)
-
++ The form `x' is intended to be evaluated by the compiler, e.g. in
++ toplevel conditional definition or as sub-domain predicate.
++ Normalize operators and compile the form.
compCompilerPredicate(x,e) ==
- savedNormalizeTree := $normalizeTree
- $normalizeTree := true
- t := compOrCroak(parseTran x, $Boolean, e)
- $normalizeTree := savedNormalizeTree
- t
-
+ $normalizeTree: local := true
+ compOrCroak(parseTran x, $Boolean, e)
comp(x,m,e) ==
T:= compNoStacking(x,m,e) => ($compStack:= nil; T)
@@ -170,7 +159,7 @@ compNoStacking(x,m,e) ==
--$Representation is bound in compDefineFunctor, set by doIt
--this hack says that when something is undeclared, $ is
--preferred to the underlying representation -- RDJ 9/12/83
- --Now that `per' and `rep' are built in, we do the above
+ --Now that `per' and `rep' are built in, we use the above
--hack only when `Rep' is defined the old way. -- gdr 2008/01/26
compNoStacking1(x,m,e,$compStack)
@@ -205,7 +194,6 @@ comp3(x,m,$e) ==
^x or atom x => compAtom(x,m,e)
op:= first x
getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
- op is ["KAPPA",sig,varlist,body] => compApply(sig,varlist,body,rest x,m,e)
op=":" => compColon(x,m,e)
op="::" => compCoerce(x,m,e)
not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
@@ -238,9 +226,9 @@ applyMapping([op,:argl],m,e,ml) ==
T() == [.,.,e]:= comp(x,m',e) or return "failed"
if argl'="failed" then return nil
form:=
- not member(op,$formalArgList) and ATOM op and not get(op,'value,e) =>
+ atom op and not(op in $formalArgList) and not get(op,"value",e) =>
nprefix := $prefix or
- -- following needed for referencing local funs at capsule level
+ -- following needed for referencing local funs at capsule level
getAbbreviation($op,#rest $form)
[op',:argl',"$"] where
op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
@@ -264,14 +252,14 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
if STRINGP x then x:= INTERN x
for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
[.,.,e]:= compMakeDeclaration([":",v,m],$EmptyMode,e)
- not null vl and not hasFormalMapVariable(x, vl) => return
+ (vl ^= nil) and not hasFormalMapVariable(x, vl) => return
[u,.,.] := comp([x,:vl],m',e) or return nil
extractCodeAndConstructTriple(u, m, oldE)
null vl and (t := comp([x], m', e)) => return
[u,.,.] := t
extractCodeAndConstructTriple(u, m, oldE)
[u,.,.]:= comp(x,m',e) or return nil
- uu:=optimizeFunctionDef [nil,['LAMBDA,vl,u]]
+ uu:=optimizeFunctionDef [nil,["LAMBDA",vl,u]]
-- At this point, we have a function that we would like to pass.
-- Unfortunately, it makes various free variable references outside
-- itself. So we build a mini-vector that contains them all, and
@@ -285,42 +273,42 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
not IDENTP u => free
MEMQ(u,bound) => free
v:=ASSQ(u,free) =>
- RPLACD(v,1+CDR v)
+ RPLACD(v,1 + rest v)
free
null getmode(u,e) => free
[[u,:1],:free]
- op:=CAR u
- MEMQ(op, '(QUOTE GO function)) => free
- EQ(op,'LAMBDA) =>
- bound:=UNIONQ(bound,CADR u)
+ op := first u
+ op in '(QUOTE GO function) => free
+ op = "LAMBDA" =>
+ bound := UNIONQ(bound, second u)
for v in CDDR u repeat
free:=FreeList(v,bound,free,e)
free
- EQ(op,'PROG) =>
- bound:=UNIONQ(bound,CADR u)
- for v in CDDR u | NOT ATOM v repeat
+ op = "PROG" =>
+ bound := UNIONQ(bound, second u)
+ for v in CDDR u | not atom v repeat
free:=FreeList(v,bound,free,e)
free
- EQ(op,'SEQ) =>
- for v in CDR u | NOT ATOM v repeat
+ op = "SEQ" =>
+ for v in rest u | not atom v repeat
free:=FreeList(v,bound,free,e)
free
- EQ(op,'COND) =>
- for v in CDR u repeat
+ op = "COND" =>
+ for v in rest u repeat
for vv in v repeat
free:=FreeList(vv,bound,free,e)
free
- if ATOM op then u:=CDR u --Atomic functions aren't descended
+ if atom op then u := rest u --Atomic functions aren't descended
for v in u repeat
free:=FreeList(v,bound,free,e)
free
expandedFunction :=
--One free can go by itself, more than one needs a vector
--An A-list name . number of times used
- #frees = 0 => ['LAMBDA,[:vl,"$$"], :CDDR expandedFunction]
+ #frees = 0 => ["LAMBDA",[:vl,"$$"], :CDDR expandedFunction]
#frees = 1 =>
vec:=first first frees
- ['LAMBDA,[:vl,vec], :CDDR expandedFunction]
+ ["LAMBDA",[:vl,vec], :CDDR expandedFunction]
scode:=nil
vec:=nil
slist:=nil
@@ -338,16 +326,16 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
slist => SUBLISNQ(slist,CDDR expandedFunction)
CDDR expandedFunction
if locals then
- if body is [['DECLARE,:.],:.] then
- body:=[CAR body,['PROG,locals,:scode,['RETURN,['PROGN,:CDR body]]]]
- else body:=[['PROG,locals,:scode,['RETURN,['PROGN,:body]]]]
- vec:=['VECTOR,:NREVERSE vec]
- ['LAMBDA,[:vl,"$$"],:body]
- fname:=['CLOSEDFN,expandedFunction]
- --Like QUOTE, but gets compiled
+ if body is [["DECLARE",:.],:.] then
+ body := [first body,["PROG",locals,:scode,
+ ["RETURN",["PROGN",:rest body]]]]
+ else body:=[["PROG",locals,:scode,["RETURN",["PROGN",:body]]]]
+ vec:=["VECTOR",:nreverse vec]
+ ["LAMBDA",[:vl,"$$"],:body]
+ fname:=["CLOSEDFN",expandedFunction] --Like QUOTE, but gets compiled
uu:=
- frees => ['CONS,fname,vec]
- ['LIST,fname]
+ frees => ["CONS",fname,vec]
+ ["LIST",fname]
[uu,m,oldE]
extractCodeAndConstructTriple(u, m, oldE) ==
@@ -360,7 +348,7 @@ extractCodeAndConstructTriple(u, m, oldE) ==
compExpression(x,m,e) ==
$insideExpressionIfTrue: local:= true
-- special forms have dedicated compilers.
- (op := first x) and SYMBOLP op and (fn := GET(op,"SPECIAL")) =>
+ (op := first x) and IDENTP op and (fn := GET(op,"SPECIAL")) =>
FUNCALL(fn,x,m,e)
compForm(x,m,e)
@@ -489,10 +477,8 @@ outputComp(x,e) ==
[x,$OutputForm,e]
compForm1(form is [op,:argl],m,e) ==
- $NumberOfArgsIfInteger: local:= #argl --see compElt
op in $coreDiagnosticFunctions =>
- [[op,:[([.,.,e]:=outputComp(x,e)).expr
- for x in argl]],m,e]
+ [[op,:[([.,.,e]:=outputComp(x,e)).expr for x in argl]],m,e]
op is ["elt",domain,op'] =>
domain="Lisp" =>
--op'='QUOTE and null rest argl => [first argl,m,e]
@@ -527,18 +513,21 @@ compForm2(form is [op,:argl],m,e,modemapList) ==
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 whenever subsumee true)
+ -- now delete any modemaps that are subsumed by something else,
+ -- provided the conditions are right (i.e. subsumer true
+ -- whenever subsumee true)
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]
if not PredImplies(ncond,cond) then
newList := [[CAR u,[cond,['ELT,dc,nil]]],:newList]
- if deleteList then modemapList:=[u for u in modemapList | not MEMQ(u,deleteList)]
+ if deleteList 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
- if newList then modemapList := append(modemapList,newList)
+ if newList then
+ modemapList := append(modemapList,newList)
-- The calling convention vector is used to determine when it is
-- appropriate to infer type by compiling the argument vs. just
@@ -611,10 +600,10 @@ compFormWithModemap(form,m,e,modemap) ==
form':= [f,:[t.expr for t in Tl]]
m'=$Category or isCategoryForm(m',e) => form'
-- try to deal with new-style Unions where we know the conditions
- op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and
+ op = "elt" and f is ['XLAM,:.] and IDENTP(z := first argl) and
(c:=get(z,'condition,e)) and
c is [["case",=z,c1]] and
- (c1 is [":",=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
+ (c1 is [":",=(second argl),=m] or EQ(c1,second argl) ) =>
-- first is a full tag, as placed by getInverseEnvironment
-- second is what getSuccessEnvironment will place there
["CDR",z]
@@ -712,17 +701,6 @@ seteltModemapFilter(name,mmList,e) ==
nil
mmList
-
-compApply(sig,varl,body,argl,m,e) ==
- argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl]
- contour:=
- [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]])
- for x in varl for m' in sig.source for a in argl]
- code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]]
- m':= resolve(m,sig.target)
- body':= (comp(body,m',addContour(contour,e))).expr
- [code,m',e]
-
compToApply(op,argl,m,e) ==
T:= compNoStacking(op,$EmptyMode,e) or return nil
m1:= T.mode
@@ -807,7 +785,7 @@ compCons1(["CONS",x,y],m,e) ==
my is ["List",m',:.] =>
mr:= ["List",resolve(m',mx) or return nil]
yt':= convert(yt,mr) or return nil
- [x,.,e]:= convert([x,mx,yt'.env],CADR mr) or return nil
+ [x,.,e]:= convert([x,mx,yt'.env],second mr) or return nil
yt'.expr is ["LIST",:.] => [["LIST",x,:rest yt'.expr],mr,e]
[["CONS",x,yt'.expr],mr,e]
[["CONS",x,y],["Pair",mx,my],e]
@@ -818,7 +796,8 @@ compCons1(["CONS",x,y],m,e) ==
compSetq: (%List,%Thing,%List) -> %List
compSetq1: (%Form,%Thing,%Mode,%List) -> %List
-compSetq(["%LET",form,val],m,E) == compSetq1(form,val,m,E)
+compSetq(["%LET",form,val],m,E) ==
+ compSetq1(form,val,m,E)
compSetq1(form,val,m,E) ==
IDENTP form => setqSingle(form,val,m,E)
@@ -843,10 +822,10 @@ setqSingle(id,val,m,E) ==
--used for comping domain forms within functions
currentProplist:= getProplist(id,E)
m'':=
- get(id,'mode,E) or getmode(id,E) or
+ get(id,"mode",E) or getmode(id,E) or
(if m=$NoValueMode then $EmptyMode else m)
-- m'':= LASSOC("mode",currentProplist) or $EmptyMode
- --for above line to work, line 3 of compNoStackingis required
+ --for above line to work, line 3 of compNoStacking is required
T:=
eval or return nil where
eval() ==
@@ -859,11 +838,14 @@ setqSingle(id,val,m,E) ==
if $profileCompiler = true then
null IDENTP id => nil
key :=
- MEMQ(id,rest $form) => 'arguments
- 'locals
+ id in rest $form => "arguments"
+ "locals"
profileRecord(key,id,T.mode)
- newProplist:= consProplistOf(id,currentProplist,"value",removeEnv [val,:rest T])
- e':= (PAIRP id => e'; addBinding(id,newProplist,e'))
+ newProplist :=
+ consProplistOf(id,currentProplist,"value",removeEnv [val,:rest T])
+ e':=
+ CONSP id => e'
+ addBinding(id,newProplist,e')
if isDomainForm(val,e') then
if isDomainInScope(id,e') then
stackWarning("domain valued variable %1b has been reassigned within its scope",[id])
@@ -871,9 +853,9 @@ setqSingle(id,val,m,E) ==
--all we do now is to allocate a slot number for lhs
--e.g. the %LET form below will be changed by putInLocalDomainReferences
--+
- if (k:=NRTassocIndex(id))
- then form:=['SETELT,"$",k,x]
- else form:=
+ if k := NRTassocIndex(id) then
+ form := ['SETELT,"$",k,x]
+ else form:=
$QuickLet => ["%LET",id,x]
["%LET",id,x,
(isDomainForm(x,e') => ['ELT,id,0];CAR outputComp(id,e'))]
@@ -897,7 +879,8 @@ setqMultiple(nameList,val,m,e) ==
[x,m',e]:= convert(T,m) or return nil
1.1 --exit if result is a list
m1 is ["List",D] =>
- for y in nameList repeat e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
+ for y in nameList repeat
+ e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
convert([["PROGN",x,["%LET",nameList,g],g],m',e],m)
2 --verify that the #nameList = number of parts of right-hand-side
selectorModePairs:=
@@ -969,24 +952,24 @@ compWhere([.,form,:exprList],m,eInit) ==
compConstruct: (%Form,%Mode,%Env) -> %Maybe %Triple
compConstruct(form is ["construct",:l],m,e) ==
y:= modeIsAggregateOf("List",m,e) =>
- T:= compList(l,["List",CADR y],e) => convert(T,m)
+ T:= compList(l,["List",second y],e) => convert(T,m)
compForm(form,m,e)
y:= modeIsAggregateOf("Vector",m,e) =>
- T:= compVector(l,["Vector",CADR y],e) => convert(T,m)
+ T:= compVector(l,["Vector",second y],e) => convert(T,m)
compForm(form,m,e)
T:= compForm(form,m,e) => T
for D in getDomainsInScope e repeat
(y:=modeIsAggregateOf("List",D,e)) and
- (T:= compList(l,["List",CADR y],e)) and (T':= convert(T,m)) =>
+ (T:= compList(l,["List",second y],e)) and (T':= convert(T,m)) =>
return T'
(y:=modeIsAggregateOf("Vector",D,e)) and
- (T:= compVector(l,["Vector",CADR y],e)) and (T':= convert(T,m)) =>
+ (T:= compVector(l,["Vector",second y],e)) and (T':= convert(T,m)) =>
return T'
++ Compile a literal (quoted) symbol.
compQuote: (%Form,%Mode,%Env) -> %Maybe %Triple
compQuote(expr,m,e) ==
- expr is ["QUOTE",x] and SYMBOLP x => convert([expr,$Symbol,e],m)
+ expr is ["QUOTE",x] and IDENTP x => convert([expr,$Symbol,e],m)
stackAndThrow('"%1b is not a literal symbol.",[x])
compList: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -1029,18 +1012,15 @@ compSeq: (%Form,%Mode,%Env) -> %Maybe %Triple
compSeq1: (%Form,%List,%Env) -> %Maybe %Triple
compSeqItem: (%Thing,%Thing,%List) -> %List
-compSeq(["SEQ",:l],m,e) == compSeq1(l,[m,:$exitModeStack],e)
+compSeq(["SEQ",:l],m,e) ==
+ compSeq1(l,[m,:$exitModeStack],e)
compSeq1(l,$exitModeStack,e) ==
$insideExpressionIfTrue: local
- $finalEnv: local
- --used in replaceExitEtc.
+ $finalEnv: local := nil --used in replaceExitEtc.
c:=
[([.,.,e]:=
-
-
--this used to be compOrCroak-- but changed so we can back out
-
($insideExpressionIfTrue:= NIL; compSeqItem(x,$NoValueMode,e) or return
"failed")).expr for x in l]
if c="failed" then return nil
@@ -1048,7 +1028,8 @@ compSeq1(l,$exitModeStack,e) ==
form:= ["SEQ",:replaceExitEtc(c,catchTag,"TAGGEDexit",$exitModeStack.(0))]
[["CATCH",catchTag,form],$exitModeStack.(0),$finalEnv]
-compSeqItem(x,m,e) == comp(macroExpand(x,e),m,e)
+compSeqItem(x,m,e) ==
+ comp(macroExpand(x,e),m,e)
replaceExitEtc(x,tag,opFlag,opMode) ==
(fn(x,tag,opFlag,opMode); x) where
@@ -1115,7 +1096,8 @@ compReturn(["return",level,x],m,e) ==
nil
level^=1 => userError '"multi-level returns not supported"
index:= MAX(0,#$exitModeStack-1)
- if index>=0 then $returnMode:= resolve($exitModeStack.index,$returnMode)
+ if index >= 0 then
+ $returnMode:= resolve($exitModeStack.index,$returnMode)
[x',m',e']:= u:= comp(x,$returnMode,e) or return nil
if index>=0 then
$returnMode:= resolve(m',$returnMode)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 58d33090..3901ffbd 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1488,7 +1488,7 @@ doIt(item,$predl) ==
$functorsUsed:= insert(opOf rhs',$functorsUsed)
$packagesUsed:= insert([opOf rhs'],$packagesUsed)
if lhs="Rep" then
- $Representation:= (get("Rep",'value,$e)).(0)
+ $Representation:= (get("Rep",'value,$e)).expr
--$Representation bound by compDefineFunctor, used in compNoStacking
if $NRTopt = true
then NRTgetLocalIndex $Representation
diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot
index af7a4de8..563fa1fe 100644
--- a/src/interp/i-toplev.boot
+++ b/src/interp/i-toplev.boot
@@ -129,14 +129,13 @@ processInteractive(form, posnForm) ==
$op: local:= (form is [op,:.] => op; form) --name of operator
$Coerce: local := NIL
- $compErrorMessageStack:local
+ $compErrorMessageStack: local := nil
$freeVars : local := NIL
$mapList:local := NIL --list of maps being type analyzed
$compilingMap:local:= NIL --true when compiling a map
$compilingLoop:local:= NIL --true when compiling a loop body
$interpOnly: local := NIL --true when in interpret only mode
$whereCacheList: local := NIL --maps compiled because of where
- $timeGlobalName: local := '$compTimeSum --see incrementTimeSum
$StreamFrame: local := nil --used in printing streams
$declaredMode: local := NIL --Weak type propagation for symbols
$localVars:local := NIL --list of local variables in function
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index e35d7bb6..38ee6e52 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -36,6 +36,10 @@ import c_-util
import info
namespace BOOT
+--%
+
+$forceAdd := false
+
--% EXTERNAL ROUTINES
--These functions are called from outside this file to add a domain
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 9dd8bff1..dc6218e1 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -61,6 +61,9 @@ $NRTdeltaLength := 0
++
$NRTaddForm := nil
+++
+$NRTderivedTargetIfTrue := false
+$killOptimizeIfTrue := false
-----------------------------NEW buildFunctor CODE-----------------------------
NRTaddDeltaCode() ==
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 90497aea..ddc448c2 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -142,7 +142,7 @@ substDomainArgs(domain,object) ==
--=======================================================
domainTableLookup(op,sig,dollar,env) == lookupInTable(op,sig,dollar,env)
lookupInTable(op,sig,dollar,[domain,table]) ==
- EQ(table,'derived) => lookupInAddChain(op,sig,domain,dollar)
+ table = "derived" => lookupInAddChain(op,sig,domain,dollar)
success := false
someMatch := false
while not success for [sig1,:code] in LASSQ(op,table) repeat
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 31785bc2..14776731 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -284,7 +284,6 @@
(*print-pretty* t)
($MACROASSOC ())
($NEWSPAD T)
- (|$compUniquelyIfTrue| nil)
|$currentFunction|
|$topOp|
(|$semanticErrorStack| ())
@@ -384,15 +383,6 @@
(COLLECT |formatCOLLECT|)
(REDUCE |formatREDUCE|)))
-(defmacro |incTimeSum| (a b)
- (if (not |$InteractiveTimingStatsIfTrue|) a
- (let ((key b) (oldkey (gensym)) (val (gensym)))
- `(prog (,oldkey ,val)
- (setq ,oldkey (|incrementTimeSum| ,key))
- (setq ,val ,a)
- (|incrementTimeSum| ,oldkey)
- (return ,val)))))
-
(defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
(defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index 7f402883..fc971f76 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -163,8 +163,6 @@ compTopLevel(x,m,e) ==
$NRTderivedTargetIfTrue: local := false
$killOptimizeIfTrue: local:= false
$forceAdd: local:= false
- $compTimeSum: local := 0
- $resolveTimeSum: local := 0
$packagesUsed: local := []
-- The next line allows the new compiler to be tested interactively.
compFun := 'compOrCroak
@@ -389,7 +387,6 @@ compForm(form,m,e) ==
compForm1(form,m,e) ==
[op,:argl] := form
- $NumberOfArgsIfInteger: local:= #argl --see compElt
op="error" =>
[[op,:[([.,.,e]:=outputComp(x,e)).expr
for x in argl]],m,e]
@@ -957,7 +954,6 @@ comp3(x,m,$e) ==
^x or atom x => compAtom(x,m,e)
op:= first x
getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
- op is ["KAPPA",sig,varlist,body] => compApply(sig,varlist,body,rest x,m,e)
op=":" => compColon(x,m,e)
op="::" => compCoerce(x,m,e)
not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 81a8cbe3..e449b0f0 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -1145,7 +1145,7 @@ doItLet1 item ==
$packagesUsed:= insert([opOf rhs'],$packagesUsed)
$globalImportDefAlist := pp [[lhs, :rhs'],:$globalImportDefAlist]
if lhs="Rep" then
- $Representation:= (get("Rep",'value,$e)).(0)
+ $Representation:= (get("Rep",'value,$e)).expr
--$Representation bound by compDefineFunctor, used in compNoStacking
--+
if $NRTopt = true