aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2013-05-11 20:47:10 +0000
committerdos-reis <gdr@axiomatics.org>2013-05-11 20:47:10 +0000
commit9df910dc2e9a9a1eaf7a0e8d726a2181b1e31862 (patch)
treeda29042a8ae4bfb04d01ac7a67b34db81ffe2a95 /src/interp
parent4d744926ba30ed64d68481878404d99c745cd595 (diff)
downloadopen-axiom-9df910dc2e9a9a1eaf7a0e8d726a2181b1e31862.tar.gz
Consistently use OIL opcodes for abstractions
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot8
-rw-r--r--src/interp/clam.boot4
-rw-r--r--src/interp/define.boot12
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/i-eval.boot2
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/i-special.boot16
-rw-r--r--src/interp/lisp-backend.boot6
-rw-r--r--src/interp/slam.boot14
9 files changed, 33 insertions, 33 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index b6e253c3..0c128bdf 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1438,7 +1438,7 @@ foldExportedFunctionReferences defs ==
for fun in defs repeat
fun isnt [name,lamex] => nil
getFunctionReplacement name => nil
- lamex isnt ["LAMBDA",vars,body] => nil
+ lamex isnt ['%lambda,vars,body] => nil
body := replaceSimpleFunctions body
form := expandableDefinition?(vars,body) =>
registerFunctionReplacement(name,form)
@@ -1518,8 +1518,8 @@ backendCompileNEWNAM x ==
backendCompileNEWNAM first x
backendCompileNEWNAM rest x
-++ Lisp back end compiler for SPADSLAM forms [namd,args,:body].
-++ A SPADSLAM form is one that is `functional' in the sense that
+++ Lisp back end compiler for %slam forms [namd,args,:body].
+++ A %slam form is one that is `functional' in the sense that
++ its values are cached, so that equal lists of argument values
++ yield equal values. The arguments-value pairs are stored
++ in a hash table. This backend compiler is used to compile constructors.
@@ -1554,7 +1554,7 @@ backendCompile2: %Code -> %Symbol
backendCompile2 code ==
code isnt [name,[type,args,:body]] =>
systemError ['"parenthesis error in: ", code]
- type = "SPADSLAM" => backendCompileSPADSLAM(name,args,body)
+ type = '%slam => backendCompileSPADSLAM(name,args,body)
assembleCode [name,[type,args,:body]]
++ returns all fuild variables contained in `x'. Fuild variables are
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 10d5157a..6b8cbaa9 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -108,11 +108,11 @@ compHash(op,argl,body) ==
codeBody := mkBind([[g2,getCode]],
['%when,[g2,returnFoundValue],['%otherwise,putCode]])
- computeFunction := [auxfn,['LAMBDA,argl,:body]]
+ computeFunction := [auxfn,['%lambda,argl,:body]]
if $reportCompilation then
sayBrightlyI bright '"Generated code for function:"
pp computeFunction
- compQuietly [[op,['LAMBDA,argl,codeBody]],computeFunction]
+ compQuietly [[op,['%lambda,argl,codeBody]],computeFunction]
op
CDRwithIncrement x ==
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 4779e3e8..bef1da67 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1146,7 +1146,7 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) ==
body:=
["%bind",[[g:= gensym(),body]],
['%seq,['%store,['%tref,g,0],mkConstructor $form],g]]
- fun := compile(db,[op',["LAMBDA",sargl,body]],signature')
+ fun := compile(db,[op',['%lambda,sargl,body]],signature')
-- 5. give operator a 'modemap property
pairlis := pairList(form.args,$FormalMapVariableList)
@@ -1484,8 +1484,8 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
T:= compFunctorBody(db,body,rettype,$e)
body':= T.expr
lamOrSlam :=
- dbInstanceCache db = nil => 'LAMBDA
- 'SPADSLAM
+ dbInstanceCache db = nil => '%lambda
+ '%slam
fun := compile(db,dbSubstituteFormals(db,[op',[lamOrSlam,form.args,body']]),signature')
--The above statement stops substitutions gettting in one another's way
operationAlist := dbSubstituteAllQuantified(db,$lisplibOperationAlist)
@@ -1938,7 +1938,7 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
body' := replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
body' := addArgumentConditions(body',$op)
finalBody := ['%scope,catchTag,body']
- compile(db,[op',["LAMBDA",[:argl,'_$],finalBody]],signature)
+ compile(db,[op',['%lambda,[:argl,'$],finalBody]],signature)
$functorStats:= addStats($functorStats,$functionStats)
--7. give operator a 'value property
@@ -2094,9 +2094,9 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
-- we will cache all of its values on $ConstructorCache with reference
-- counts
dbConstructorKind db = 'category =>
- first compAndDefine [[fn,['SPADSLAM,vl,:bodyl]]]
+ first compAndDefine [[fn,['%slam,vl,:bodyl]]]
dbInstanceCache db = nil =>
- first backendCompile [[fn,['LAMBDA,vl,:bodyl]]]
+ first backendCompile [[fn,['%lambda,vl,:bodyl]]]
compHash(fn,vl,bodyl)
constructMacro: %Form -> %Form
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index c961dcc3..2fe0791b 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -210,7 +210,7 @@ macro builtinConstructor? s ==
--%
$AbstractionOperator ==
- '(LAM ILAM XLAM SPADSLAM LAMBDA %lambda)
+ '(LAM ILAM XLAM LAMBDA %lambda %slam)
++ Return the character designated by the string `s'.
stringToChar: %String -> %Char
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index b43c83e0..582089f2 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -243,7 +243,7 @@ evalForm(op,opName,argl,mmS) ==
['SPADCALL,:form,freeFun]
fun is ['XLAM,xargs,:xbody] =>
rec := first form
- ['FUNCALL,['function, ['LAMBDA,xargs,:xbody]],:take(#xargs, form)]
+ ['%funcall,['%function, ['%lambda,xargs,:xbody]],:take(#xargs, form)]
dcVector := evalDomain dc
fun0 :=
newType? CAAR mm =>
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 6470fd76..ba4e1277 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -774,7 +774,7 @@ compileCoerceMap(op,argTypes,mm) ==
minivectorName := makeInternalMapMinivectorName name
body := substitute(["%dynval",MKQ minivectorName],"$$$",body)
symbolValue(minivectorName) := vector $minivector
- compileInteractive [name,['LAMBDA,parms,body]]
+ compileInteractive [name,['%lambda,parms,body]]
sig.target
depthOfRecursion(opName,body) ==
diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot
index f8d224ed..1980d4ad 100644
--- a/src/interp/i-special.boot
+++ b/src/interp/i-special.boot
@@ -177,15 +177,15 @@ compileADEFBody(t,vars,types,body,computedResultType) ==
-- MCD 13/3/96
parms := [:vars,"envArg"]
if not $definingMap and ($genValue or $compilingMap) then
- code := wrap compileInteractive [$mapName,["LAMBDA",parms,body]]
+ code := wrap compileInteractive [$mapName,['%lambda,parms,body]]
else
$freeVariables: local := []
$boundVariables: local := [minivectorName,:vars]
-- CCL does not support upwards funargs, so we check for any free variables
-- and pass them into the lambda as part of envArg.
body := checkForFreeVariables(body,"ALL")
- fun := ["function",["LAMBDA",parms,body]]
- code := ["CONS", fun, ["VECTOR", :reverse $freeVariables]]
+ fun := ['%function,['%lambda,parms,body]]
+ code := ['%pair, fun, ['%vector, :reverse $freeVariables]]
val := objNew(code,rt := ['Mapping,computedResultType,:rest types])
putValue(t,val)
@@ -795,9 +795,9 @@ mkIterFun([index,:s],funBody) ==
$boundVariables: local := [index]
body := checkForFreeVariables(objVal getValue funBody,"ALL")
parms := [index,"envArg"]
- val:=['function,declareUnusedParameters ['LAMBDA,parms,body]]
+ val:=['%function,declareUnusedParameters ['%lambda,parms,body]]
vec := mkAtreeNode gensym()
- putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
+ putValue(vec,objNew(['%pair,val,['%vector,:reverse $freeVariables]],mapMode))
vec
checkForFreeVariables(v,locals) ==
@@ -823,7 +823,7 @@ checkForFreeVariables(v,locals) ==
-- Might have a mode at the front of a list, or be calling a function
-- which returns a function.
[checkForFreeVariables(op,locals),:[checkForFreeVariables(a,locals) for a in args]]
- op in '(LAMBDA QUOTE getValueFromEnvironment) => v
+ op in '(LAMBDA %lambda QUOTE getValueFromEnvironment) => v
op = "LETT" => -- Expands to a SETQ.
["SETF",:[checkForFreeVariables(a,locals) for a in args]]
op in '(COLLECT REPEAT %collect %repeat) =>
@@ -935,9 +935,9 @@ mkIterZippedFun(indexList,funBody,zipType,$localVars) ==
body :=
[checkForFreeVariables(form,$localVars) for form in getValue funBody]
parms := [$index,'envArg]
- val:=['function,declareUnusedParameters ['LAMBDA,parms,objVal body]]
+ val:=['%function,declareUnusedParameters ['%lambda,parms,objVal body]]
vec := mkAtreeNode gensym()
- putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
+ putValue(vec,objNew(['%pair,val,['%vector,:reverse $freeVariables]],mapMode))
vec
subVecNodes(new,old,form) ==
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 2f4b661f..6fb119e8 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -805,16 +805,16 @@ COMPILE1 fun ==
body := body'
args := removeFluids args
newArgs :=
- type is 'LAMBDA and simpleParameterList? args => args
+ type in '(%lambda LAMBDA) and simpleParameterList? args => args
args' := gensym()
body := [['DSETQ,args,args'],:body]
- type is 'LAMBDA => ["&REST",args',"&AUX",:$Vars]
+ type in '(%lambda LAMBDA) => ["&REST",args',"&AUX",:$Vars]
type is 'MLAMBDA => ["&WHOLE",args',"&REST",gensym(),"&AUX",:$Vars]
systemError ['"bad function type: ",:bright symbolName type]
if $Decls ~= nil then
body := [['DECLARE,['SPECIAL,:$Decls]],:body]
body :=
- type is 'LAMBDA => ['DEFUN,name,newArgs,:body]
+ type in '(%lambda LAMBDA) => ['DEFUN,name,newArgs,:body]
['DEFMACRO,name,newArgs,:body]
compileLispDefinition(name,body)
body
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index f8c0e4b1..ded60ffa 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -151,7 +151,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
parms := [:argl,"envArg"]
cacheCount = 0 or null argl =>
- compileInteractive [nam,["LAMBDA",parms,body]]
+ compileInteractive [nam,['%lambda,parms,body]]
nam
num :=
integer? cacheCount =>
@@ -186,8 +186,8 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
["PROG",[g2,g3],["RETURN",['%when,secondPredPair,thirdPredPair]]]
-- cannot use envArg in next statement without redoing much
-- of above.
- mainFunction:= [nam,["LAMBDA",arg,codeBody]]
- computeFunction:= [auxfn,["LAMBDA",parms,body]]
+ mainFunction:= [nam,['%lambda,arg,codeBody]]
+ computeFunction:= [auxfn,['%lambda,parms,body]]
compileInteractive mainFunction
compileInteractive computeFunction
cacheType:= "function"
@@ -220,9 +220,9 @@ reportFunctionCacheAll(op,nam,argl,body) ==
['%store,['tableValue,['%dynval,MKQ cacheName],g1],
computeValue]]
codeBody:= ["PROG",[g2],["RETURN",['%when,secondPredPair,thirdPredPair]]]
- mainFunction:= [nam,["LAMBDA",arg,codeBody]]
+ mainFunction:= [nam,['%lambda,arg,codeBody]]
parms := [:argl, "envArg"]
- computeFunction:= [auxfn,["LAMBDA",parms,body]]
+ computeFunction:= [auxfn,['%lambda,parms,body]]
compileInteractive mainFunction
compileInteractive computeFunction
cacheType:= 'hash_-table
@@ -285,7 +285,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
['store,['tableValue,["%dynval", MKQ stateNam],extraArgumentCode],
newTripleCode]
- computeFunction:= [auxfn,["LAMBDA",cargl,cbody]] where
+ computeFunction:= [auxfn,['%lambda,cargl,cbody]] where
cargl:= [:argl,lastArg]
returnValue:= ["PROGN",newStateCode,first gsList]
cbody:=
@@ -301,7 +301,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
continueInit:=
[["%LET",gIndex,["ELT",stateVar,0]],
:[["%LET",g,["ELT",stateVar,i]] for g in gsList for i in 1..]]
- mainFunction:= [nam,["LAMBDA",margl,mbody]] where
+ mainFunction:= [nam,['%lambda,margl,mbody]] where
margl:= [:argl,'envArg]
max:= gensym()
tripleCode := ['%pair,n,['%list,:initCode]]