Don't error on type abstraction when cloning binders.

[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 2d2a9068bd8b0d8042aeba6ea60eb4f342916783..dd62a34136a9ba0e84d587d48f9a3d69633f22e5 100644 (file)
--- a/cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/cλash/CLasH/Normalize/NormalizeTools.hs
@@ -24,12 +24,15 @@ 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
 import qualified CLasH.VHDL.VHDLTools as VHDLTools
 
@@ -179,9 +182,10 @@ substitute ((b, e):subss) expr = substitute subss' expr'
     subss' = map (Arrow.second (CoreSubst.substExpr subs)) subss
 
 -- Is the given expression representable at runtime, based on the type?
-isRepr :: CoreSyn.CoreExpr -> TransformMonad Bool
-isRepr (Type ty) = return False
-isRepr expr = Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType (CoreUtils.exprType expr)
+isRepr :: (CoreTools.TypedThing t) => t -> TransformMonad Bool
+isRepr tything = case CoreTools.getType tything of
+  Nothing -> return False
+  Just ty -> Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType ty 
 
 is_local_var :: CoreSyn.CoreExpr -> TranslatorSession Bool
 is_local_var (CoreSyn.Var v) = do
@@ -201,3 +205,15 @@ isUserDefined bndr = str `elem` compiler_names
     -- 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)