X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=827315cfd70ee9f7e6aa2ca9c5c1671ce200477b;hb=e9fdb64bf7174b8608d9b1c7004fdcbe3dd23a9c;hp=0b2cf04d6b2e171b459186607aa3530a203c7060;hpb=374a42ba3cf333ae53fa1d992620d25286641ae2;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 0b2cf04..827315c 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -199,11 +199,24 @@ mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let exp -- | A function to wrap a builder-like function that expects its arguments to -- be expressions. genExprArgs wrap dst func args = do - args' <- eitherCoreOrExprArgs args + args' <- argsToVHDLExprs args wrap dst func args' -eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr] -eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift tsType) . varToVHDLExpr . exprToVar) return) args +-- | Turn the all lefts into VHDL Expressions. +argsToVHDLExprs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr] +argsToVHDLExprs = catMaybesM . (mapM argToVHDLExpr) + +argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr) +argToVHDLExpr (Left expr) = MonadState.lift tsType $ do + let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!" + ty_maybe <- vhdl_ty errmsg expr + case ty_maybe of + Just _ -> do + vhdl_expr <- varToVHDLExpr $ exprToVar expr + return $ Just vhdl_expr + Nothing -> return $ Nothing + +argToVHDLExpr (Right expr) = return $ Just expr -- A function to wrap a builder-like function that generates no component -- instantiations @@ -773,7 +786,7 @@ genApplication dst f args = do -- Local binder that references a top level binding. Generate a -- component instantiation. signature <- getEntity f - args' <- eitherCoreOrExprArgs args + args' <- argsToVHDLExprs args let entity_id = ent_id signature -- TODO: Using show here isn't really pretty, but we'll need some -- unique-ish value... @@ -794,7 +807,7 @@ genApplication dst f args = do Left bndr -> do -- We have the bndr, so we can get at the type labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr) - args' <- eitherCoreOrExprArgs args + args' <- argsToVHDLExprs args return $ (zipWith mkassign labels $ args', []) where mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm