-getTypeString ty
- = case (splitAppTy ty) of { (tc, args) ->
- do_tc tc : map do_arg_ty args }
- where
- do_tc (TyConTy tc _) = Left (origName "do_tc" tc)
- do_tc (SynTy _ _ ty) = do_tc ty
- do_tc other = --pprTrace "getTypeString:do_tc:" (pprType PprDebug other) $
- Right (_PK_ (ppShow 1000 (pprType PprForC other)))
-
- do_arg_ty (TyConTy tc _) = Left (origName "do_arg_ty" tc)
- do_arg_ty (TyVarTy tv) = Right (_PK_ (ppShow 80 (ppr PprForC tv)))
- do_arg_ty (SynTy _ _ ty) = do_arg_ty ty
- do_arg_ty other = --pprTrace "getTypeString:do_arg_ty:" (pprType PprDebug other) $
- Right (_PK_ (ppShow 1000 (pprType PprForC other)))
-
- -- PprForC expands type synonyms as it goes;
- -- it also forces consistent naming of tycons
- -- (e.g., can't have both "(,) a b" and "(a,b)":
- -- must be consistent!
-
- --------------------------------------------------
- -- tidy: very ad-hoc
- tidy [] = [] -- done
-
- tidy (' ' : more)
- = case more of
- ' ' : _ -> tidy more
- '-' : '>' : xs -> '-' : '>' : tidy (no_leading_sps xs)
- other -> ' ' : tidy more
-
- tidy (',' : more) = ',' : tidy (no_leading_sps more)
-
- tidy (x : xs) = x : tidy xs -- catch all
-
- no_leading_sps [] = []
- no_leading_sps (' ':xs) = no_leading_sps xs
- no_leading_sps other = other
-
-typeMaybeString :: Maybe Type -> [Either OrigName FAST_STRING]
-typeMaybeString Nothing = [Right SLIT("!")]
-typeMaybeString (Just t) = getTypeString t
-
-specMaybeTysSuffix :: [Maybe Type] -> FAST_STRING
-specMaybeTysSuffix ty_maybes
- = panic "PprType.specMaybeTysSuffix"
-{- LATER:
- = let
- ty_strs = concat (map typeMaybeString ty_maybes)
- dotted_tys = [ _CONS_ '.' str | str <- ty_strs ]
- in
- _CONCAT_ dotted_tys
--}
-\end{code}
-
-Grab a name for the type. This is used to determine the type
-description for profiling.