diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 22 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 21 |
3 files changed, 51 insertions, 1 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f4814f71..8a6b7a9c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2011-12-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-opt.boot (groupTranscients!): New. + (reduceXLAM!): Likewise. + (optimizeFunctionDef): Call them before simplifyVMForm. + * interp/g-util.boot (mkSeq): New. + (abstraction?): Likewise. + (walkWith!): Likewise. + +2011-12-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot (compReduce1): Tidy. * interp/define.boot (compDefineCategory2): Likewise. * interp/nruncomp.boot (buildFunctor): Likewise. diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index d5eaa8be..1bf11beb 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -194,6 +194,26 @@ groupVariableDefinitions form == ['%seq,:stmts,['%exit,val]] mkBind(defs,expr) +++ Group all %LET-definitions of artificial/temporary variables +++ into %bind-forms, appropriate for inlining in later stages. +groupTranscients! x == walkWith!(x,function f) where + f x == + x is ['%scope,tag,y] and y is ['%seq,:.] => + defs := [s.args for s in y.args while s is ['%LET,z,u] + and gensym? z and hasNoLeave?(u,tag)] + defs = nil => x + resetTo(x,mkBind(defs,mkScope(tag,mkSeq drop(#defs,y.args)))) + x + +++ Reduce all applications of XLAM-abstractions to arguments. +++ This is done before simplifyVMForm to expose more opportunities +++ for further reductions. +reduceXLAM! x == walkWith!(x,function f) where + f x == + x is ['%call,y,:args] and y is ['XLAM,:.] => + resetTo(x,doInlineCall(args,y.absParms,copyTree y.absBody)) + x + optimizeFunctionDef(def) == if $reportOptimization then sayBrightlyI bright '"Original LISP code:" @@ -201,7 +221,7 @@ optimizeFunctionDef(def) == expr := copyTree second def changeVariableDefinitionToStore(expr.absBody,expr.absParms) - expr := simplifyVMForm expr + expr := simplifyVMForm reduceXLAM! groupTranscients! expr if $reportOptimization then sayBrightlyI bright '"Intermediate VM code:" diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 7e15d637..a43ff7c7 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -38,6 +38,7 @@ import daase namespace BOOT module g_-util where + abstraction?: %Form -> %Boolean getTypeOfSyntax: %Form -> %Mode pairList: (%List %Form,%List %Form) -> %List %Pair(%Form,%Form) mkList: %List %Form -> %Form @@ -46,9 +47,13 @@ module g_-util where isDefaultPackageName: %Symbol -> %Boolean makeDefaultPackageName: %String -> %Symbol spliceSeqArgs: %List %Code -> %Code + mkSeq: %List %Code -> %Code --% +abstraction? x == + x is [op,:.] and ident? op and abstractionOperator? op + hasNoLeave?(expr,g) == expr is ['%leave, =g,:.] => false expr isnt [.,:.] => true @@ -68,6 +73,10 @@ mkBind(inits,expr) == mkBind([:inits,:inits'],expr') ['%bind,inits,expr] +mkSeq stmts == + stmts is [s] => s + ['%seq,:stmts] + ++ Given a (possibly multiple) assignment expression `u', return ++ the list of all assignment sub-expressions that must be evaluated before ++ effecting the toplevel assignment indicated by `u'. In that case, @@ -101,6 +110,18 @@ spliceSeqArgs l == l.rest := spliceSeqArgs rest l l +++ Apply the function `f' on all non-atomic subforms of `x' in +++ depth-first walk. Mutate `x' in place, replacing each sub-form +++ with the result of applying `f' to that subform. +walkWith!(x,f) == + atomic? x => x + abstraction? x => + x.absBody := walkWith!(x.absBody,f) + x + for ys in tails x | not atomic? first ys repeat + ys.first := walkWith!(first ys,f) + apply(f,x,nil) + --% ++ List of category constructors that do not have entries in the |