Small bugfixes found from testing.

ghc · Jun 20, 2013 · 81bccef · 81bccef
1 parent 9b85f75
commit 81bccef
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 11 deletions.
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
@@ -271,7 +271,7 @@ repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
 		                   fdKindSig = opt_kind }))
   = do { tc1 <- lookupLOcc tc 		-- See note [Binders and occurrences] 
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
-           do { info' <- repFamilyInfo info
+           do { 
 	      ; case (opt_kind, info) of 
                   (Nothing, ClosedTypeFamily eqns) ->
                     do { eqns1 <- mapM repTyFamEqn eqns
@@ -282,9 +282,13 @@ repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
                        ; eqns2 <- coreList tySynEqnQTyConName eqns1
                        ; ki1 <- repLKind ki
                        ; repClosedFamilyKind tc1 bndrs ki1 eqns2 }              
-                  (Nothing, _) -> repFamilyNoKind info' tc1 bndrs
-                  (Just ki, _) -> do { ki1 <- repLKind ki 
-                                ; repFamilyKind info' tc1 bndrs ki1 }
+                  (Nothing, _) ->
+                    do { info' <- repFamilyInfo info
+                       ; repFamilyNoKind info' tc1 bndrs }
+                  (Just ki, _) ->
+                    do { info' <- repFamilyInfo info
+                       ; ki1 <- repLKind ki 
+                       ; repFamilyKind info' tc1 bndrs ki1 }
               }
        ; return (loc, dec)
        }

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
@@ -128,10 +128,22 @@ data IfaceAT = IfaceAT IfaceDecl [IfaceAxBranch]
         -- Just ds => default associated type instance from these templates
 
 instance Outputable IfaceAxBranch where
-   ppr (IfaceAxBranch { ifaxbTyVars = tvs, ifaxbLHS = pat_tys, ifaxbRHS = ty
-                      , ifaxbIncomps = incomps }) 
-      = ppr tvs <+> hsep (map ppr pat_tys) <+> char '=' <+> ppr ty $$ maybe_incomps
+  ppr = pprAxBranch Nothing
+
+pprAxBranch :: Maybe IfaceTyCon -> IfaceAxBranch -> SDoc
+pprAxBranch mtycon (IfaceAxBranch { ifaxbTyVars = tvs
+                                  , ifaxbLHS = pat_tys
+                                  , ifaxbRHS = ty
+                                  , ifaxbIncomps = incomps })
+  = ppr tvs <+> ppr_lhs <+> char '=' <+> ppr ty $+$
+    nest 4 maybe_incomps
       where
+        ppr_lhs
+          | Just tycon <- mtycon
+          = ppr (IfaceTyConApp tycon pat_tys)
+          | otherwise
+          = hsep (map ppr pat_tys)
+
         maybe_incomps
           | [] <- incomps
           = empty
@@ -554,10 +566,7 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 
 pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branches })
   = hang (ptext (sLit "axiom") <+> ppr name <> colon)
-       2 (vcat $ map ppr_branch branches)
-  where
-     ppr_branch (IfaceAxBranch { ifaxbTyVars = tyvars, ifaxbLHS = lhs, ifaxbRHS = rhs })
-        = pprIfaceTvBndrs tyvars <> dot <+> ppr (IfaceTyConApp tycon lhs) <+> text "~#" <+> ppr rhs
+       2 (vcat $ map (pprAxBranch $ Just tycon) branches)
 
 pprCType :: Maybe CType -> SDoc
 pprCType Nothing = ptext (sLit "No C type associated")