Pretty-print built in synonym families in interfaces

This closes #9181.

5 files changed, 59 insertions, 2 deletions

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 79e235925e..afd73639f9 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -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
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index e3c0ac33d8..f2d2058611 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1626,7 +1626,7 @@ tyConToIfaceDecl env tycon
       = IfaceSynonymTyCon (tidyToIfaceType env1 ty)
 
     to_ifsyn_rhs (BuiltInSynFamTyCon {})
-      = pprPanic "toIfaceDecl: BuiltInFamTyCon" (ppr tycon)
+      = IfaceBuiltInSynFamTyCon
 
 
     ifaceConDecls (NewTyCon { data_con = con })     = IfNewTyCon  (ifaceConDecl con)
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e4a415a099..1a2a447576 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -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,
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
new file mode 100644
index 0000000000..fb9cf5d4e0
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -0,0 +1,50 @@
+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
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 1ae910500c..b71dfd14ce 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -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'])