-> 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
-- ^ 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
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
-----------------------------------------------------------------------------
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