-- Function to generate VHDL for applications
-----------------------------------------------------------------------------
genApplication ::
-- Function to generate VHDL for applications
-----------------------------------------------------------------------------
genApplication ::
-> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
-- ^ The corresponding VHDL concurrent statements and entities
-- instantiated.
-> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
-- ^ The corresponding VHDL concurrent statements and entities
-- instantiated.
- htype_either <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
- let argsNoState = filter (\x -> not (either hasStateType (\x -> False) x)) args
- let dcs = datacons_for bndr
+ htype_either <- MonadState.lift tsType $ mkHTypeEither dsttype
+ let argsNoState = filter (\x -> not (either hasStateType (\x -> False) x)) (map fst args)
+ let dcs = datacons_for dsttype
case (dcs, argsNoState) of
-- This is a type with a single datacon and a single
-- argument, so no record is created (the type of the
case (dcs, argsNoState) of
-- This is a type with a single datacon and a single
-- argument, so no record is created (the type of the
-- In all other cases, a record type is created.
_ -> case htype_either of
Right htype@(AggrType _ _ _) -> do
-- In all other cases, a record type is created.
_ -> case htype_either of
Right htype@(AggrType _ _ _) -> do
let labels = getFieldLabels htype dc_i
arg_exprs <- argsToVHDLExprs argsNoState
let (final_labels, final_exprs) = case getConstructorFieldLabel htype of
let labels = getFieldLabels htype dc_i
arg_exprs <- argsToVHDLExprs argsNoState
let (final_labels, final_exprs) = case getConstructorFieldLabel htype of
simple_assign = do
expr <- MonadState.lift tsType $ dataconToVHDLExpr dc
return ([mkUncondAssign dst expr], [])
simple_assign = do
expr <- MonadState.lift tsType $ dataconToVHDLExpr dc
return ([mkUncondAssign dst expr], [])
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
let entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...