[commit: ghc] master: Simplify printing of boot-file mis-matches, by using PprTyThing.pprTyThing (8755758)

git at git.haskell.org git
Fri Oct 4 18:16:17 UTC 2013


Repository : ssh://git at git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/875575805a99d73deebb2d0b9bf36cc296009dda/ghc

>---------------------------------------------------------------

commit 875575805a99d73deebb2d0b9bf36cc296009dda
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Oct 4 18:45:55 2013 +0100

    Simplify printing of boot-file mis-matches, by using PprTyThing.pprTyThing


>---------------------------------------------------------------

875575805a99d73deebb2d0b9bf36cc296009dda
 compiler/typecheck/TcRnDriver.lhs |   19 ++++---------------
 1 file changed, 4 insertions(+), 15 deletions(-)

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index de45b50..1ab1bc7 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -34,7 +34,8 @@ import TcHsSyn
 import TcExpr
 import TcRnMonad
 import TcEvidence
-import Coercion( pprCoAxiom, pprCoAxBranch )
+import PprTyThing( pprTyThing )
+import Coercion( pprCoAxiom )
 import FamInst
 import InstEnv
 import FamInstEnv
@@ -850,20 +851,8 @@ bootMisMatch real_thing boot_thing
   = vcat [ppr real_thing <+>
           ptext (sLit "has conflicting definitions in the module"),
           ptext (sLit "and its hs-boot file"),
-          ptext (sLit "Main module:") <+> ppr_mismatch real_thing,
-          ptext (sLit "Boot file:  ") <+> ppr_mismatch boot_thing]
-  where
-      -- closed type families need special treatment, because they might differ
-      -- in their equations, which are not stored in the corresponding IfaceDecl
-    ppr_mismatch thing
-      | ATyCon tc <- thing
-      , Just (ClosedSynFamilyTyCon ax) <- synTyConRhs_maybe tc
-      = hang (ppr iface_decl <+> ptext (sLit "where"))
-           2 (vcat $ brListMap (pprCoAxBranch tc) (coAxiomBranches ax))
-      
-      | otherwise
-      = ppr iface_decl
-      where iface_decl = tyThingToIfaceDecl thing
+          ptext (sLit "Main module:") <+> PprTyThing.pprTyThing real_thing,
+          ptext (sLit "Boot file:  ") <+> PprTyThing.pprTyThing boot_thing]
 
 instMisMatch :: ClsInst -> SDoc
 instMisMatch inst




More information about the ghc-commits mailing list