Use data-accessor-transformers package to remove deprecation warnings

[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 f38da518e8535b68e4f560fdbae021db1d1b7af9..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 Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
 
 -- GHC API
 import CoreSyn
@@ -24,11 +24,13 @@ import qualified Name
 import qualified Id
 import qualified CoreSubst
 import qualified CoreUtils
+import qualified Type
 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
 import CLasH.Normalize.NormalizeTypes
 import CLasH.Translator.TranslatorTypes
+import CLasH.Utils
 import CLasH.Utils.Pretty
 import qualified CLasH.Utils.Core.CoreTools as CoreTools
 import CLasH.VHDL.VHDLTypes
@@ -134,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
-        change $ substitute [(bndr, expr')] res
+        res' <- substitute_clone bndr expr' res
+        change res'
       else
         -- Don't change this let
         return expr
@@ -160,24 +163,26 @@ changeif :: Bool -> a -> TransformMonad a
 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
@@ -196,10 +201,22 @@ 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
-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
     -- reason these are not marked as system, probably because the name itself
     -- is not made up by the compiler, just this particular binding is.
     compiler_names = ["fromInteger"]
+
+-- Is the given binder normalizable? This means that its type signature can be
+-- represented in hardware, which should (?) guarantee that it can be made
+-- into hardware. Note that if a binder is not normalizable, it might become
+-- so using argument propagation.
+isNormalizeable :: CoreBndr -> TransformMonad Bool 
+isNormalizeable bndr = do
+  let ty = Id.idType bndr
+  let (arg_tys, res_ty) = Type.splitFunTys ty
+  -- This function is normalizable if all its arguments and return value are
+  -- representable.
+  andM $ mapM isRepr (res_ty:arg_tys)