From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Wed, 19 Aug 2009 15:14:50 +0000 (+0200)
Subject: Split substitute into substitute and substitute_clone.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=6e0808a8e328f0a5fc0c62f0328c978507fd5627;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Split substitute into substitute and substitute_clone.

Since cloning is not needed (nor possible) for type substitutions, this
makes things a bit more clear and elegant.
---

diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs"
index 4ef112b..6fd6a2e 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -64,8 +64,10 @@ etatop = notappargs ("eta", eta)
 -- β-reduction
 --------------------------------
 beta, betatop :: Transform
--- Substitute arg for x in expr
-beta (App (Lam x expr) arg) = setChanged >> substitute x arg expr
+-- Substitute arg for x in expr. For value lambda's, also clone before
+-- substitution.
+beta (App (Lam x expr) arg) | CoreSyn.isTyVar x = setChanged >> substitute x arg expr
+                            | otherwise      = setChanged >> substitute_clone x arg expr
 -- Propagate the application into the let
 beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
 -- Propagate the application into each of the alternatives
diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
index e32bd34..3761498 100644
--- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
+++ "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
@@ -136,9 +136,10 @@ inlinebind :: ((CoreBndr, CoreExpr) -> TransformMonad Bool) -> Transform
 inlinebind condition expr@(Let (NonRec bndr expr') res) = do
     applies <- condition (bndr, expr')
     if applies
-      then
+      then do
         -- Substitute the binding in res and return that
-        setChanged >> substitute bndr expr' res
+        res' <- substitute_clone bndr expr' res
+        change res'
       else
         -- Don't change this let
         return expr
@@ -162,28 +163,26 @@ changeif :: Bool -> a -> TransformMonad a
 changeif True val = change val
 changeif False val = return val
 
--- Creates a transformation that substitutes the given binder with the given
--- expression (This can be a type variable, replace by a Type expression). All
--- value binders in the expression are cloned before the replacement, to
--- guarantee uniqueness.
+-- | Creates a transformation that substitutes the given binder with the given
+-- expression (This can be a type variable, replace by a Type expression).
+-- Does not set the changed flag.
 substitute :: CoreBndr -> CoreExpr -> Transform
--- Use CoreSubst to subst a type var in a type
-substitute find (Type repl_ty) (Type ty) = do
-  let subst = CoreSubst.extendTvSubst CoreSubst.emptySubst find repl_ty
-  let ty' = CoreSubst.substTy subst ty 
-  return (Type ty')
--- Use CoreSubst to subst a type var in the type annotation of a case
-substitute find repl@(Type repl_ty) (Case scrut bndr ty alts) = do
-  let subst = CoreSubst.extendTvSubst CoreSubst.emptySubst find repl_ty
-  let ty' = CoreSubst.substTy subst ty 
-  -- And continue with substituting on all subexpressions of the case
-  subeverywhere (substitute find repl) (Case scrut bndr ty' alts)
+-- Use CoreSubst to subst a type var in an expression
+substitute find repl expr = do
+  let subst = CoreSubst.extendSubst CoreSubst.emptySubst find repl
+  return $ CoreSubst.substExpr subst expr 
+
+-- | Creates a transformation that substitutes the given binder with the given
+-- expression. This does only work for value expressions! All binders in the
+-- expression are cloned before the replacement, to guarantee uniqueness.
+substitute_clone :: CoreBndr -> CoreExpr -> Transform
 -- If we see the var to find, replace it by a uniqued version of repl
-substitute find repl (Var var) | find == var = do
-  setChanged >> (Trans.lift $ CoreTools.genUniques repl)
+substitute_clone find repl (Var var) | find == var = do
+  repl' <- Trans.lift $ CoreTools.genUniques repl
+  change repl'
 
 -- For all other expressions, just look in subexpressions
-substitute find repl expr = subeverywhere (substitute find repl) expr
+substitute_clone find repl expr = subeverywhere (substitute_clone find repl) expr
 
 -- Is the given expression representable at runtime, based on the type?
 isRepr :: (CoreTools.TypedThing t) => t -> TransformMonad Bool