X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=NormalizeTools.hs;h=14e3faca07543f497da404cd8e5cb317c7e6d099;hb=acdf6e104979ff6354caeecf73eef680ea9369e4;hp=c36d85f2006f54aa84632c54afb4a9f40ce45efb;hpb=b5fe532686b527c92994415c1e7e287d33861242;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/NormalizeTools.hs b/NormalizeTools.hs
index c36d85f..14e3fac 100644
--- a/NormalizeTools.hs
+++ b/NormalizeTools.hs
@@ -7,6 +7,7 @@ module NormalizeTools where
 import Debug.Trace
 import qualified List
 import qualified Data.Monoid as Monoid
+import qualified Control.Arrow as Arrow
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State
 import qualified Control.Monad.Trans.Writer as Writer
@@ -74,6 +75,17 @@ cloneVar v = do
   -- contains, but vannillaIdInfo is always correct, since it means "no info").
   return $ Var.lazySetVarIdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
 
+-- Creates a new function with the same name as the given binder (but with a
+-- new unique) and with the given function body. Returns the new binder for
+-- this function.
+mkFunction :: CoreBndr -> CoreExpr -> TransformMonad CoreBndr
+mkFunction bndr body = do
+  let ty = CoreUtils.exprType body
+  id <- cloneVar bndr
+  let newid = Var.setVarType id ty
+  Trans.lift $ addGlobalBind newid body
+  return newid
+
 -- Apply the given transformation to all expressions in the given expression,
 -- including the expression itself.
 everywhere :: (String, Transform) -> Transform
@@ -191,8 +203,21 @@ mkUnique = Trans.lift $ do
 -- 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.extendSubst s b e) CoreSubst.emptySubst replace
+substitute [] expr = expr
+-- Apply one substitution on the expression, but also on any remaining
+-- substitutions. This seems to be the only way to handle substitutions like
+-- [(b, c), (a, b)]. This means we reuse a substitution, which is not allowed
+-- according to CoreSubst documentation (but it doesn't seem to be a problem).
+-- TODO: Find out how this works, exactly.
+substitute ((b, e):subss) expr = substitute subss' expr'
+  where 
+    -- Create the Subst
+    subs = (CoreSubst.extendSubst CoreSubst.emptySubst b e)
+    -- Apply this substitution to the main expression
+    expr' = CoreSubst.substExpr subs expr
+    -- Apply this substitution on all the expressions in the remaining
+    -- substitutions
+    subss' = map (Arrow.second (CoreSubst.substExpr subs)) subss
 
 -- Run a given TransformSession. Used mostly to setup the right calls and
 -- an initial state.