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 SrcLoc
import qualified Type
import qualified IdInfo
+import qualified CoreUtils
+import qualified CoreSubst
import Outputable ( showSDoc, ppr, nest )
-- Local imports
(expr'', changed) <- Writer.listen $ second expr'
if Monoid.getAny changed
then
- trace ("Transform " ++ name ++ " changed from:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nTo:\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n") $
+ trace ("Transform " ++ name ++ " changed from:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n" ++ "\nTo:\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
applyboth first (name, second) 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 ()
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