[commit: ghc] master: Pretty-print the following TyThings via their IfaceDecl counterpart: * AnId * ACoAxiom * AConLike (065c35a)
Dr. ÉRDI Gergő
gergo at erdi.hu
Thu Mar 13 22:52:32 UTC 2014
Yes:-(
I'll unbreak them later today.
On Mar 14, 2014 4:16 AM, "Johan Tibell" <johan.tibell at gmail.com> 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, <git at git.haskell.org> wrote:
>
>> Repository : ssh://git@git.haskell.org/ghc
>>
>> On branch : master
>> Link :
>> http://ghc.haskell.org/trac/ghc/changeset/065c35a9d6d48060c8fac8d755833349ce58b35b/ghc
>>
>> >---------------------------------------------------------------
>>
>> commit 065c35a9d6d48060c8fac8d755833349ce58b35b
>> Author: Dr. ERDI Gergo <gergo at erdi.hu>
>> 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
>> ghc-commits at haskell.org
>> http://www.haskell.org/mailman/listinfo/ghc-commits
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/ghc-devs/attachments/20140314/d25bd3f1/attachment.html>
More information about the ghc-devs
mailing list