Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
GHC
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alexander Kaznacheev
GHC
Commits
1ea02299
Commit
1ea02299
authored
11 years ago
by
Gergő Érdi
Browse files
Options
Downloads
Patches
Plain Diff
Pretty-print the following TyThings via their IfaceDecl counterpart:
* AnId * ACoAxiom * AConLike
parent
880a37bd
Loading
Loading
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
compiler/iface/IfaceSyn.lhs
+1
-1
1 addition, 1 deletion
compiler/iface/IfaceSyn.lhs
compiler/iface/MkIface.lhs
+9
-1
9 additions, 1 deletion
compiler/iface/MkIface.lhs
compiler/main/PprTyThing.hs
+13
-46
13 additions, 46 deletions
compiler/main/PprTyThing.hs
with
23 additions
and
48 deletions
compiler/iface/IfaceSyn.lhs
+
1
−
1
View file @
1ea02299
...
...
@@ -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 <>
d
colon)
2 (vcat $ map (pprAxBranch $ Just tycon) branches)
pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
...
...
This diff is collapsed.
Click to expand it.
compiler/iface/MkIface.lhs
+
9
−
1
View file @
1ea02299
...
...
@@ -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 "t
oIfaceDecl
" (ppr
dc
)
--
Should be trimmed out earlier
RealDataCon dc ->
dataConT
oIfaceDecl dc --
for ppr purposes only
PatSynCon ps -> patSynToIfaceDecl ps
--------------------------
...
...
@@ -1476,6 +1476,14 @@ idToIfaceDecl id
ifIdDetails = toIfaceIdDetails (idDetails 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
...
...
This diff is collapsed.
Click to expand it.
compiler/main/PprTyThing.hs
+
13
−
46
View file @
1ea02299
...
...
@@ -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
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment