-- A single alt case must be a selector. This means thee 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])) =
+mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
+ -- Don't generate VHDL for substate extraction
+ | hasStateType bndr = return ([], [])
+ | otherwise =
case alt of
(CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
case List.elemIndex sel_bndr bndrs of
-- | 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 = mapM argToVHDLExpr
+
+argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession AST.Expr
+argToVHDLExpr (Left expr) = MonadState.lift tsType $ varToVHDLExpr (exprToVar expr)
+argToVHDLExpr (Right expr) = return expr
-- A function to wrap a builder-like function that generates no component
-- instantiations
-- 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...
let label = "comp_ins_" ++ (either show prettyShow) dst
- let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
+ portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
return ([mkComponentInst label entity_id portmaps], [f])
False -> do
-- Not a top level binder, so this must be a local variable reference.
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