aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot57
-rw-r--r--src/interp/define.boot7
-rw-r--r--src/interp/i-map.boot3
-rw-r--r--src/interp/i-spec1.boot3
-rw-r--r--src/interp/slam.boot3
-rw-r--r--src/interp/sys-driver.boot1
6 files changed, 54 insertions, 20 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index c18d6b52..3af79992 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1215,11 +1215,31 @@ mutateToBackendCode x ==
$LocalVars := REMOVE_-IF(function LAMBDA(y(), y in newBindings),
$LocalVars)
[u,second x,:res]
+ u = "DECLARE" => nil -- there is nothing to do convert there
mutateToBackendCode u
mutateToBackendCode rest x
-++ Generate Lisp code by lowering middle end form `x'.
+skipDeclarations: %List -> %List
+skipDeclarations form ==
+ while first form is ["DECLARE",:.] repeat
+ form := rest form
+ form
+
+++ return the last node containing a declaration in form, otherwise nil.
+lastDeclarationNode: %List -> %List
+lastDeclarationNode form ==
+ while second form is ["DECLARE",:.] repeat
+ form := rest form
+ first form is ["DECLARE",:.] => form
+ nil
+
+declareGlobalVariables: %List -> %List
+declareGlobalVariables vars ==
+ ["DECLARE",["SPECIAL",:vars]]
+
+++ Generate Lisp code by lowering middle end defining form `x'.
+++ x has the strucrure: <name, parms, stmt1, ...>
transformToBackendCode: %Form -> %Code
transformToBackendCode x ==
$FluidVars: fluid := nil
@@ -1227,27 +1247,32 @@ transformToBackendCode x ==
$SpecialVars: fluid := nil
x := middleEndExpand x
mutateToBackendCode CDDR x
+ body := skipDeclarations CDDR x
+ -- Make it explicitly a sequence of statements if it is not a one liner.
body :=
- null CDDDR x and
- (atom third x or first third x = "SEQ"
- or not CONTAINED("EXIT",third x)) =>
- third x
- ["SEQ",:CDDR x]
- x := [first x, second x, body]
+ stmt := first body
+ null rest body and
+ (atom stmt or first stmt = "SEQ" or not CONTAINED("EXIT",stmt)) =>
+ body
+ [["SEQ",:body]]
$FluidVars := REMDUP nreverse $FluidVars
$LocalVars := S_-(S_-(REMDUP nreverse $LocalVars,$FluidVars),
LISTOFATOMS second x)
lvars := [:$FluidVars,:$LocalVars]
fluids := S_+($FluidVars,$SpecialVars)
- x :=
+ body :=
fluids ^= nil =>
- [first x, second x, ["PROG",lvars,["DECLARE","SPECIAL",:fluids],
- ["RETURN",third x]]]
- [first x, second x,
- (lvars ^= nil or CONTAINED("RETURN",third x) =>
- ["PROG",lvars,["RETURN",third x]]; third x)]
+ [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]]
+ lvars ^= nil or CONTAINED("RETURN",body) =>
+ [["PROG",lvars,["RETURN",:body]]]
+ body
-- add reference parameters to the list of special variables.
fluids := S_+(backendFluidize second x, $SpecialVars)
- null fluids => x
- [first x, second x, ["DECLARE","SPECIAL",:fluids],:CDDR x]
-
+ lastdecl := lastDeclarationNode rest x
+ if lastdecl = nil then
+ RPLACD(rest x, body)
+ else
+ null fluids =>
+ RPLACD(lastdecl, body)
+ RPLACD(lastdecl, [declareGlobalVariables fluids,:body])
+ x
diff --git a/src/interp/define.boot b/src/interp/define.boot
index ae460b75..3104d044 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1246,7 +1246,6 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
clearReplacement nam -- Make sure we have fresh info
if $optReplaceSimpleFunctions then
body := replaceSimpleFunctions body
- form := [nam,[lam,vl,body]]
if vl is [:vl',E] and body is [nam',: =vl'] then
LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam']
@@ -1256,6 +1255,12 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
macform := ['XLAM,vl',body]
LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
sayBrightly ['" ",:bright nam,'"is replaced by",:bright body]
+
+ if GET(nam,"SPADreplace") then
+ form := [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]]
+ else
+ form := [nam,[lam,vl,body]]
+
$insideCapsuleFunctionIfTrue =>
$optExportedFunctionReference =>
$capsuleFunctionStack := [form,:$capsuleFunctionStack]
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 56eae07a..6ae29170 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -760,7 +760,8 @@ compileCoerceMap(op,argTypes,mm) ==
minivectorName := makeInternalMapMinivectorName(name)
body := substitute(minivectorName,"$$$",body)
setDynamicBinding(minivectorName,LIST2REFVEC $minivector)
- compileInteractive [name,['LAMBDA,parms,body]]
+ compileInteractive
+ [name,['LAMBDA,parms,declareGlobalVariables [minivectorName],body]]
CAR sig
depthOfRecursion(opName,body) ==
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index c3690278..93c383f7 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -177,7 +177,8 @@ compileADEFBody(t,vars,types,body,computedResultType) ==
--
-- MCD 13/3/96
if not $definingMap and ($genValue or $compilingMap) then
- fun := [$mapName,["LAMBDA",[:vars,'envArg],body]]
+ fun := [$mapName,["LAMBDA",[:vars,'envArg],
+ declareGlobalVariables [minivectorName],body]]
code := wrap compileInteractive fun
else
$freeVariables := []
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 672acb96..8adf4882 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -54,7 +54,8 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
cacheCount:= getCacheCount op
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
cacheCount = 0 or null argl =>
- fun:= [nam,["LAMBDA",[:argl,'envArg],body]]
+ fun:= [nam,["LAMBDA",[:argl,'envArg],
+ declareGlobalVariables [minivectorName],body]]
compileInteractive fun
nam
num :=
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index da622f96..4d21a797 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -59,6 +59,7 @@ $options := []
+++ to the interpreter or compiler.
+++ ??? This part is still in flux.
AxiomCore::%sysInit() ==
+ SETQ(_*READ_-DEFAULT_-FLOAT_-FORMAT_*, "DOUBLE-FLOAT")
SETQ(_*PACKAGE_*, FIND_-PACKAGE '"BOOT")
SETQ(_*LOAD_-VERBOSE_*,false)
initMemoryConfig()