TFVec builtin should now completely work

[matthijs/master-project/cλash.git] / cλash / CLasH / Utils / Core / CoreTools.hs

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index 0c0e1fa7f60d88cd3914b9fcf1c3b20073c3a8ff..b4808026fe37958e0d34d81baf70a229a83a5517 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/CLasH/Utils/Core/CoreTools.hs
@@ -2,7 +2,7 @@
 -- programs. This module does not provide the actual plumbing to work with
 -- Core and Haskell (it uses HsTools for this), but only the functions that
 -- know about various libraries and know which functions to call.
-module CoreTools where
+module CLasH.Utils.Core.CoreTools where
 
 --Standard modules
 import qualified Maybe
@@ -32,27 +32,30 @@ import qualified CoreFVs
 import qualified Literal
 
 -- Local imports
-import GhcTools
-import HsTools
-import Pretty
+import CLasH.Utils.GhcTools
+import CLasH.Utils.HsTools
+import CLasH.Utils.Pretty
 
 -- | Evaluate a core Type representing type level int from the tfp
 -- 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
 
-    let from_int_t_name = mkRdrName "Types.Data.Num" "fromIntegerT"
+    let from_int_t_name = mkRdrName "Types.Data.Num.Ops" "fromIntegerT"
     let from_int_t = SrcLoc.noLoc $ HsExpr.HsVar from_int_t_name
     let undef = hsTypedUndef $ coreToHsType ty
     let app = SrcLoc.noLoc $ HsExpr.HsApp (from_int_t) (undef)
     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 :: CoreSyn.CoreExpr -> [CoreSyn.CoreExpr]
+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 _ = []