* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %fmanexp.

	(sideEffectFree?): New.
	(varIsAssigned): Tidy.
	(canInlineVarDefinition): Likewise.
	* interp/boot-pkg.lisp (gensym?): New.
	* interp/c-util.boot ($NonExpandableOperators): New.
	(expandableDefinition?): Use it.
	* algebra/sf.spad.pamphlet (DoubleFloat): Use %fmanexp.

4 files changed, 42 insertions, 13 deletions

diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp
index bad04369..b7b1cd56 100644
--- a/src/interp/boot-pkg.lisp
+++ b/src/interp/boot-pkg.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -60,6 +60,9 @@
  (defun define-function (f v)
    (setf (symbol-function f) v)))
 
+(defun |gensym?| (s)
+  (null (symbol-package s)))
+
 ;; Below are some missing functions.  There here for lack of better
 ;; place (sys-funs.lisp?)
 ;;
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e77ce4f8..beaa874c 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1163,6 +1163,11 @@ usesVariablesLinearly?(form,vars) ==
   atomic? form => true
   and/[numOfOccurencesOf(var,form) < 2 for var in vars] 
 
+++ List of builtin operators we should not attempt to promote
+++ to inlinable status.
+$NonExpandableOperators ==
+  '(%store %LET SPADCALL %bind LET)
+
 ++ We are processing a function definition with parameter list `vars'
 ++ and body given by `body'.  If `body' is a form that can be inlined,
 ++ then return the inline form.  Otherwise, return nil.
@@ -1176,11 +1181,11 @@ expandableDefinition?(vars,body) ==
     -- we want to avoid disturbing object identity, so we rule
     -- out use of side-effect full operators.  
     -- FIXME: This should be done only for constant creators.
-    null vars' => semiSimpleRelativeTo?(body,$VMsideEffectFreeOperators)
+    null vars' => sideEffectFree? body
 
     atomic? body => true
     [op,:args] := body
-    not IDENTP op => false
+    not IDENTP op or op in $NonExpandableOperators => false
     and/[atomic? x for x in args] 
       or semiSimpleRelativeTo?(body,$simpleVMoperators) =>
                 usesVariablesLinearly?(body,vars')
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index a3ef3050..d99f8c6a 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -407,7 +407,7 @@ $VMsideEffectFreeOperators ==
     %irem %iquo %idivide %idec
     %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
     %fpowi %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
-    %fsqrt %fpowf %flog %flog2 %flog10
+    %fsqrt %fpowf %flog %flog2 %flog10 %fmanexp
     %fsin  %fcos  %ftan  %fcot  %fsec  %fcsc
     %fasin %facos %fatan %facot %fasec %facsc
     %fsinh  %fcosh  %ftanh  %fcsch  %fcoth  %fsech
@@ -435,9 +435,13 @@ $simpleVMoperators ==
 ++ to the list of operators `ops'.
 semiSimpleRelativeTo?(form,ops) ==
   atomic? form => true
-  form isnt [op,:args] or not MEMQ(op,ops) => false
+  form isnt [op,:args] or not symbol? op or not MEMQ(op,ops) => false
   and/[semiSimpleRelativeTo?(f,ops) for f in args]
 
+++ Return true if `form' os a side-effect free form.  
+sideEffectFree? form ==
+  semiSimpleRelativeTo?(form,$VMsideEffectFreeOperators)
+
 ++ Return true if `form' is a simple VM form.
 ++ See $simpleVMoperators for the definition of simple operators.
 isSimpleVMForm form ==
@@ -449,8 +453,8 @@ isFloatableVMForm: %Code -> %Boolean
 isFloatableVMForm form ==
   atom form => form ~= "$"
   form is ["QUOTE",:.] => true
-  MEMQ(first form, $simpleVMoperators) and
-    "and"/[isFloatableVMForm arg for arg in rest form]
+  MEMQ(form.op, $simpleVMoperators) and
+    "and"/[isFloatableVMForm arg for arg in form.args]
     
 
 ++ Return true if the VM form `form' is one that we certify to 
@@ -476,16 +480,32 @@ findVMFreeVars form ==
 ++ in `form'.
 varIsAssigned(var,form) ==
   atomic? form => false
-  form is [op,=var,:.] and op in '(%LET LETT SETQ %store) => true
+  form is [op,var',:.] and op in '(%LET LETT SETQ %store) =>
+    symbol? var' => var' = var   -- whole var is assigned
+    var' is [.,=var]             -- only part of it is modified
   or/[varIsAssigned(var,f) for f in form]
 
-++ Subroutine of optLET.  Return true if the variable `var' locally
-++ defined in the LET-form can be safely replaced by its initalization
-++ `expr' in the `body' of the LET-form.
+++ Subroutine of optLET and optBind.  Return true if the variable `var' locally
+++ defined in a binding form can be safely replaced by its initalization
+++ `expr' in the `body' of the binding form.
 canInlineVarDefinition(var,expr,body) ==
+  -- If the variable is assigned to, that is a no no.
   varIsAssigned(var,body) => false
-  numOfOccurencesOf(var,body) < 2 => true
-  atom expr and not varIsAssigned(expr,body)
+  -- Similarly, if the variable is initialized from a variable that
+  -- is latter assigned, it is a no no.
+  IDENTP expr and varIsAssigned(expr,body) => false
+  -- Conversatively preserve order of inialization
+  body is ['%bind,:.] => false
+  -- Linearly used internal temporaries should be replaced, and
+  -- so should side-effet free initializers for linear variables.
+  usageCount := numOfOccurencesOf(var,body)
+  usageCount < 2 and (gensym? var or sideEffectFree? expr) => true
+  -- If the initializer is a variable and the body is
+  -- a series of choices with side-effect free predicates, then
+  -- no harm is done by removing the local `var'.
+  IDENTP expr and body is ['%when,:branches] =>
+    and/[sideEffectFree? pred for [pred,:.] in branches]
+  false
 
 ++ Implement simple-minded LET-inlining.  It seems we can't count
 ++ on Lisp implementations to do this simple transformation.
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index a7e42468..8a9a01d2 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -515,6 +515,7 @@ for x in [
     ['%fmul,  :"*"],
     ['%fpowi, :'EXPT],
     ['%fsub,  :"-"],
+    ['%fmanexp, :'MANEXP],               -- (mantissa, exponent) pair.
 
     ['%fexp,   :'EXP],
     ['%fsin,   :'SIN],