Yes:-( I'll unbreak them later today. On Mar 14, 2014 4:16 AM, "Johan Tibell" <[email protected]> wrote:
> Could these changes be related to the validate failures I just posted > about on the mailing list? > > > On Thu, Mar 13, 2014 at 2:21 PM, <[email protected]> wrote: > >> Repository : ssh://[email protected]/ghc >> >> On branch : master >> Link : >> http://ghc.haskell.org/trac/ghc/changeset/065c35a9d6d48060c8fac8d755833349ce58b35b/ghc >> >> >--------------------------------------------------------------- >> >> commit 065c35a9d6d48060c8fac8d755833349ce58b35b >> Author: Dr. ERDI Gergo <[email protected]> >> Date: Thu Mar 13 21:18:39 2014 +0800 >> >> Pretty-print the following TyThings via their IfaceDecl counterpart: >> * AnId >> * ACoAxiom >> * AConLike >> >> >> >--------------------------------------------------------------- >> >> 065c35a9d6d48060c8fac8d755833349ce58b35b >> compiler/iface/IfaceSyn.lhs | 2 +- >> compiler/iface/MkIface.lhs | 10 +++++++- >> compiler/main/PprTyThing.hs | 59 >> ++++++++++--------------------------------- >> 3 files changed, 23 insertions(+), 48 deletions(-) >> >> diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs >> index 8ca8582..7484b37 100644 >> --- a/compiler/iface/IfaceSyn.lhs >> +++ b/compiler/iface/IfaceSyn.lhs >> @@ -1100,7 +1100,7 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName >> = clas, ifTyVars = tyvars, >> sep (map ppr sigs)]) >> >> pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = >> branches }) >> - = hang (ptext (sLit "axiom") <+> ppr name <> colon) >> + = hang (ptext (sLit "axiom") <+> ppr name <> dcolon) >> 2 (vcat $ map (pprAxBranch $ Just tycon) branches) >> >> pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap, >> diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs >> index 0af9af6..51df08c 100644 >> --- a/compiler/iface/MkIface.lhs >> +++ b/compiler/iface/MkIface.lhs >> @@ -1461,7 +1461,7 @@ tyThingToIfaceDecl (AnId id) = idToIfaceDecl id >> tyThingToIfaceDecl (ATyCon tycon) = tyConToIfaceDecl emptyTidyEnv tycon >> tyThingToIfaceDecl (ACoAxiom ax) = coAxiomToIfaceDecl ax >> tyThingToIfaceDecl (AConLike cl) = case cl of >> - RealDataCon dc -> pprPanic "toIfaceDecl" (ppr dc) -- Should be >> trimmed out earlier >> + RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only >> PatSynCon ps -> patSynToIfaceDecl ps >> >> -------------------------- >> @@ -1477,6 +1477,14 @@ idToIfaceDecl id >> ifIdInfo = toIfaceIdInfo (idInfo id) } >> >> -------------------------- >> +dataConToIfaceDecl :: DataCon -> IfaceDecl >> +dataConToIfaceDecl dataCon >> + = IfaceId { ifName = getOccName dataCon, >> + ifType = toIfaceType (dataConUserType dataCon), >> + ifIdDetails = IfVanillaId, >> + ifIdInfo = NoInfo } >> + >> +-------------------------- >> patSynToIfaceDecl :: PatSyn -> IfaceDecl >> patSynToIfaceDecl ps >> = IfacePatSyn { ifName = getOccName . getName $ ps >> diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs >> index 27e7390..fb92b5a 100644 >> --- a/compiler/main/PprTyThing.hs >> +++ b/compiler/main/PprTyThing.hs >> @@ -23,20 +23,18 @@ module PprTyThing ( >> ) where >> >> import TypeRep ( TyThing(..) ) >> -import ConLike >> import DataCon >> -import PatSyn >> import Id >> import TyCon >> import Class >> -import Coercion( pprCoAxiom, pprCoAxBranch ) >> +import Coercion( pprCoAxBranch ) >> import CoAxiom( CoAxiom(..), brListMap ) >> import HscTypes( tyThingParent_maybe ) >> -import HsBinds( pprPatSynSig ) >> import Type( tidyTopType, tidyOpenType, splitForAllTys, funResultTy ) >> import Kind( synTyConResKind ) >> import TypeRep( pprTvBndrs, pprForAll, suppressKinds ) >> import TysPrim( alphaTyVars ) >> +import MkIface ( tyThingToIfaceDecl ) >> import TcType >> import Name >> import VarEnv( emptyTidyEnv ) >> @@ -44,7 +42,6 @@ import StaticFlags( opt_PprStyle_Debug ) >> import DynFlags >> import Outputable >> import FastString >> -import Data.Maybe >> >> -- >> ----------------------------------------------------------------------------- >> -- Pretty-printing entities that we get from the GHC API >> @@ -76,7 +73,7 @@ pprTyThingLoc tyThing >> >> -- | Pretty-prints a 'TyThing'. >> pprTyThing :: TyThing -> SDoc >> -pprTyThing thing = ppr_ty_thing showAll thing >> +pprTyThing thing = ppr_ty_thing (Just showAll) thing >> >> -- | Pretty-prints a 'TyThing' in context: that is, if the entity >> -- is a data constructor, record selector, or class method, then >> @@ -88,7 +85,7 @@ pprTyThingInContext thing >> where >> go ss thing = case tyThingParent_maybe thing of >> Just parent -> go (getName thing : ss) parent >> - Nothing -> ppr_ty_thing ss thing >> + Nothing -> ppr_ty_thing (Just ss) thing >> >> -- | Like 'pprTyThingInContext', but adds the defining location. >> pprTyThingInContextLoc :: TyThing -> SDoc >> @@ -100,21 +97,17 @@ pprTyThingInContextLoc tyThing >> -- 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 (AnId id) = pprId id >> -pprTyThingHdr (AConLike conLike) = case conLike of >> - RealDataCon dataCon -> pprDataConSig dataCon >> - PatSynCon patSyn -> pprPatSyn patSyn >> -pprTyThingHdr (ATyCon tyCon) = pprTyConHdr tyCon >> -pprTyThingHdr (ACoAxiom ax) = pprCoAxiom ax >> +pprTyThingHdr = ppr_ty_thing Nothing >> >> ------------------------ >> -ppr_ty_thing :: ShowSub -> TyThing -> SDoc >> -ppr_ty_thing _ (AnId id) = pprId id >> -ppr_ty_thing _ (AConLike conLike) = case conLike of >> - RealDataCon dataCon -> pprDataConSig dataCon >> - PatSynCon patSyn -> pprPatSyn patSyn >> -ppr_ty_thing ss (ATyCon tyCon) = pprTyCon ss tyCon >> -ppr_ty_thing _ (ACoAxiom ax) = pprCoAxiom ax >> +-- NOTE: We pretty-print 'TyThing' via 'IfaceDecl' so that we can reuse >> the >> +-- 'TyCon' tidying happening in 'tyThingToIfaceDecl'. See #8776 for >> details. >> +ppr_ty_thing :: Maybe ShowSub -> TyThing -> SDoc >> +ppr_ty_thing mss tyThing = case tyThing of >> + ATyCon tyCon -> case mss of >> + Nothing -> pprTyConHdr tyCon >> + Just ss -> pprTyCon ss tyCon >> + _ -> ppr $ tyThingToIfaceDecl tyThing >> >> pprTyConHdr :: TyCon -> SDoc >> pprTyConHdr tyCon >> @@ -143,10 +136,6 @@ pprTyConHdr tyCon >> | isAlgTyCon tyCon = pprThetaArrowTy (tyConStupidTheta tyCon) >> | otherwise = empty -- Returns 'empty' if null theta >> >> -pprDataConSig :: DataCon -> SDoc >> -pprDataConSig dataCon >> - = ppr_bndr dataCon <+> dcolon <+> pprTypeForUser (dataConUserType >> dataCon) >> - >> pprClassHdr :: Class -> SDoc >> pprClassHdr cls >> = sdocWithDynFlags $ \dflags -> >> @@ -158,28 +147,6 @@ pprClassHdr cls >> where >> (tvs, funDeps) = classTvsFds cls >> >> -pprId :: Var -> SDoc >> -pprId ident >> - = hang (ppr_bndr ident <+> dcolon) >> - 2 (pprTypeForUser (idType ident)) >> - >> -pprPatSyn :: PatSyn -> SDoc >> -pprPatSyn patSyn >> - = pprPatSynSig ident is_bidir args (pprTypeForUser rhs_ty) prov req >> - where >> - ident = patSynId patSyn >> - is_bidir = isJust $ patSynWrapper patSyn >> - >> - args = fmap pprParendType (patSynTyDetails patSyn) >> - prov = pprThetaOpt prov_theta >> - req = pprThetaOpt req_theta >> - >> - pprThetaOpt [] = Nothing >> - pprThetaOpt theta = Just $ pprTheta theta >> - >> - (_univ_tvs, _ex_tvs, (prov_theta, req_theta)) = patSynSig patSyn >> - rhs_ty = patSynType patSyn >> - >> pprTypeForUser :: Type -> SDoc >> -- We do two things here. >> -- a) We tidy the type, regardless >> >> _______________________________________________ >> ghc-commits mailing list >> [email protected] >> http://www.haskell.org/mailman/listinfo/ghc-commits >> > >
_______________________________________________ ghc-devs mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-devs
