Actually make the scrutinee binder removal not crash.

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

diff --git a/cλash/CLasH/Normalize/NormalizeTools.hs b/cλash/CLasH/Normalize/NormalizeTools.hs
index dd62a34136a9ba0e84d587d48f9a3d69633f22e5..936a4ec1e834ec59c6cc49002f50f1878c544d6e 100644 (file)
--- a/cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/cλash/CLasH/Normalize/NormalizeTools.hs
@@ -16,7 +16,7 @@ import qualified Control.Monad.Trans.Writer as Writer
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor

-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn


@@ -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
 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
         -- Substitute the binding in res and return that

-        change $ substitute [(bndr, expr')] res
+        res' <- substitute_clone bndr expr' res
+        change res'

       else
         -- Don't change this let
         return expr
       else
         -- Don't change this let
         return expr


@@ -162,24 +163,26 @@ changeif :: Bool -> a -> TransformMonad a
 changeif True val = change val
 changeif False val = return val
 
 changeif True val = change val
 changeif False val = return val
 

--- Replace each of the binders given with the coresponding expressions in the
--- given expression.
-substitute :: [(CoreBndr, CoreExpr)] -> CoreExpr -> CoreExpr
-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
+-- | 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 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_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_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
 
 -- Is the given expression representable at runtime, based on the type?
 isRepr :: (CoreTools.TypedThing t) => t -> TransformMonad Bool


@@ -198,7 +201,7 @@ isUserDefined :: CoreSyn.CoreBndr -> Bool
 -- System names are certain to not be user defined
 isUserDefined bndr | Name.isSystemName (Id.idName bndr) = False
 -- Check a list of typical compiler-defined names
 -- System names are certain to not be user defined
 isUserDefined bndr | Name.isSystemName (Id.idName bndr) = False
 -- Check a list of typical compiler-defined names

-isUserDefined bndr = str `elem` compiler_names
+isUserDefined bndr = not $ str `elem` compiler_names

   where
     str = Name.getOccString bndr
     -- These are names of bindings usually generated by the compiler. For some
   where
     str = Name.getOccString bndr
     -- These are names of bindings usually generated by the compiler. For some