import qualified Literal
import qualified MkCore
import qualified VarEnv
+import qualified Literal
-- Local imports
import CLasH.Translator.TranslatorTypes
has_free_tyvars :: CoreSyn.CoreExpr -> Bool
has_free_tyvars = not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars Var.isTyVar)
+-- Does the given type have any free type vars?
+ty_has_free_tyvars :: Type.Type -> Bool
+ty_has_free_tyvars = not . VarSet.isEmptyVarSet . Type.tyVarsOfType
+
-- Does the given CoreExpr have any free local vars?
has_free_vars :: CoreSyn.CoreExpr -> Bool
has_free_vars = not . VarSet.isEmptyVarSet . CoreFVs.exprFreeVars
-- arguments, to get at the value arguments.
n = length tyvars + length predtypes
-getLiterals :: CoreSyn.CoreExpr -> [CoreSyn.CoreExpr]
-getLiterals app@(CoreSyn.App _ _) = literals
+getLiterals :: HscTypes.HscEnv -> CoreSyn.CoreExpr -> [CoreSyn.CoreExpr]
+getLiterals _ app@(CoreSyn.App _ _) = literals
where
(CoreSyn.Var f, args) = CoreSyn.collectArgs app
literals = filter (is_lit) args
-getLiterals lit@(CoreSyn.Lit _) = [lit]
+getLiterals _ lit@(CoreSyn.Lit _) = [lit]
+
+getLiterals hscenv letrec@(CoreSyn.Let (CoreSyn.NonRec letBind (letExpr)) letRes) = [lit]
+ where
+ ty = Var.varType letBind
+ litInt = eval_tfp_int hscenv ty
+ lit = CoreSyn.Lit (Literal.mkMachInt (toInteger litInt))
+
+getLiterals _ expr = error $ "\nCoreTools.getLiterals: Not a known Lit: " ++ pprString expr
reduceCoreListToHsList ::
[HscTypes.CoreModule] -- ^ The modules where parts of the list are hidden
f' <- genUniques' subst f
arg' <- genUniques' subst arg
return (CoreSyn.App f' arg')
-genUniques' subst (CoreSyn.Lam bndr res) | CoreSyn.isTyVar bndr =
- error $ "Cloning type variables not supported!"
+-- Don't change type abstractions
+genUniques' subst expr@(CoreSyn.Lam bndr res) | CoreSyn.isTyVar bndr = return expr
genUniques' subst (CoreSyn.Lam bndr res) = do
-- Generate a new unique for the bound variable
(subst', bndr') <- genUnique subst bndr