X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=da8be8a7afda04735e7ba3e07abae4c5252ae602;hb=d2fb40118bbcc404ea242d57dd6be196e70d171d;hp=1e6f28ffca0e33b7fb4f562889483aef0d4847a6;hpb=4f5949f4e4451111010d1a4f67206f07b41f77a5;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 1e6f28f..da8be8a 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -207,7 +207,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do let valargs = get_val_args (Var.varType f) args genApplication (Left bndr) f (map Left valargs) --- A single alt case must be a selector. This means thee scrutinee is a simple +-- A single alt case must be a selector. This means the scrutinee is a simple -- variable, the alternative is a dataalt with a single non-wild binder that -- is also returned. mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) @@ -234,7 +234,8 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) -- first is the default case, if there is any. mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut - let cond_expr = scrut' AST.:=: (altconToVHDLExpr con) + altcon <- MonadState.lift tsType $ altconToVHDLExpr con + let cond_expr = scrut' AST.:=: altcon true_expr <- MonadState.lift tsType $ varToVHDLExpr true false_expr <- MonadState.lift tsType $ varToVHDLExpr false return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], []) @@ -292,14 +293,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.