Commit 33140f41 authored by Phil de Joux's avatar Phil de Joux Committed by Ben Gamari

Show explicit quantifiers in conflicting definitions error

This fixes #12441, where definitions in a Haskell module and its boot
file which differed only in their quantifiers produced a confusing error
message. Here we teach GHC to always show quantifiers for these errors.

Reviewers: goldfire, simonmar, erikd, austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: snowleopard, simonpj, mpickering, thomie

Differential Revision: https://phabricator.haskell.org/D2734

GHC Trac Issues: #12441
parent d49b2bb2
......@@ -22,6 +22,7 @@ import GHCi.RemoteTypes
import GhcMonad
import HscTypes
import Id
import IfaceSyn ( showToHeader )
import IfaceEnv( newInteractiveBinder )
import Name
import Var hiding ( varName )
......@@ -214,7 +215,7 @@ pprTypeAndContents :: GhcMonad m => Id -> m SDoc
pprTypeAndContents id = do
dflags <- GHC.getSessionDynFlags
let pcontents = gopt Opt_PrintBindContents dflags
pprdId = (PprTyThing.pprTyThing . AnId) id
pprdId = (pprTyThing showToHeader . AnId) id
if pcontents
then do
let depthBound = 100
......
......@@ -35,7 +35,7 @@ module IfaceSyn (
-- Pretty printing
pprIfaceExpr,
pprIfaceDecl,
ShowSub(..), ShowHowMuch(..)
AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader
) where
#include "HsVersions.h"
......@@ -572,7 +572,7 @@ instance HasOccName IfaceDecl where
occName = getOccName
instance Outputable IfaceDecl where
ppr = pprIfaceDecl showAll
ppr = pprIfaceDecl showToIface
{-
Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -583,28 +583,52 @@ filtering of method signatures. Instead we just check if anything at all is
filtered and hide it in that case.
-}
-- TODO: Kill this and Note [Printing IfaceDecl binders]
data ShowSub
= ShowSub
{ ss_ppr_bndr :: OccName -> SDoc -- Pretty-printer for binders in IfaceDecl
-- See Note [Printing IfaceDecl binders]
, ss_how_much :: ShowHowMuch }
{ ss_how_much :: ShowHowMuch
, ss_forall :: ShowForAllFlag }
-- See Note [Printing IfaceDecl binders]
-- The alternative pretty printer referred to in the note.
newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))
data ShowHowMuch
= ShowHeader -- Header information only, not rhs
| ShowSome [OccName] -- [] <=> Print all sub-components
-- (n:ns) <=> print sub-component 'n' with ShowSub=ns
-- elide other sub-components to "..."
-- May 14: the list is max 1 element long at the moment
| ShowIface -- Everything including GHC-internal information (used in --show-iface)
= ShowHeader AltPpr -- ^Header information only, not rhs
| ShowSome [OccName] AltPpr
-- ^ Show only some sub-components. Specifically,
--
-- [@[]@] Print all sub-components.
-- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;
-- elide other sub-components to @...@
-- May 14: the list is max 1 element long at the moment
| ShowIface
-- ^Everything including GHC-internal information (used in --show-iface)
{-
Note [Printing IfaceDecl binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The binders in an IfaceDecl are just OccNames, so we don't know what module they
come from. But when we pretty-print a TyThing by converting to an IfaceDecl
(see PprTyThing), the TyThing may come from some other module so we really need
the module qualifier. We solve this by passing in a pretty-printer for the
binders.
When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
-}
instance Outputable ShowHowMuch where
ppr ShowHeader = text "ShowHeader"
ppr ShowIface = text "ShowIface"
ppr (ShowSome occs) = text "ShowSome" <+> ppr occs
ppr (ShowHeader _) = text "ShowHeader"
ppr ShowIface = text "ShowIface"
ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs
showToHeader :: ShowSub
showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing
, ss_forall = ShowForAllWhen }
showAll :: ShowSub
showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }
showToIface :: ShowSub
showToIface = ShowSub { ss_how_much = ShowIface
, ss_forall = ShowForAllWhen }
ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
......@@ -612,32 +636,19 @@ ppShowIface _ _ = Outputable.empty
-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
ppShowAllSubs _ _ = Outputable.empty
ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
ppShowAllSubs _ _ = Outputable.empty
ppShowRhs :: ShowSub -> SDoc -> SDoc
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = Outputable.empty
ppShowRhs _ doc = doc
ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty
ppShowRhs _ doc = doc
showSub :: HasOccName n => ShowSub -> n -> Bool
showSub (ShowSub { ss_how_much = ShowHeader }) _ = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
showSub (ShowSub { ss_how_much = _ }) _ = True
{-
Note [Printing IfaceDecl binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The binders in an IfaceDecl are just OccNames, so we don't know what module they
come from. But when we pretty-print a TyThing by converting to an IfaceDecl
(see PprTyThing), the TyThing may come from some other module so we really need
the module qualifier. We solve this by passing in a pretty-printer for the
binders.
When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
-}
ppr_trim :: [Maybe SDoc] -> [SDoc]
-- Collapse a group of Nothings to a single "..."
ppr_trim xs
......@@ -683,7 +694,9 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
pp_roles
| is_data_instance = empty
| otherwise = pprRoles (== Representational)
(pprPrefixIfDeclBndr ss (occName tycon))
(pprPrefixIfDeclBndr
(ss_how_much ss)
(occName tycon))
binders roles
-- Don't display roles for data family instances (yet)
-- See discussion on Trac #8672.
......@@ -714,7 +727,11 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
, ifRoles = roles
, ifFDs = fds, ifMinDef = minDef
, ifBinders = binders })
= vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss (occName clas)) binders roles
= vcat [ pprRoles
(== Nominal)
(pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
binders
roles
, text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
<+> pprFundeps fds <+> pp_where
, nest 2 (vcat [ vcat asocs, vcat dsigs
......@@ -788,7 +805,11 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon
pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
= hang (text "where")
2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss (occName tycon))) brs)
2 (vcat (map (pprAxBranch
(pprPrefixIfDeclBndr
(ss_how_much ss)
(occName tycon))
) brs)
$$ ppShowIface ss (text "axiom" <+> ppr ax))
pp_branches _ = Outputable.empty
......@@ -814,8 +835,8 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
ifIdDetails = details, ifIdInfo = info })
= vcat [ hang (pprPrefixIfDeclBndr ss (occName var) <+> dcolon)
2 (pprIfaceSigmaType ty)
= vcat [ hang (pprPrefixIfDeclBndr (ss_how_much ss) (occName var) <+> dcolon)
2 (pprIfaceSigmaType (ss_forall ss) ty)
, ppShowIface ss (ppr details)
, ppShowIface ss (ppr info) ]
......@@ -839,14 +860,22 @@ pprRoles suppress_if tyCon bndrs roles
in ppUnless (all suppress_if roles || null froles) $
text "type role" <+> tyCon <+> hsep (map ppr froles)
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
= pprInfixVar (isSymOcc name) (ppr_bndr name)
pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
pprInfixIfDeclBndr _ name
= pprInfixVar (isSymOcc name) (ppr name)
pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr))) name
= parenSymOcc name (ppr_bndr name)
pprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
= parenSymOcc name (ppr_bndr name)
pprPrefixIfDeclBndr _ name
= parenSymOcc name (ppr name)
instance Outputable IfaceClassOp where
ppr = pprIfaceClassOp showAll
ppr = pprIfaceClassOp showToIface
pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp ss (IfaceClassOp n ty dm)
......@@ -856,10 +885,13 @@ pprIfaceClassOp ss (IfaceClassOp n ty dm)
= text "default" <+> pp_sig n dm_ty
| otherwise
= empty
pp_sig n ty = pprPrefixIfDeclBndr ss (occName n) <+> dcolon <+> pprIfaceSigmaType ty
pp_sig n ty
= pprPrefixIfDeclBndr (ss_how_much ss) (occName n)
<+> dcolon
<+> pprIfaceSigmaType ShowForAllWhen ty
instance Outputable IfaceAT where
ppr = pprIfaceAT showAll
ppr = pprIfaceAT showToIface
pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
pprIfaceAT ss (IfaceAT d mb_def)
......@@ -887,7 +919,7 @@ pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
pprIfaceDeclHead context ss tc_occ bndrs m_res_kind
= sdocWithDynFlags $ \ dflags ->
sep [ pprIfaceContextArr context
, pprPrefixIfDeclBndr ss (occName tc_occ)
, pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)
<+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)
, maybe empty (\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]
......@@ -911,12 +943,16 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
| gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty
| not (null fields) = pp_prefix_con <+> pp_field_args
| is_infix
, [ty1, ty2] <- pp_args = sep [ty1, pprInfixIfDeclBndr ss (occName name), ty2]
, [ty1, ty2] <- pp_args = sep [ ty1
, pprInfixIfDeclBndr how_much (occName name)
, ty2]
| otherwise = pp_prefix_con <+> sep pp_args
where
how_much = ss_how_much ss
tys_w_strs :: [(IfaceBang, IfaceType)]
tys_w_strs = zip stricts arg_tys
pp_prefix_con = pprPrefixIfDeclBndr ss (occName name)
pp_prefix_con = pprPrefixIfDeclBndr how_much (occName name)
(univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
ppr_ty = pprIfaceForAllPart (map tv_to_forall_bndr univ_tvs ++ ex_tvs)
......@@ -949,8 +985,10 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
maybe_show_label :: IfaceTopBndr -> (IfaceBang, IfaceType) -> Maybe SDoc
maybe_show_label sel bty
| showSub ss sel = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
| otherwise = Nothing
| showSub ss sel =
Just (pprPrefixIfDeclBndr how_much lbl <+> dcolon <+> pprBangTy bty)
| otherwise =
Nothing
where
-- IfaceConDecl contains the name of the selector function, so
-- we have to look up the field label (in case
......@@ -971,7 +1009,7 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
con_univ_tvs = filterOut done_univ_tv (map ifTyConBinderTyVar tc_binders)
ppr_tc_app gadt_subst dflags
= pprPrefixIfDeclBndr ss (occName tycon)
= pprPrefixIfDeclBndr how_much (occName tycon)
<+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
| (tv,_kind)
<- map ifTyConBinderTyVar $
......
......@@ -18,7 +18,7 @@ module IfaceType (
IfaceTyLit(..), IfaceTcArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllBndr, ArgFlag(..),
IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
ifTyConBinderTyVar, ifTyConBinderName,
......@@ -719,7 +719,7 @@ ppr_ty ctxt_prec (IfaceCoercionTy co)
(text "<>")
ppr_ty ctxt_prec ty
= maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)
= maybeParen ctxt_prec FunPrec (pprIfaceSigmaType ShowForAllMust ty)
{-
Note [Defaulting RuntimeRep variables]
......@@ -826,27 +826,21 @@ ppr_tc_args ctx_prec args
ITC_Vis t ts -> pprTys t ts
ITC_Invis t ts -> pprTys t ts
-------------------
ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
ppr_iface_sigma_type show_foralls_unconditionally ty
= ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
where
(tvs, theta, tau) = splitIfaceSigmaTy ty
-------------------
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
pprIfaceForAllPart tvs ctxt sdoc
= ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart tvs sdoc =
sep [ pprIfaceForAllCo tvs, sdoc ]
pprIfaceForAllCoPart tvs sdoc
= sep [ pprIfaceForAllCo tvs, sdoc ]
ppr_iface_forall_part :: Bool
ppr_iface_forall_part :: ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
= sep [ if show_foralls_unconditionally
then pprIfaceForAll tvs
else pprUserIfaceForAll tvs
ppr_iface_forall_part show_forall tvs ctxt sdoc
= sep [ case show_forall of
ShowForAllMust -> pprIfaceForAll tvs
ShowForAllWhen -> pprUserIfaceForAll tvs
, pprIfaceContextArr ctxt
, sdoc]
......@@ -893,8 +887,18 @@ pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (tv, kind_co)
= parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
pprIfaceSigmaType :: IfaceType -> SDoc
pprIfaceSigmaType ty = ppr_iface_sigma_type False ty
-- | Show forall flag
--
-- Unconditionally show the forall quantifier with ('ShowForAllMust')
-- or when ('ShowForAllWhen') the names used are free in the binder
-- or when compiling with -fprint-explicit-foralls.
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType show_forall ty
= ppr_iface_forall_part show_forall tvs theta (ppr tau)
where
(tvs, theta, tau) = splitIfaceSigmaTy ty
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll tvs
......
......@@ -11,6 +11,7 @@ type IfLclName = FastString
type IfaceKind = IfaceType
type IfacePredType = IfaceType
data ShowForAllFlag
data IfaceType
data IfaceTyCon
data IfaceTyLit
......@@ -23,7 +24,7 @@ type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
instance Outputable IfaceType
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceSigmaType :: IfaceType -> SDoc
pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
......
......@@ -1890,7 +1890,7 @@ isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
-- | tyThingParent_maybe x returns (Just p)
-- when pprTyThingInContext sould print a declaration for p
-- when pprTyThingInContext should print a declaration for p
-- (albeit with some "..." in it) when asked to show x
-- It returns the *immediate* parent. So a datacon returns its tycon
-- but the tycon could be the associated type of a class, so it in turn
......
......@@ -20,12 +20,13 @@ module PprTyThing (
#include "HsVersions.h"
import Type ( TyThing(..) )
import IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
, showToHeader, pprIfaceDecl )
import CoAxiom ( coAxiomTyCon )
import HscTypes( tyThingParent_maybe )
import MkIface ( tyThingToIfaceDecl )
import Type ( tidyOpenType )
import IfaceSyn ( pprIfaceDecl, ShowSub(..), ShowHowMuch(..) )
import FamInstEnv( FamInst( .. ), FamFlavor(..) )
import FamInstEnv( FamInst(..), FamFlavor(..) )
import Type( Type, pprTypeApp, pprSigmaType )
import Name
import VarEnv( emptyTidyEnv )
......@@ -94,56 +95,62 @@ pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom
-- | Pretty-prints a 'TyThing' with its defining location.
pprTyThingLoc :: TyThing -> SDoc
pprTyThingLoc tyThing
= showWithLoc (pprDefinedAt (getName tyThing)) (pprTyThing tyThing)
-- | Pretty-prints a 'TyThing'.
pprTyThing :: TyThing -> SDoc
pprTyThing = ppr_ty_thing False []
= showWithLoc (pprDefinedAt (getName tyThing))
(pprTyThing showToHeader tyThing)
-- | Pretty-prints the 'TyThing' header. For functions and data constructors
-- the function is equivalent to 'pprTyThing' but for type constructors
-- and classes it prints only the header part of the declaration.
pprTyThingHdr :: TyThing -> SDoc
pprTyThingHdr = ppr_ty_thing True []
pprTyThingHdr = pprTyThing showToHeader
-- | Pretty-prints a 'TyThing' in context: that is, if the entity
-- is a data constructor, record selector, or class method, then
-- the entity's parent declaration is pretty-printed with irrelevant
-- parts omitted.
pprTyThingInContext :: TyThing -> SDoc
pprTyThingInContext thing
pprTyThingInContext :: ShowSub -> TyThing -> SDoc
pprTyThingInContext show_sub thing
= go [] thing
where
go ss thing = case tyThingParent_maybe thing of
Just parent -> go (getOccName thing : ss) parent
Nothing -> ppr_ty_thing False ss thing
go ss thing
= case tyThingParent_maybe thing of
Just parent ->
go (getOccName thing : ss) parent
Nothing ->
pprTyThing
(show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) })
thing
-- | Like 'pprTyThingInContext', but adds the defining location.
pprTyThingInContextLoc :: TyThing -> SDoc
pprTyThingInContextLoc tyThing
= showWithLoc (pprDefinedAt (getName tyThing))
(pprTyThingInContext tyThing)
(pprTyThingInContext showToHeader tyThing)
------------------------
ppr_ty_thing :: Bool -> [OccName] -> TyThing -> SDoc
-- | Pretty-prints a 'TyThing'.
pprTyThing :: ShowSub -> TyThing -> SDoc
-- We pretty-print 'TyThing' via 'IfaceDecl'
-- See Note [Pretty-printing TyThings]
ppr_ty_thing hdr_only path ty_thing
= pprIfaceDecl ss (tyThingToIfaceDecl ty_thing)
pprTyThing ss ty_thing
= pprIfaceDecl ss' (tyThingToIfaceDecl ty_thing)
where
ss = ShowSub { ss_how_much = how_much, ss_ppr_bndr = ppr_bndr }
how_much | hdr_only = ShowHeader
| otherwise = ShowSome path
name = getName ty_thing
ppr_bndr :: OccName -> SDoc
ppr_bndr | isBuiltInSyntax name
= ppr
| otherwise
= case nameModule_maybe name of
Just mod -> \ occ -> getPprStyle $ \sty ->
pprModulePrefix sty mod occ <> ppr occ
Nothing -> WARN( True, ppr name ) ppr
-- Nothing is unexpected here; TyThings have External names
ss' = case ss_how_much ss of
ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' }
ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' }
_ -> ss
ppr' = AltPpr $ ppr_bndr $ getName ty_thing
ppr_bndr :: Name -> Maybe (OccName -> SDoc)
ppr_bndr name
| isBuiltInSyntax name
= Nothing
| otherwise
= case nameModule_maybe name of
Just mod -> Just $ \occ -> getPprStyle $ \sty ->
pprModulePrefix sty mod occ <> ppr occ
Nothing -> WARN( True, ppr name ) Nothing
-- Nothing is unexpected here; TyThings have External names
pprTypeForUser :: Type -> SDoc
-- The type is tidied
......
......@@ -59,6 +59,8 @@ import Plugins ( tcPlugin )
import DynFlags
import StaticFlags
import HsSyn
import IfaceSyn ( ShowSub(..), showToHeader )
import IfaceType( ShowForAllFlag(..) )
import PrelNames
import RdrName
import TcHsSyn
......@@ -67,7 +69,7 @@ import TcRnMonad
import TcRnExports
import TcEvidence
import qualified BooleanFormula as BF
import PprTyThing( pprTyThing )
import PprTyThing( pprTyThingInContext )
import MkIface( tyThingToIfaceDecl )
import Coercion( pprCoAxiom )
import CoreFVs( orphNamesOfFamInst )
......@@ -1177,17 +1179,33 @@ badReexportedBootThing is_boot name name'
bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> SDoc
bootMisMatch is_boot extra_info real_thing boot_thing
= vcat [ppr real_thing <+>
text "has conflicting definitions in the module",
text "and its" <+>
(if is_boot then text "hs-boot file"
else text "hsig file"),
text "Main module:" <+> PprTyThing.pprTyThing real_thing,
(if is_boot
then text "Boot file: "
else text "Hsig file: ")
<+> PprTyThing.pprTyThing boot_thing,
extra_info]
= pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc
where
to_doc
= pprTyThingInContext $ showToHeader { ss_forall =
if is_boot
then ShowForAllMust
else ShowForAllWhen }
real_doc = to_doc real_thing
boot_doc = to_doc boot_thing
pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc
pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc
= vcat
[ ppr real_thing <+>
text "has conflicting definitions in the module",
text "and its" <+>
(if is_boot
then text "hs-boot file"
else text "hsig file"),
text "Main module:" <+> real_doc,
(if is_boot
then text "Boot file: "
else text "Hsig file: ")
<+> boot_doc,
extra_info
]
instMisMatch :: Bool -> ClsInst -> SDoc
instMisMatch is_boot inst
......@@ -2492,7 +2510,7 @@ ppr_tydecls tycons
= vcat [ ppr (tyThingToIfaceDecl (ATyCon tc))
| tc <- sortBy (comparing getOccName) tycons ]
-- The Outputable instance for IfaceDecl uses
-- showAll, which is what we want here, whereas
-- showToIface, which is what we want here, whereas
-- pprTyThing uses ShowSome.
{-
......@@ -2533,4 +2551,3 @@ loadTcPlugins hsc_env =
where
load_plugin (_, plug, opts) = tcPlugin plug opts
#endif
......@@ -2475,7 +2475,7 @@ instance Outputable TyLit where
------------------
pprSigmaType :: Type -> SDoc
pprSigmaType = pprIfaceSigmaType . tidyToIfaceType
pprSigmaType = (pprIfaceSigmaType ShowForAllWhen) . tidyToIfaceType
pprForAll :: [TyVarBinder] -> SDoc
pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
......
......@@ -56,6 +56,7 @@ import Module
import Name
import Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
listVisibleModuleNames, pprFlag )
import IfaceSyn ( showToHeader )
import PprTyThing
import PrelNames
import RdrName ( RdrName, getGRE_NameQualifier_maybes, getRdrName )
......@@ -2135,8 +2136,8 @@ browseModule bang modl exports_only = do
let things | bang = catMaybes mb_things
| otherwise = filtered_things
pretty | bang = pprTyThing
| otherwise = pprTyThingInContext
pretty | bang = pprTyThing showToHeader
| otherwise = pprTyThingInContext showToHeader
labels [] = text "-- not currently imported"
labels l = text $ intercalate "\n" $ map qualifier l
......@@ -2830,7 +2831,7 @@ showBindings = do
pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
pprTT (thing, fixity, _cls_insts, _fam_insts)
= pprTyThing thing
= pprTyThing showToHeader thing
$$ show_fixity
where
show_fixity
......@@ -2839,7 +2840,7 @@ showBindings = do
printTyThing :: TyThing -> GHCi ()
printTyThing tyth = printForUser (pprTyThing tyth)
printTyThing tyth = printForUser (pprTyThing showToHeader tyth)
showBkptTable :: GHCi ()
showBkptTable = do
......
......@@ -6,4 +6,3 @@ import qualified Data.ByteString.Char8 as S8
main :: IO ()
main = (S8.concat (map S.singleton (S.unpack (S8.pack "<foo>"))) == S8.empty) `seq` return ()
......@@ -4,21 +4,15 @@
T.length :: T.Integer
class N a
class S a
class C a b where
c1 :: N b => a -> b
c2 :: (N b, S b) => a -> b
c3 :: a1 -> b
c4 :: a1 -> b
{-# MINIMAL c1, c2, c3, c4 #-}
class C a b
...