Add support for Lisp declarations in generated Lisp code.

	* interp/i-map.boot (compileCoerceMap): Tell backend that
	minivector is global.
	* interp/i-spec1.boot (compileADEFBody): Likewise.
	* interp/slam.boot (reportFunctionCompilation): Likewise.
	* interp/define.boot (spadCompileOrSetq): Tell backend to ignore
	last argument for simple functions.
	* interp/c-util.boot (skipDeclarations): New.
	(lastDeclarationNode): Likewise.
	(declareGlobalVariables): Likewise.
	(transformToBackendCode): Use them to allow for Lisp
	declarations in middle-end forms.
	* interp/sys-driver.boot (AxiomCore::%sysInit): Reading Lisp level
	Floating point numbers default to double precision.
	* algebra/strap: Update.

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()