Add variant of isRepr that operates in the TranslatorSession.

[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 1995e38f9f69d44145bfec77ea264f4330ea9645..3da2728176ec42b95e8cbf5a267f2d07658038e9 100644 (file)
--- a/cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/cλash/CLasH/Normalize/NormalizeTools.hs
@@ -41,8 +41,8 @@ applyboth first (name, second) expr = do
   expr' <- first expr
   -- Apply the second
   (expr'', changed) <- Writer.listen $ second expr'
-  if Monoid.getAny
-        -- $ trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
+  if Monoid.getAny $
+        -- trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n")
         changed 
     then 
      -- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
@@ -178,9 +178,12 @@ substitute_clone find repl expr = subeverywhere (substitute_clone find repl) exp
 
 -- Is the given expression representable at runtime, based on the type?
 isRepr :: (CoreTools.TypedThing t) => t -> TransformMonad Bool
-isRepr tything = case CoreTools.getType tything of
+isRepr tything = Trans.lift (isRepr' tything)
+
+isRepr' :: (CoreTools.TypedThing t) => t -> TranslatorSession Bool
+isRepr' tything = case CoreTools.getType tything of
   Nothing -> return False
-  Just ty -> Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType ty 
+  Just ty -> MonadState.lift tsType $ VHDLTools.isReprType ty 
 
 is_local_var :: CoreSyn.CoreExpr -> TranslatorSession Bool
 is_local_var (CoreSyn.Var v) = do
@@ -199,7 +202,7 @@ isUserDefined bndr = str `notElem` compiler_names
     -- 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"]
+    compiler_names = ["fromInteger", "head", "tail", "init", "last", "+", "*", "-", "!"]
 
 -- Is the given binder normalizable? This means that its type signature can be
 -- represented in hardware, which should (?) guarantee that it can be made