- otherwise ->
- case htype of
- Right (AggrType _ _) -> do
- labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
- args' <- argsToVHDLExprs argsNostate
- return (zipWith mkassign labels args', [])
- where
- mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
- mkassign label arg =
- let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
- mkUncondAssign (Right sel_name) arg
- _ -> do -- error $ "DIE!"
- args' <- argsToVHDLExprs argsNostate
- return ([mkUncondAssign dst (head args')], [])
- Right _ -> error "\nGenerate.genApplication(DataConWorkId): Can't generate dataconstructor application without an original binder"
+ -- In all other cases, a record type is created.
+ _ -> case htype_either of
+ Right htype@(AggrType _ etype _) -> do
+ let dc_i = datacon_index dsttype dc
+ let labels = getFieldLabels htype dc_i
+ arg_exprs <- argsToVHDLExprs argsNoState
+ let (final_labels, final_exprs) = case getConstructorFieldLabel htype of
+ -- Only a single constructor
+ Nothing ->
+ (labels, arg_exprs)
+ -- Multiple constructors, so assign the
+ -- constructor used to the constructor field as
+ -- well.
+ Just dc_label ->
+ let { dc_index = getConstructorIndex (snd $ Maybe.fromJust etype) (varToString f)
+ ; dc_expr = AST.PrimLit $ show dc_index
+ } in (dc_label:labels, dc_expr:arg_exprs)
+ return (zipWith mkassign final_labels final_exprs, [])
+ where
+ mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
+ mkassign label arg =
+ let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
+ mkUncondAssign (Right sel_name) arg
+ -- Enumeration types have no arguments and are just
+ -- simple assignments
+ Right (EnumType _ _) ->
+ simple_assign
+ -- These builtin types are also enumeration types
+ Right (BuiltinType tyname) | tyname `elem` ["Bit", "Bool"] ->
+ simple_assign
+ Right _ -> error $ "Datacon application does not result in a aggregate type? datacon: " ++ pprString f ++ " Args: " ++ show args
+ Left _ -> error $ "Unrepresentable result type in datacon application? datacon: " ++ pprString f ++ " Args: " ++ show args
+ where
+ -- Simple uncoditional assignment, for (built-in)
+ -- enumeration types
+ simple_assign = do
+ expr <- MonadState.lift tsType $ dataconToVHDLExpr dc
+ return ([mkUncondAssign dst expr], [])
+ --
+ -- Right _ -> do
+ -- let dcs = datacons_for dsttype
+ -- error $ "\nGenerate.genApplication(DataConWorkId): Can't generate dataconstructor application without an original binder" ++ show dcs