aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/c-util.boot33
-rw-r--r--src/interp/i-map.boot3
-rw-r--r--src/interp/i-spec1.boot10
-rw-r--r--src/interp/slam.boot15
5 files changed, 49 insertions, 23 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 656b89e5..c4ed009e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2010-06-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/c-util.boot (usedSymbol?): New.
+ (declareUnusedParameters): Use it. Reimplement.
+ * interp/i-map.boot (compileCoerceMap): Adjust call.
+ * interp/i-spec1.boot (compileADEFBody): Likewise.
+ (mkIterFun): Likewise.
+ * interp/slam.boot (reportFunctionCompilation): Likewise.
+ (reportFunctionCacheAll): Likewise.
+ (compileRecurrenceRelation): Likewise.
+
2010-06-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
* algebra/list.spad.pamphlet: Use builtin functions.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e135583f..3304a391 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -41,7 +41,7 @@ module c_-util where
replaceSimpleFunctions: %Form -> %Form
foldExportedFunctionReferences: %List -> %List
diagnoseUnknownType: (%Mode,%Env) -> %Form
- declareUnusedParameters: (%List,%Code) -> %List
+ declareUnusedParameters: %Code -> %Code
registerFunctionReplacement: (%Symbol,%Form) -> %Thing
getFunctionReplacement: %Symbol -> %Form
getSuccessEnvironment: (%Form,%Env) -> %Env
@@ -156,13 +156,34 @@ wantArgumentsAsTuple: (%List,%Signature) -> %Boolean
wantArgumentsAsTuple(args,sig) ==
isHomoegenousVarargSignature sig and #args ~= #sig
+$AbstractionOperator ==
+ '(LAM ILAM SLAM SPADSLAM LAMBDA)
+
+++ Return true if the symbol 's' is used in the form 'x'.
+usedSymbol?(s,x) ==
+ symbol? x => s = x
+ atom x => false
+ x is ['QUOTE,:.] => false
+ x is [op,parms,:body] and op in $AbstractionOperator =>
+ x in parms => false
+ usedSymbol?(x,body)
+ or/[usedSymbol?(s,x') for x' in x]
+
+
++ We are about to seal the (Lisp) definition of a function.
-++ Augment the `body' with a declaration for those `parms'
+++ Augment the body of any function definition in the form `x'
+++ with declarations for unused parameters.
++ that are unused.
-declareUnusedParameters(parms,body) ==
- unused := [p for p in parms | not CONTAINED(p,body)]
- null unused => [body]
- [["DECLARE",["IGNORE",:unused]],body]
+declareUnusedParameters x == (augment x; x) where
+ augment x ==
+ isAtomicForm x => nil
+ x is [op,parms,body] and op in $AbstractionOperator =>
+ augment body
+ unused := [p for p in parms | not usedSymbol?(p,body)]
+ null unused => [body]
+ x.rest.rest := [["DECLARE",["IGNORE",:unused]],body]
+ for x' in x repeat
+ augment x'
devaluate d ==
not REFVECP d => d
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 85a4380f..90db927f 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -766,8 +766,7 @@ compileCoerceMap(op,argTypes,mm) ==
minivectorName := makeInternalMapMinivectorName name
body := substitute(["%dynval",MKQ minivectorName],"$$$",body)
setDynamicBinding(minivectorName,LIST2VEC $minivector)
- compileInteractive
- [name,['LAMBDA,parms,:declareUnusedParameters(parms,body)]]
+ compileInteractive [name,['LAMBDA,parms,body]]
sig.target
depthOfRecursion(opName,body) ==
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index ca70e66e..f6d51ed9 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -177,16 +177,14 @@ compileADEFBody(t,vars,types,body,computedResultType) ==
-- MCD 13/3/96
parms := [:vars,"envArg"]
if not $definingMap and ($genValue or $compilingMap) then
- fun := [$mapName,["LAMBDA",parms,:declareUnusedParameters(parms,body)]]
- code := wrap compileInteractive fun
+ 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,
- :declareUnusedParameters(parms,body)]]
+ fun := ["function",["LAMBDA",parms,body]]
code := ["CONS", fun, ["VECTOR", :reverse $freeVariables]]
val := objNew(code,rt := ['Mapping,computedResultType,:rest types])
@@ -786,7 +784,7 @@ mkIterFun([index,:s],funBody) ==
$boundVariables: local := [index]
body := checkForFreeVariables(objVal getValue funBody,"ALL")
parms := [index,"envArg"]
- val:=['function,['LAMBDA,parms,:declareUnusedParameters(parms,body)]]
+ val:=['function,declareUnusedParameters ['LAMBDA,parms,body]]
vec := mkAtreeNode gensym()
putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
vec
@@ -926,7 +924,7 @@ mkIterZippedFun(indexList,funBody,zipType,$localVars) ==
body :=
[checkForFreeVariables(form,$localVars) for form in getValue funBody]
parms := [$index,'envArg]
- val:=['function,['LAMBDA,parms,:declareUnusedParameters(parms,objVal body)]]
+ val:=['function,declareUnusedParameters ['LAMBDA,parms,objVal body]]
vec := mkAtreeNode gensym()
putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode))
vec
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index a1ea2cb3..a6466db1 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -153,8 +153,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
parms := [:argl,"envArg"]
cacheCount = 0 or null argl =>
- fun:= [nam,["LAMBDA",parms,:declareUnusedParameters(parms,body)]]
- compileInteractive fun
+ compileInteractive [nam,["LAMBDA",parms,body]]
nam
num :=
FIXP cacheCount =>
@@ -190,8 +189,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
-- of above.
lamex:= ["LAM",arg,codeBody]
mainFunction:= [nam,lamex]
- computeFunction:= [auxfn,["LAMBDA",parms,
- :declareUnusedParameters(parms,body)]]
+ computeFunction:= [auxfn,["LAMBDA",parms,body]]
compileInteractive mainFunction
compileInteractive computeFunction
cacheType:= "function"
@@ -225,8 +223,7 @@ reportFunctionCacheAll(op,nam,argl,body) ==
lamex:= ["LAM",arg,codeBody]
mainFunction:= [nam,lamex]
parms := [:argl, "envArg"]
- computeFunction:= [auxfn,["LAMBDA",parms,
- :declareUnusedParameters(parms,body)]]
+ computeFunction:= [auxfn,["LAMBDA",parms,body]]
compileInteractive mainFunction
compileInteractive computeFunction
cacheType:= 'hash_-table
@@ -304,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,["LAM",margl,:declareUnusedParameters(margl,mbody)]] where
+ mainFunction:= [nam,["LAM",margl,mbody]] where
margl:= [:argl,'envArg]
max:= gensym()
tripleCode := ["CONS",n,["LIST",:initCode]]
@@ -412,8 +409,8 @@ clearLocalModemaps x ==
compileInteractive fn ==
if $InteractiveMode then startTimingProcess 'compilation
- --following not used for common lisp
- --removeUnnecessaryLastArguments second fn
+ if fn is [.,[bindOp,.,.]] and bindOp in $AbstractionOperator then
+ fn := [first fn,declareUnusedParameters second fn]
if $reportCompilation then
sayBrightlyI bright '"Generated LISP code for function:"
pp fn