From 1328fa0128ebf17c274b230eb724df195be8a915 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 7 Dec 2011 19:21:43 +0000
Subject: 	* interp/g-opt.boot (removeSeq!): New. 	(inlineLocals!):
 Likewise. 	(optimizeFunctionDef): Use them. 	(optSeq): Tidy. 
 * interp/buildom.boot (seteltRecordFun): Tidy. 	* interp/clam.boot
 (compHash): Likewise.

---
 src/interp/buildom.boot |  2 +-
 src/interp/clam.boot    |  4 ++--
 src/interp/g-opt.boot   | 43 ++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 43 insertions(+), 6 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 05a09efe..5d662bb7 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -605,7 +605,7 @@ seteltRecordFun(n,i) ==
   field := formalRecordField(n,i)
   body := 
     n > 2 => ['%store,field,"#3"]
-    ['%seq,['%store,field,"#3"],['%exit,field]]
+    ['%seq,['%store,field,"#3"],field]
   ["XLAM",args,body]
 
 copyRecordFun n ==
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 65602dd1..9df15798 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -229,7 +229,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
           ['tableValue,cacheNameOrNil,MKQ op],MKQ eqEtc]
       ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]]
     ['tableValue,cacheName,g1]
-  secondPredPair:= [g2,optSeq ['%seq,:hitCountCode,['%exit,returnFoundValue]]]
+  secondPredPair:= [g2,optSeq ['%seq,:hitCountCode,returnFoundValue]]
   putCode:=
     null argl =>
       cacheNameOrNil =>
@@ -249,7 +249,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
   thirdPredPair:= ['%otherwise,putCode]
   codeBody:= optSeq
     ['%seq,:callCountCode,
-      ['%exit,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]]
+      ['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]
   lamex:= ['LAM,arg,codeBody]
   mainFunction:= [op,lamex]
   computeFunction:= [auxfn,['LAMBDA,argl,:body]]
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 1bf11beb..05708d68 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -214,6 +214,44 @@ reduceXLAM! x == walkWith!(x,function f) where
      resetTo(x,doInlineCall(args,y.absParms,copyTree y.absBody))
     x
 
+++ Splice in all %seq subforms, remove throw away expressions,
+++ and remove unnecessary %seq boxes around singleton expressions.
+removeSeq! x == walkWith!(x,function f) where
+  f x ==
+    x is ['%seq,:.] =>
+      x.args := g x.args
+      x.args is [y] => resetTo(x,y)
+      x
+    x
+  g xs ==
+    xs = nil => nil
+    x := first xs
+    x is "/throwAway" => g rest xs          -- skip garbages
+    x is ['%seq,:.] =>                      -- splice sub-sequences
+      ys := g x.args =>
+        lastNode(ys).rest := g rest xs
+        ys
+      g rest xs                             -- skip empty statements
+    rest xs = nil => xs
+    xs.rest := g rest xs
+    xs
+
+inlineLocals! x == walkWith!(x,function f) where
+  f x ==
+    x is ['%bind,inits,:.] =>
+      kept := nil
+      while inits is [u,:inits] repeat
+        [y,z] := u
+        usedSymbol?(y,z) or usedSymbol?(y,inits) => kept := [u,:kept]
+        or/[usedSymbol?(v,z) for [v,.] in kept] => kept := [u,:kept]
+        canInlineVarDefinition(y,z,x.absBody) =>
+          x.absBody := substitute!(z,y,x.absBody)
+        kept := [u,:kept]
+      kept = nil => resetTo(x,x.absBody)
+      x.absParms := reverse! kept
+      x
+    x
+
 optimizeFunctionDef(def) ==
   if $reportOptimization then
     sayBrightlyI bright '"Original LISP code:"
@@ -221,7 +259,8 @@ optimizeFunctionDef(def) ==
  
   expr := copyTree second def
   changeVariableDefinitionToStore(expr.absBody,expr.absParms)
-  expr := simplifyVMForm reduceXLAM! groupTranscients! expr
+  expr := simplifyVMForm removeSeq! inlineLocals!
+            groupTranscients! reduceXLAM! expr
  
   if $reportOptimization then
     sayBrightlyI bright '"Intermediate VM code:"
@@ -481,8 +520,6 @@ optSeq ['%seq,:l] ==
       null l => nil
       l is [["%LET",g,x],:r] and replaceableTemporary?(g,r) =>
         getRidOfTemps substitute(x,g,r)
-      first l is "/throwAway" => getRidOfTemps rest l
-      --this gets rid of unwanted labels generated by declarations in %seq
       [first l,:getRidOfTemps rest l]
     seqToCOND l ==
       transform:= [[a,b] for x in l while (x is ['%when,[a,['%exit,b]]])]
-- 
cgit v1.2.3