Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
96a89801
Commit
96a89801
authored
Jun 07, 2014
by
Joachim Breitner
Browse files
Pretty-print built in synonym families in interfaces
This closes #9181.
parent
b36bc2f5
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/iface/IfaceSyn.lhs
View file @
96a89801
...
...
@@ -275,6 +275,7 @@ data IfaceSynTyConRhs
[IfaceAxBranch] -- for pretty printing purposes only
| IfaceAbstractClosedSynFamilyTyCon
| IfaceSynonymTyCon IfaceType
| IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
instance Binary IfaceSynTyConRhs where
put_ bh IfaceOpenSynFamilyTyCon = putByte bh 0
...
...
@@ -282,6 +283,8 @@ instance Binary IfaceSynTyConRhs where
>> put_ bh br
put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
put_ bh (IfaceSynonymTyCon ty) = putByte bh 3 >> put_ bh ty
put_ _ IfaceBuiltInSynFamTyCon
= pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty
get bh = do { h <- getByte bh
; case h of
...
...
@@ -1255,6 +1258,7 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
pp_rhs IfaceOpenSynFamilyTyCon = ppShowIface ss (ptext (sLit "open"))
pp_rhs IfaceAbstractClosedSynFamilyTyCon = ppShowIface ss (ptext (sLit "closed, abstract"))
pp_rhs (IfaceClosedSynFamilyTyCon _ (_:_)) = ptext (sLit "where")
pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in"))
pp_rhs _ = panic "pprIfaceDecl syn"
pp_branches (IfaceClosedSynFamilyTyCon ax brs)
...
...
@@ -1635,6 +1639,7 @@ freeNamesIfSynRhs IfaceOpenSynFamilyTyCon = emptyNameSet
freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br)
= unitNameSet ax &&& fnList freeNamesIfAxBranch br
freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet
freeNamesIfContext :: IfaceContext -> NameSet
freeNamesIfContext = fnList freeNamesIfType
...
...
compiler/iface/MkIface.lhs
View file @
96a89801
...
...
@@ -1626,7 +1626,7 @@ tyConToIfaceDecl env tycon
= IfaceSynonymTyCon (tidyToIfaceType env1 ty)
to_ifsyn_rhs (BuiltInSynFamTyCon {})
=
pprPanic "toIfaceDecl:
BuiltInFamTyCon
" (ppr tycon)
=
Iface
BuiltIn
Syn
FamTyCon
ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
...
...
compiler/iface/TcIface.lhs
View file @
96a89801
...
...
@@ -494,6 +494,8 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
tc_syn_rhs IfaceAbstractClosedSynFamilyTyCon = return AbstractClosedSynFamilyTyCon
tc_syn_rhs (IfaceSynonymTyCon ty) = do { rhs_ty <- tcIfaceType ty
; return (SynonymTyCon rhs_ty) }
tc_syn_rhs IfaceBuiltInSynFamTyCon = pprPanic "tc_iface_decl"
(ptext (sLit "IfaceBuiltInSynFamTyCon in interface file"))
tc_iface_decl _parent ignore_prags
(IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
...
...
testsuite/tests/ghci/scripts/T9181.stdout
0 → 100644
View file @
96a89801
type family (GHC.TypeLits.*) (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
GHC.TypeLits.Nat
type family (GHC.TypeLits.+) (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
GHC.TypeLits.Nat
type family (GHC.TypeLits.-) (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
GHC.TypeLits.Nat
type (GHC.TypeLits.<=) (x :: GHC.TypeLits.Nat)
(y :: GHC.TypeLits.Nat) =
(x GHC.TypeLits.<=? y) ~ 'True
type family (GHC.TypeLits.<=?) (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
Bool
type family GHC.TypeLits.CmpNat (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
Ordering
type family GHC.TypeLits.CmpSymbol (a :: GHC.TypeLits.Symbol)
(b :: GHC.TypeLits.Symbol) ::
Ordering
class GHC.TypeLits.KnownNat (n :: GHC.TypeLits.Nat) where
GHC.TypeLits.natSing :: GHC.TypeLits.SNat n
class GHC.TypeLits.KnownSymbol (n :: GHC.TypeLits.Symbol) where
GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n
data GHC.TypeLits.Nat
data GHC.TypeLits.SomeNat where
GHC.TypeLits.SomeNat :: GHC.TypeLits.KnownNat n =>
(Data.Proxy.Proxy n) -> GHC.TypeLits.SomeNat
data GHC.TypeLits.SomeSymbol where
GHC.TypeLits.SomeSymbol :: GHC.TypeLits.KnownSymbol n =>
(Data.Proxy.Proxy n) -> GHC.TypeLits.SomeSymbol
data GHC.TypeLits.Symbol
type family (GHC.TypeLits.^) (a :: GHC.TypeLits.Nat)
(b :: GHC.TypeLits.Nat) ::
GHC.TypeLits.Nat
GHC.TypeLits.natVal ::
GHC.TypeLits.KnownNat n => proxy n -> Integer
GHC.TypeLits.sameNat ::
(GHC.TypeLits.KnownNat a, GHC.TypeLits.KnownNat b) =>
Data.Proxy.Proxy a
-> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b)
GHC.TypeLits.sameSymbol ::
(GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) =>
Data.Proxy.Proxy a
-> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b)
GHC.TypeLits.someNatVal :: Integer -> Maybe GHC.TypeLits.SomeNat
GHC.TypeLits.someSymbolVal :: String -> GHC.TypeLits.SomeSymbol
GHC.TypeLits.symbolVal ::
GHC.TypeLits.KnownSymbol n => proxy n -> String
testsuite/tests/ghci/scripts/all.T
View file @
96a89801
...
...
@@ -174,4 +174,4 @@ test('T8917', normal, ghci_script, ['T8917.script'])
test
('
T8931
',
normal
,
ghci_script
,
['
T8931.script
'])
test
('
T8959
',
normal
,
ghci_script
,
['
T8959.script
'])
test
('
T8959b
',
expect_broken
(
8959
),
ghci_script
,
['
T8959b.script
'])
test
('
T9181
',
expect_broken
(
9181
)
,
ghci_script
,
['
T9181.script
'])
test
('
T9181
',
normal
,
ghci_script
,
['
T9181.script
'])
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment