X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=fafbaab1d27df759b5ad8d84504350ee0f9070fe;hp=a5176ce0ed8b960346857492843ed3fcb99964eb;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=bcadca676448e38427b910bad5d7063f948a99c8 diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index a5176ce..fafbaab 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -7,6 +7,7 @@ \begin{code} -- We expose the relevant stuff from this module via the Type module {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE DeriveDataTypeable #-} module TypeRep ( TyThing(..), @@ -61,6 +62,9 @@ import Class import PrelNames import Outputable import FastString + +-- libraries +import Data.Data hiding ( TyCon ) \end{code} ---------------------- @@ -155,6 +159,7 @@ data Type -- of a 'FunTy' (unlike the 'PredType' constructors 'ClassP' or 'IParam') -- See Note [PredTy], and Note [Equality predicates] + deriving (Data, Typeable) -- | The key type representing kinds in the compiler. -- Invariant: a kind is always in one of these forms: @@ -196,6 +201,7 @@ data PredType = ClassP Class [Type] -- ^ Class predicate e.g. @Eq a@ | IParam (IPName Name) Type -- ^ Implicit parameter e.g. @?x :: Int@ | EqPred Type Type -- ^ Equality predicate e.g @ty1 ~ ty2@ + deriving (Data, Typeable) -- | A collection of 'PredType's type ThetaType = [PredType] @@ -443,12 +449,23 @@ pprClassPred :: Class -> [Type] -> SDoc pprClassPred clas tys = ppr_type_app TopPrec (getName clas) tys pprTheta :: ThetaType -> SDoc -pprTheta theta = parens (sep (punctuate comma (map pprPred theta))) +-- pprTheta [pred] = pprPred pred -- I'm in two minds about this +pprTheta theta = parens (sep (punctuate comma (map pprPred theta))) pprThetaArrow :: ThetaType -> SDoc -pprThetaArrow theta - | null theta = empty - | otherwise = parens (sep (punctuate comma (map pprPred theta))) <+> ptext (sLit "=>") +pprThetaArrow [] = empty +pprThetaArrow [pred] + | noParenPred pred = pprPred pred <+> darrow +pprThetaArrow preds = parens (sep (punctuate comma (map pprPred preds))) <+> darrow + +noParenPred :: PredType -> Bool +-- A predicate that can appear without parens before a "=>" +-- C a => a -> a +-- a~b => a -> b +-- But (?x::Int) => Int -> Int +noParenPred (ClassP {}) = True +noParenPred (EqPred {}) = True +noParenPred (IParam {}) = False ------------------ instance Outputable Type where @@ -471,7 +488,8 @@ ppr_type :: Prec -> Type -> SDoc ppr_type _ (TyVarTy tv) -- Note [Infix type variables] | isSymOcc (getOccName tv) = parens (ppr tv) | otherwise = ppr tv -ppr_type _ (PredTy pred) = ifPprDebug (ptext (sLit "")) <> (ppr pred) +ppr_type p (PredTy pred) = maybeParen p TyConPrec $ + ifPprDebug (ptext (sLit "")) <> (ppr pred) ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $