X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize%2FNormalizeTools.hs;h=ed538cfc455ffc8431b834a0cd768f353b539af0;hb=25b6c1ebc720fda83104b93d4a24ad8dde4d71a5;hp=1995e38f9f69d44145bfec77ea264f4330ea9645;hpb=fc16bdb6576ef2c08d3675fdbf74fd61d5d25589;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
index 1995e38..ed538cf 100644
--- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
+++ "b/c\316\273ash/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
@@ -193,22 +196,45 @@ 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 `notElem` compiler_names
+isUserDefined bndr = str `notElem` (compiler_names ++ builtin_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"]
+    builtin_names = [ "!", "replace", "head", "last", "tail", "take", "drop"
+                    , "select", "+>", "<+", "++", "map", "zipWith", "foldl"
+                    , "foldr", "zip", "unzip", "shiftl", "shiftr", "rotl"
+                    , "rotr", "concat", "reverse", "iteraten", "iterate"
+                    , "generaten", "generate", "empty", "singleton", "copyn"
+                    , "copy", "lengthT", "null", "hwxor", "hwand", "hwor"
+                    , "hwnot", "not", "+", "*", "-", "fromSizedWord"
+                    , "resizeWord", "resizeInt", "fst", "snd", "blockRAM"
+                    , "split", "==", "/=", "init"
+                    ]
+
+    -- , (ltId             , (2, genOperator2 (AST.:<:)  ) )
+    -- , (lteqId           , (2, genOperator2 (AST.:<=:) ) )
+    -- , (gtId             , (2, genOperator2 (AST.:>:)  ) )
+    -- , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
+    -- , (boolOrId         , (2, genOperator2 AST.Or     ) )
+    -- , (boolAndId        , (2, genOperator2 AST.And    ) )
+    -- , (negateId         , (1, genNegation             ) )
+    -- , (sizedIntId       , (1, genSizedInt             ) )
+    -- , (smallIntegerId   , (1, genFromInteger          ) )
 
 -- 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
+isNormalizeable bndr = Trans.lift (isNormalizeable' bndr)
+
+isNormalizeable' :: CoreBndr -> TranslatorSession 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)
+  andM $ mapM isRepr' (res_ty:arg_tys)