* algebra/any.spad.pamphlet (AnyFunctions1): Remove `pretend'

	shenanigans.  Use is-case pattern matching.
	* interp/g-opt.boot (varIsAssigned): New.
	(canInlineVarDefinition): New.
	(optLET): Use it to inline functionally used local variables.
	Register as backend optimizer.

3 files changed, 47 insertions, 5 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 4ea91dc5..87ae21c9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2009-06-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* algebra/any.spad.pamphlet (AnyFunctions1): Remove `pretend'
+	shenanigans.  Use is-case pattern matching.
+	* interp/g-opt.boot (varIsAssigned): New.
+	(canInlineVarDefinition): New.
+	(optLET): Use it to inline functionally used local variables.
+	Register as backend optimizer.
+
+2009-06-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/sys-constants.boot ($defaultOptimizationLevel): New.
 	* interp/sys-driver.boot (initializeGlobalState): Use it for
 	default initialization level.
diff --git a/src/algebra/any.spad.pamphlet b/src/algebra/any.spad.pamphlet
index 0b7cd216..e7818eb2 100644
--- a/src/algebra/any.spad.pamphlet
+++ b/src/algebra/any.spad.pamphlet
@@ -231,6 +231,7 @@ import Any
 ++ Date Created:
 ++ Change History:
 ++ Basic Functions:  coerce, retractIfCan, retractable?, retract
+++ Date Last Updated: June 13, 2009.
 ++ Related Constructors: Any
 ++ Also See:
 ++ AMS Classification:
@@ -262,16 +263,22 @@ AnyFunctions1(S:Type): with
 
         Sexpr:SExpression := devaluate(S)$Lisp
 
-        retractable? a  == dom(a) = Sexpr
         coerce(s:S):Any == any(Sexpr, s::None)
 
+        retractable? a ==
+          case a is
+            s: S => true
+            otherwise => false
+
         retractIfCan a ==
-            retractable? a => obj(a) pretend S
-            "failed"
+          case a is
+            s: S => s
+            otherwise => "failed"
 
         retract a ==
-            retractable? a => obj(a) pretend S
-            error "Cannot retract value."
+          case a is
+            s: S => s
+            otherwise => error "Cannot retract value."
 
 @
 
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index dd8c04e0..c51987dc 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -421,6 +421,21 @@ findVMFreeVars form ==
   atom op => vars
   union(findVMFreeVars op,vars)
 
+++ Return true is `var' is the left hand side of an assignment
+++ in `form'.
+varIsAssigned(var,form) ==
+  isAtomicForm form => false
+  form is [op,=var,:.] and MEMQ(op,'(%LET LETT SETQ)) => true
+  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.
+canInlineVarDefinition(var,expr,body) ==
+  varIsAssigned(var,body) => false
+  numOfOccurencesOf(var,body) < 2 => true
+  atom expr and not varIsAssigned(expr,body)
+
 ++ Implement simple-minded LET-inlining.  It seems we can't count
 ++ on Lisp implementations to do this simple transformation.
 ++ This transformation will probably be more effective when all
@@ -429,6 +444,16 @@ findVMFreeVars form ==
 optLET u ==
   -- Hands off non-simple cases.
   u isnt ["LET",inits,body] => u
+  -- Inline functionally used local variables with their initializers.
+  inits := [:newInit for (init := [var,expr]) in inits] where 
+    newInit() ==
+      canInlineVarDefinition(var,expr,body) =>
+        body := substitute(expr,var,body)
+        nil  -- remove this initialization
+      [init] -- otherwwise keep it.
+  null inits => body
+  rplac(second u,inits)
+  rplac(third u,body)
   -- Avoid initialization forms that may not be floatable.
   not(and/[isFloatableVMForm init for [.,init] in inits]) => u
   -- Identity function.
@@ -473,6 +498,7 @@ lispize x == first optimize [x]
  
 for x in '( (call         optCall) _
            (SEQ          optSEQ)_
+           (LET          optLET)_
            (MINUS        optMINUS)_
            (QSMINUS      optQSMINUS)_
            (_-           opt_-)_