diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/algebra/any.spad.pamphlet | 17 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 26 |
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_-)_ |