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
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
isUserDefined :: CoreSyn.CoreBndr -> Bool
-- System names are certain to not be user defined
isUserDefined bndr | Name.isSystemName (Id.idName bndr) = False
--- Assume everything else is user defined
-isUserDefined bdnr = True
-
+-- Check a list of typical compiler-defined names
+isUserDefined bndr = 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)