+
+mkHType :: Type.Type -> VHDLSession HType
+mkHType ty = do
+ -- FIXME: Do we really need to do this here again?
+ let builtin_ty = do -- See if this is a tycon and lookup its name
+ (tycon, args) <- Type.splitTyConApp_maybe ty
+ let name = Name.getOccString (TyCon.tyConName tycon)
+ Map.lookup name builtin_types
+ case builtin_ty of
+ Just typ ->
+ return $ BuiltinType $ prettyShow typ
+ Nothing ->
+ case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> do
+ let name = Name.getOccString (TyCon.tyConName tycon)
+ case name of
+ "TFVec" -> do
+ elem_htype <- mkHType (tfvec_elem ty)
+ return $ VecType (tfvec_len ty) elem_htype
+ otherwise -> do
+ mkTyConHType tycon args
+ Nothing -> return $ StdType $ OrdType ty
+
+-- FIXME: Do we really need to do this here again?
+mkTyConHType :: TyCon.TyCon -> [Type.Type] -> VHDLSession HType
+mkTyConHType tycon args =
+ case TyCon.tyConDataCons tycon of
+ -- Not an algebraic type
+ [] -> error $ "\nVHDLTools.mkHType: Only custom algebraic types are supported: " ++ pprString tycon
+ [dc] -> do
+ let arg_tys = DataCon.dataConRepArgTys dc
+ let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
+ elem_htys <- mapM mkHType real_arg_tys
+ return $ ADTType (nameToString (TyCon.tyConName tycon)) elem_htys
+ dcs -> error $ "\nVHDLTools.mkHType: Only single constructor datatypes supported: " ++ pprString tycon
+ where
+ tyvars = TyCon.tyConTyVars tycon
+ subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args)
\ No newline at end of file