Add support for fromIntegerT

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index bf2ca27be3b6717b5262a8f9c1770397924be605..acc2fa630c416a32f6a99a15c0df18281b6526da 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/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
@@ -228,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

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 1e6f28ffca0e33b7fb4f562889483aef0d4847a6..b058e06c4b2ed3cc5b844fce8efbf293996a92c4 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -292,14 +292,16 @@ genVarArgs wrap dst func args = wrap dst func args'
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals
 genLitArgs ::
-  (dst -> func -> [Literal.Literal] -> res)
-  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genLitArgs wrap dst func args = wrap dst func args'
-  where
-    args' = map exprToLit litargs
-    -- FIXME: Check if we were passed an CoreSyn.App
-    litargs = concat (map getLiterals exprargs)
-    (exprargs, []) = Either.partitionEithers args
+  (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
+genLitArgs wrap dst func args = do
+  hscenv <- MonadState.lift tsType $ getA tsHscEnv
+  let (exprargs, []) = Either.partitionEithers args
+  -- FIXME: Check if we were passed an CoreSyn.App
+  let litargs = concat (map (getLiterals hscenv) exprargs)
+  let args' = map exprToLit litargs
+  concsms <- wrap dst func args'
+  return concsms    
 
 -- | A function to wrap a builder-like function that produces an expression
 -- and expects it to be assigned to the destination.