Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

[matthijs/master-project/cλash.git] / NormalizeTools.hs

diff --git a/NormalizeTools.hs b/NormalizeTools.hs
index 91e5b4526bbd272ff95b020b8a010f2040b55e4f..6699101d33bc18a3a90a8870ce18d095cd72b129 100644 (file)
--- a/NormalizeTools.hs
+++ b/NormalizeTools.hs
@@ -5,6 +5,7 @@
 module NormalizeTools where
 -- Standard modules
 import Debug.Trace
 module NormalizeTools where
 -- Standard modules
 import Debug.Trace

+import qualified List

 import qualified Data.Monoid as Monoid
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State


@@ -23,6 +24,7 @@ import qualified SrcLoc
 import qualified Type
 import qualified IdInfo
 import qualified CoreUtils
 import qualified Type
 import qualified IdInfo
 import qualified CoreUtils

+import qualified CoreSubst

 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports


@@ -122,6 +124,18 @@ dotransforms' transs expr = do
   (expr', changed) <- Writer.runWriterT $ Monad.foldM (flip ($)) expr transs
   if Monoid.getAny changed then dotransforms' transs expr' else return expr'
 
   (expr', changed) <- Writer.runWriterT $ Monad.foldM (flip ($)) expr transs
   if Monoid.getAny changed then dotransforms' transs expr' else return expr'
 

+-- Inline all let bindings that satisfy the given condition
+inlinebind :: ((CoreBndr, CoreExpr) -> Bool) -> Transform
+inlinebind condition (Let (Rec binds) expr) | not $ null replace =
+    change newexpr
+  where 
+    -- Find all simple bindings
+    (replace, others) = List.partition condition binds
+    -- Substitute the to be replaced binders with their expression
+    newexpr = substitute replace (Let (Rec others) expr)
+-- Leave all other expressions unchanged
+inlinebind _ expr = return expr
+

 -- Sets the changed flag in the TransformMonad, to signify that some
 -- transform has changed the result
 setChanged :: TransformMonad ()
 -- Sets the changed flag in the TransformMonad, to signify that some
 -- transform has changed the result
 setChanged :: TransformMonad ()


@@ -140,3 +154,9 @@ mkUnique = Trans.lift $ do
     let (us', us'') = UniqSupply.splitUniqSupply us
     putA tsUniqSupply us'
     return $ UniqSupply.uniqFromSupply us''
     let (us', us'') = UniqSupply.splitUniqSupply us
     putA tsUniqSupply us'
     return $ UniqSupply.uniqFromSupply us''

+
+-- Replace each of the binders given with the coresponding expressions in the
+-- given expression.
+substitute :: [(CoreBndr, CoreExpr)] -> CoreExpr -> CoreExpr
+substitute replace expr = CoreSubst.substExpr subs expr
+    where subs = foldl (\s (b, e) -> CoreSubst.extendIdSubst s b e) CoreSubst.emptySubst replace