X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FUtils%2FCore%2FCoreTools.hs;h=42373a4eace28d337b193d9eb1376f7666061d7f;hb=1ccb9c8289bfb3c2701bf62435332b4c94b04169;hp=45721a891a7bf6d1662465322795daa2995a67ff;hpb=b2967df7f237e5b4db15d069895ca01c31712d9e;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 45721a8..42373a4 100644 --- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" +++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" @@ -40,7 +40,7 @@ import CLasH.Utils.Pretty -- library to a real int. eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int eval_tfp_int env ty = - unsafeRunGhc $ do + unsafeRunGhc libdir $ do GHC.setSession env -- Automatically import modules for any fully qualified identifiers setDynFlag DynFlags.Opt_ImplicitImportQualified @@ -52,7 +52,10 @@ eval_tfp_int env ty = let int_ty = SrcLoc.noLoc $ HsTypes.HsTyVar TysWiredIn.intTyCon_RDR let expr = HsExpr.ExprWithTySig app int_ty core <- toCore expr - execCore core + execCore core + where + libdir = DynFlags.topDir dynflags + dynflags = HscTypes.hsc_dflags env normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type normalise_tfp_int env ty = @@ -208,3 +211,14 @@ getLiterals app@(CoreSyn.App _ _) = literals where (CoreSyn.Var f, args) = CoreSyn.collectArgs app literals = filter (is_lit) args + +-- reduceCoreListToHsList :: CoreExpr -> [a] +reduceCoreListToHsList app@(CoreSyn.App _ _) = out + where + (fun, args) = CoreSyn.collectArgs app + len = length args + out = case len of + 3 -> ((args!!1) : (reduceCoreListToHsList (args!!2))) + otherwise -> [] + +reduceCoreListToHsList _ = []