aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-06-13 21:53:21 +0000
committerdos-reis <gdr@axiomatics.org>2009-06-13 21:53:21 +0000
commit700e13eca3eaac940000e3529d761dc7b4b15e5e (patch)
treeb3121af3c00a59bb0ce0ae0146d7414057d2dce3
parent132209605a569012699d48f985c09c4f5826a0d2 (diff)
downloadopen-axiom-700e13eca3eaac940000e3529d761dc7b4b15e5e.tar.gz
* 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.
-rw-r--r--src/ChangeLog9
-rw-r--r--src/algebra/any.spad.pamphlet17
-rw-r--r--src/interp/g-opt.boot26
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_-)_