X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FUtils%2FCore%2FCoreTools.hs;h=acc2fa630c416a32f6a99a15c0df18281b6526da;hb=c008a8ed467bc6fc4878c2ff56cbba2e6f8dd6b5;hp=cd85b4d0102e257d8f650782e9fdac516fbe6c2f;hpb=843f4ae4fae495fd340022febf4bf42bac9000a0;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" index cd85b4d..acc2fa6 100644 --- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" +++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" @@ -38,6 +38,7 @@ import qualified CoreFVs import qualified Literal import qualified MkCore import qualified VarEnv +import qualified Literal -- Local imports import CLasH.Translator.TranslatorTypes @@ -193,6 +194,10 @@ is_simple _ = False 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 @@ -224,13 +229,21 @@ get_val_args ty args = drop n args -- 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 @@ -361,8 +374,8 @@ genUniques' subst (CoreSyn.App f arg) = do 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