whenelse = case cond of
Just (cond_expr, true_expr) ->
let
- true_wform = AST.Wform [AST.WformElem true_expr Nothing]
+ true_wform = AST.Wform [AST.WformElem true_expr Nothing]
in
[AST.WhenElse true_wform cond_expr]
Nothing -> []
in
AST.CSSASm assign
+mkAltsAssign ::
+ Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+ -> [AST.Expr] -- ^ The conditions
+ -> [AST.Expr] -- ^ The expressions
+ -> AST.ConcSm -- ^ The Alt assigns
+mkAltsAssign dst conds exprs
+ | (length conds) /= ((length exprs) - 1) = error $ "\nVHDLTools.mkAltsAssign: conditions expression mismatch"
+ | otherwise =
+ let
+ whenelses = zipWith mkWhenElse conds exprs
+ false_wform = AST.Wform [AST.WformElem (last exprs) Nothing]
+ dst_name = case dst of
+ Left bndr -> AST.NSimple (varToVHDLId bndr)
+ Right name -> name
+ assign = dst_name AST.:<==: (AST.ConWforms whenelses false_wform Nothing)
+ in
+ AST.CSSASm assign
+ where
+ mkWhenElse :: AST.Expr -> AST.Expr -> AST.WhenElse
+ mkWhenElse cond true_expr =
+ let
+ true_wform = AST.Wform [AST.WformElem true_expr Nothing]
+ in
+ AST.WhenElse true_wform cond
+
mkAssocElems ::
[AST.Expr] -- ^ The argument that are applied to function
-> AST.VHDLName -- ^ The binder in which to store the result
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
- modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, tupshow)
+ let htype = ADTType (nameToString (TyCon.tyConName tycon)) (map (\x -> StdType (OrdType x)) real_arg_tys)
+ modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
return $ Right $ Just (ty_id, Left ty_def)
-- There were errors in element types
(errors, _) -> return $ Left $
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
let ty_def = AST.TDE $ AST.EnumTypeDef elems
let enumShow = mkEnumShow elems ty_id
- modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, enumShow)
+ let htype = EnumType (nameToString (TyCon.tyConName tycon)) (map (nameToString . DataCon.dataConName) dcs)
+ modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
return $ Right $ Just (ty_id, Left ty_def)
xs -> return $ Left $
"VHDLTools.mkTyConHType: Only enum-like constructor datatypes supported: " ++ pprString dcs ++ "\n"
modA tsTypes (Map.insert (StdType $ OrdType vec_ty) (Just (vec_id, (Left vec_def))))
modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
let vecShowFuns = mkVectorShow el_ty_tm vec_id
- mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+ mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (StdType $ OrdType el_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Right $ Just (ty_id, Right ty_def))
-- Empty element type? Empty vector type then. TODO: Does this make sense?