X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=07cf0e89864022936af27fa5c9f0fd6cb6719ecc;hb=07a6394442d0d83a754af8f0d90f3702bb1821c6;hp=ae763a05409ad5f789cc80af7dd9cc4f1fc507d8;hpb=88229173076f82beda4218e3e4c529ebfd04bee6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index ae763a0..07cf0e8 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/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 @@ -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