Add genCoreArgs wrapper to VHDL.Generate.

[matthijs/master-project/cλash.git] / cλash / CLasH / VHDL / Generate.hs

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 46f20679e89e10d8a5836a864ad06fc28db8176c..07cf0e89864022936af27fa5c9f0fd6cb6719ecc 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -41,7 +41,7 @@ getEntity ::
   -> TranslatorSession Entity -- ^ The resulting entity
 
 getEntity fname = makeCached fname tsEntities $ do
-      expr <- Normalize.getNormalized fname
+      expr <- Normalize.getNormalized False fname
       -- Split the normalized expression
       let (args, binds, res) = Normalize.splitNormalized expr
       -- Generate ports for all non-empty types
@@ -109,7 +109,7 @@ getArchitecture ::
   -- ^ The architecture for this function
 
 getArchitecture fname = makeCached fname tsArchitectures $ do
-  expr <- Normalize.getNormalized fname
+  expr <- Normalize.getNormalized False fname
   -- Split the normalized expression
   let (args, binds, res) = Normalize.splitNormalized expr
   
@@ -299,7 +299,7 @@ mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do --error
   exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) (alts ++ [alt])
   return ([mkAltsAssign (Left bndr) cond_exprs exprs], [])
 
-mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
+mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement does not have a simple variable as scrutinee"
 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
 
 -----------------------------------------------------------------------------
@@ -342,13 +342,22 @@ genNoInsts wrap dst func args = do
 genVarArgs ::
   (dst -> func -> [Var.Var] -> res)
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genVarArgs wrap dst func args = wrap dst func args'
+genVarArgs wrap = genCoreArgs $ \dst func args -> let
+    args' = map exprToVar args
+  in
+    wrap dst func args'
+
+-- | A function to wrap a builder-like function that expects its arguments to
+-- be core expressions.
+genCoreArgs ::
+  (dst -> func -> [CoreSyn.CoreExpr] -> res)
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
+genCoreArgs wrap dst func args = wrap dst func args'
   where
-    args' = map exprToVar args''
     -- Check (rather crudely) that all arguments are CoreExprs
-    args'' = case Either.partitionEithers args of 
+    args' = case Either.partitionEithers args of 
       (exprargs, []) -> exprargs
-      (exprsargs, rest) -> error $ "\nGenerate.genVarArgs: expect varargs but found ast exprs:" ++ (show rest)
+      (exprsargs, rest) -> error $ "\nGenerate.genCoreArgs: expect core expression arguments but found ast exprs:" ++ (show rest)
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals