+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Pretty-printing TyThings
--
-----------------------------------------------------------------------------
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module PprTyThing (
PrintExplicitForalls,
pprTyThing,
import qualified GHC
import GHC ( TyThing(..) )
-import TyCon ( tyConFamInst_maybe )
+import TyCon ( tyConFamInst_maybe, isAlgTyCon, tyConStupidTheta )
import Type ( TyThing(..), tidyTopType, pprTypeApp )
import TcType ( tcMultiSplitSigmaTy, mkPhiTy )
import SrcLoc ( SrcSpan )
| Just (fam_tc, tys) <- tyConFamInst_maybe tyCon
= ptext keyword <+> ptext SLIT("instance") <+> pprTypeApp tyCon (ppr_bndr tyCon) tys
| otherwise
- = ptext keyword <+> opt_family <+> ppr_bndr tyCon <+> hsep (map ppr vars)
+ = ptext keyword <+> opt_family <+> opt_stupid <+> ppr_bndr tyCon <+> hsep (map ppr vars)
where
vars | GHC.isPrimTyCon tyCon ||
GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars
| GHC.isOpenTyCon tyCon = ptext SLIT("family")
| otherwise = empty
+ opt_stupid -- The "stupid theta" part of the declaration
+ | isAlgTyCon tyCon = GHC.pprThetaArrow (tyConStupidTheta tyCon)
+ | otherwise = empty -- Returns 'empty' if null theta
+
pprDataConSig pefas dataCon =
ppr_bndr dataCon <+> dcolon <+> pprTypeForUser pefas (GHC.dataConType dataCon)
-- printing out the dataCon as a type signature, in GADT style
pp_tau = foldr add (ppr res_ty) tys_w_strs
- add (str,ty) pp_ty = pprBangTy str ty <+> arrow <+> pp_ty
+ add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
pprParendBangTy (strict,ty)
| GHC.isMarkedStrict strict = char '!' <> GHC.pprParendType ty