Merge branch 'master' of http://darcs.haskell.org/ghc

15 files changed, 126 insertions, 104 deletions

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 6726087bee..4e45da4b4b 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -1456,7 +1456,11 @@ exprStats (Cast e co)     = coStats co `plusCS` exprStats e
 exprStats (Tick _ e)      = exprStats e
 
 altStats :: CoreAlt -> CoreStats
-altStats (_, bs, r) = sumCS bndrStats bs `plusCS` exprStats r
+altStats (_, bs, r) = altBndrStats bs `plusCS` exprStats r
+
+altBndrStats :: [Var] -> CoreStats
+-- Charge one for the alternative, not for each binder
+altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs
 
 tyStats :: Type -> CoreStats
 tyStats ty = zeroCS { cs_ty = typeSize ty }
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index fa1cde9f76..0ead297eb8 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -157,17 +157,13 @@ ppr_expr add_par expr@(App {})
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
   = sdocWithDynFlags $ \dflags ->
     if gopt Opt_PprCaseAsLet dflags
-    then add_par $
-         sep [sep    [ ptext (sLit "let")
-                             <+> char '{'
-                             <+> ppr_case_pat con args
-                             <+> ptext (sLit "~")
-                             <+> ppr_bndr var
-                     , ptext (sLit "<-")
-                             <+> ppr_expr id expr
-                     , char '}'
-                             <+> ptext (sLit "in")
-                     ]
+    then add_par $  -- See Note [Print case as let]
+         sep [ sep [ ptext (sLit "let! {") 
+                     <+> ppr_case_pat con args
+                     <+> ptext (sLit "~")
+                     <+> ppr_bndr var
+                   , ptext (sLit "<-") <+> ppr_expr id expr
+                     <+> ptext (sLit "} in") ]
              , pprCoreExpr rhs
              ]
     else add_par $
@@ -258,6 +254,17 @@ pprArg (Coercion co) = ptext (sLit "@~") <+> pprParendCo co
 pprArg expr          = pprParendExpr expr
 \end{code}
 
+Note [Print case as let]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Single-branch case expressions are very common:
+   case x of y { I# x' -> 
+   case p of q { I# p' -> ... } }
+These are, in effect, just strict let's, with pattern matching.
+With -dppr-case-as-let we print them as such:
+   let! { I# x' ~ y <- x } in
+   let! { I# p' ~ q <- p } in ...
+
+ 
 Other printing bits-and-bobs used with the general @pprCoreBinding@
 and @pprCoreExpr@ functions.
 
diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 7736aa69ed..2932b01822 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -205,7 +205,10 @@ check' :: [(EqnNo, EquationInfo)]
         -> ([ExhaustivePat],    -- Pattern scheme that might not be matched at all
             EqnSet)             -- Eqns that are used (others are overlapped)
 
-check' [] = ([([],[])],emptyUniqSet)
+check' [] = ([],emptyUniqSet)
+  -- Was    ([([],[])], emptyUniqSet)
+  -- But that (a) seems weird, and (b) triggered Trac #7669 
+  -- So now I'm just doing the simple obvious thing
 
 check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
    | first_eqn_all_vars && case can_fail of { CantFail -> True; CanFail -> False }
diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 2de2bb4d42..5b0f3b1ff6 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -507,6 +507,7 @@ tidy1 :: Id 			-- The Id being scrutinised
 tidy1 v (ParPat pat)      = tidy1 v (unLoc pat) 
 tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat) 
 tidy1 _ (WildPat ty)      = return (idDsWrapper, WildPat ty)
+tidy1 v (BangPat (L l p)) = tidy_bang_pat v l p
 
 	-- case v of { x -> mr[] }
 	-- = case v of { _ -> let x=v in mr[] }
@@ -565,24 +566,37 @@ tidy1 _ (LitPat lit)
 tidy1 _ (NPat lit mb_neg eq)
   = return (idDsWrapper, tidyNPat tidyLitPat lit mb_neg eq)
 
--- BangPatterns: Pattern matching is already strict in constructors,
--- tuples etc, so the last case strips off the bang for thoses patterns.
-tidy1 v (BangPat (L _ (LazyPat p)))       = tidy1 v (BangPat p)
-tidy1 v (BangPat (L _ (ParPat p)))        = tidy1 v (BangPat p)
-tidy1 _ p@(BangPat (L _(VarPat _)))       = return (idDsWrapper, p)
-tidy1 _ p@(BangPat (L _ (WildPat _)))     = return (idDsWrapper, p)
-tidy1 _ p@(BangPat (L _ (CoPat _ _ _)))   = return (idDsWrapper, p)
-tidy1 _ p@(BangPat (L _ (SigPatIn _ _)))  = return (idDsWrapper, p)
-tidy1 _ p@(BangPat (L _ (SigPatOut _ _))) = return (idDsWrapper, p)
-tidy1 v (BangPat (L _ (AsPat (L _ var) pat)))
-  = do	{ (wrap, pat') <- tidy1 v (BangPat pat)
-        ; return (wrapBind var v . wrap, pat') }
-tidy1 v (BangPat (L _ p))                   = tidy1 v p
-
 -- Everything else goes through unchanged...
 
 tidy1 _ non_interesting_pat
   = return (idDsWrapper, non_interesting_pat)
+
+--------------------
+tidy_bang_pat :: Id -> SrcSpan -> Pat Id -> DsM (DsWrapper, Pat Id)
+-- BangPatterns: Pattern matching is already strict in constructors,
+-- tuples etc, so the last case strips off the bang for those patterns.
+
+-- Discard bang around strict pattern
+tidy_bang_pat v _ p@(ListPat {})   = tidy1 v p
+tidy_bang_pat v _ p@(TuplePat {})  = tidy1 v p
+tidy_bang_pat v _ p@(PArrPat {})   = tidy1 v p
+tidy_bang_pat v _ p@(ConPatOut {}) = tidy1 v p
+tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
+
+-- Discard lazy/par/sig under a bang
+tidy_bang_pat v _ (LazyPat (L l p))     = tidy_bang_pat v l p
+tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
+tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p
+
+-- Push the bang-pattern inwards, in the hope that
+-- it may disappear next time 
+tidy_bang_pat v l (AsPat v' p)  = tidy1 v (AsPat v' (L l (BangPat p)))
+tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
+
+-- Default case, leave the bang there:
+-- VarPat, WildPat, ViewPat, NPat, NPlusKPat
+tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
+  -- NB: SigPatIn, ConPatIn should not happen
 \end{code}
 
 \noindent
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e7676c8c48..1748e94709 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -9,7 +9,10 @@ Type checking of type signatures in interface files
 module TcIface ( 
         tcImportDecl, importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
-        tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
+        tcIfaceVectInfo, tcIfaceAnnotations, 
+        tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
+        tcIfaceGlobal, 
+        tcExtCoreBindings
  ) where
 
 #include "HsVersions.h"
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 597f6a5710..6ea422f092 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -2104,7 +2104,7 @@ modid   :: { Located ModuleName }
                                      (unpackFS mod ++ '.':unpackFS c))
                                 }
 
-commas :: { Int }
+commas :: { Int }   -- One or more commas
         : commas ','                    { $1 + 1 }
         | ','                           { 1 }
 
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index d296beeaaf..a67580a18c 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -642,8 +642,8 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
   prodDataCon_RDR, comp1DataCon_RDR,
   unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR,
   from_RDR, from1_RDR, to_RDR, to1_RDR,
-  datatypeName_RDR, moduleName_RDR, conName_RDR,
-  conFixity_RDR, conIsRecord_RDR,
+  datatypeName_RDR, moduleName_RDR, isNewtypeName_RDR,
+  conName_RDR, conFixity_RDR, conIsRecord_RDR,
   noArityDataCon_RDR, arityDataCon_RDR, selName_RDR,
   prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,
   rightAssocDataCon_RDR, notAssocDataCon_RDR :: RdrName
@@ -672,6 +672,7 @@ to1_RDR   = varQual_RDR gHC_GENERICS (fsLit "to1")
 
 datatypeName_RDR  = varQual_RDR gHC_GENERICS (fsLit "datatypeName")
 moduleName_RDR    = varQual_RDR gHC_GENERICS (fsLit "moduleName")
+isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")
 selName_RDR       = varQual_RDR gHC_GENERICS (fsLit "selName")
 conName_RDR       = varQual_RDR gHC_GENERICS (fsLit "conName")
 conFixity_RDR     = varQual_RDR gHC_GENERICS (fsLit "conFixity")
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 98c0b9ec2f..fb9396e5ea 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -393,7 +393,7 @@ Does 'main' print "error 1" or "error no"?  We don't really want 'f'
 to unbox its second argument.  This actually happened in GHC's onwn
 source code, in Packages.applyPackageFlag, which ended up un-boxing
 the enormous DynFlags tuple, and being strict in the
-as-yet-un-filled-in pkgState fiels.
+as-yet-un-filled-in pkgState files.
 
 \begin{code}
 ----------------------
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 35afff6d5f..8bb6de1cc2 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -89,7 +89,7 @@ to compile, and it will run fine unless we evaluate `a`. This is what
 
 It does this by keeping track of which errors correspond to which coercion
 in TcErrors. TcErrors.reportTidyWanteds does not print the errors
-and does not fail if -fwarn-type-errors is on, so that we can continue
+and does not fail if -fdefer-type-errors is on, so that we can continue
 compilation. The errors are turned into warnings in `reportUnsolved`.
 
 Note [Suppressing error messages]
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index b45177e231..5726031493 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -101,105 +101,94 @@ data DerivStuff     -- Please add this auxiliary stuff
 %*                                                                      *
 %************************************************************************
 
-Here are the heuristics for the code we generate for @Eq@:
-\begin{itemize}
-\item
-  Let's assume we have a data type with some (possibly zero) nullary
-  data constructors and some ordinary, non-nullary ones (the rest,
-  also possibly zero of them).  Here's an example, with both \tr{N}ullary
-  and \tr{O}rdinary data cons.
-\begin{verbatim}
-data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
-\end{verbatim}
+Here are the heuristics for the code we generate for @Eq@. Let's
+assume we have a data type with some (possibly zero) nullary data
+constructors and some ordinary, non-nullary ones (the rest, also
+possibly zero of them).  Here's an example, with both \tr{N}ullary and
+\tr{O}rdinary data cons.
+
+  data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
 
-\item
-  For the ordinary constructors (if any), we emit clauses to do The
+* For the ordinary constructors (if any), we emit clauses to do The
   Usual Thing, e.g.,:
 
-\begin{verbatim}
-(==) (O1 a1 b1)    (O1 a2 b2)    = a1 == a2 && b1 == b2
-(==) (O2 a1)       (O2 a2)       = a1 == a2
-(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
-\end{verbatim}
+    (==) (O1 a1 b1)    (O1 a2 b2)    = a1 == a2 && b1 == b2
+    (==) (O2 a1)       (O2 a2)       = a1 == a2
+    (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
 
-  Note: if we're comparing unlifted things, e.g., if \tr{a1} and
-  \tr{a2} are \tr{Float#}s, then we have to generate
-\begin{verbatim}
-case (a1 `eqFloat#` a2) of
-  r -> r
-\end{verbatim}
+  Note: if we're comparing unlifted things, e.g., if 'a1' and
+  'a2' are Float#s, then we have to generate
+       case (a1 `eqFloat#` a2) of r -> r
   for that particular test.
 
-\item
-  If there are any nullary constructors, we emit a catch-all clause of
-  the form:
+* If there are a lot of (more than en) nullary constructors, we emit a
+  catch-all clause of the form:
 
-\begin{verbatim}
-(==) a b  = case (con2tag_Foo a) of { a# ->
-            case (con2tag_Foo b) of { b# ->
-            case (a# ==# b#)     of {
-              r -> r
-            }}}
-\end{verbatim}
+      (==) a b  = case (con2tag_Foo a) of { a# ->
+                  case (con2tag_Foo b) of { b# ->
+                  case (a# ==# b#)     of {
+                    r -> r }}}
 
-  If there aren't any nullary constructors, we emit a simpler
+  If con2tag gets inlined this leads to join point stuff, so
+  it's better to use regular pattern matching if there aren't too
+  many nullary constructors.  "Ten" is arbitrary, of course
+
+* If there aren't any nullary constructors, we emit a simpler
   catch-all:
-\begin{verbatim}
-(==) a b  = False
-\end{verbatim}
 
-\item
-  For the @(/=)@ method, we normally just use the default method.
+     (==) a b  = False
 
+* For the @(/=)@ method, we normally just use the default method.
   If the type is an enumeration type, we could/may/should? generate
   special code that calls @con2tag_Foo@, much like for @(==)@ shown
   above.
 
-\item
-  We thought about doing this: If we're also deriving @Ord@ for this
-  tycon, we generate:
-\begin{verbatim}
-instance ... Eq (Foo ...) where
-  (==) a b  = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
-  (/=) a b  = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
-\begin{verbatim}
-  However, that requires that \tr{Ord <whatever>} was put in the context
-  for the instance decl, which it probably wasn't, so the decls
-  produced don't get through the typechecker.
-\end{itemize}
-
+We thought about doing this: If we're also deriving 'Ord' for this
+tycon, we generate:
+  instance ... Eq (Foo ...) where
+    (==) a b  = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
+    (/=) a b  = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
+However, that requires that (Ord <whatever>) was put in the context
+for the instance decl, which it probably wasn't, so the decls
+produced don't get through the typechecker.
 
 \begin{code}
 gen_Eq_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
 gen_Eq_binds loc tycon
   = (method_binds, aux_binds)
   where
-    (nullary_cons, non_nullary_cons)
-       | isNewTyCon tycon = ([], tyConDataCons tycon)
-       | otherwise        = partition isNullarySrcDataCon (tyConDataCons tycon)
+    all_cons = tyConDataCons tycon
+    (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
 
-    no_nullary_cons = null nullary_cons
+    -- If there are ten or more (arbitrary number) nullary constructors,
+    -- use the con2tag stuff.  For small types it's better to use
+    -- ordinary pattern matching.
+    (tag_match_cons, pat_match_cons)
+       | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons)
+       | otherwise                       = ([],           all_cons)
+
+    no_tag_match_cons = null tag_match_cons
 
     fall_through_eqn
-      | no_nullary_cons   -- All constructors have arguments
-      = case non_nullary_cons of
+      | no_tag_match_cons   -- All constructors have arguments
+      = case pat_match_cons of
           []  -> []   -- No constructors; no fall-though case
           [_] -> []   -- One constructor; no fall-though case
           _   ->      -- Two or more constructors; add fall-through of
                       --       (==) _ _ = False
                  [([nlWildPat, nlWildPat], false_Expr)]
 
-      | otherwise -- One or more nullary cons; add fall-through of
+      | otherwise -- One or more tag_match cons; add fall-through of
                   -- extract tags compare for equality
       = [([a_Pat, b_Pat],
          untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
                     (genOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
 
-    aux_binds | no_nullary_cons = emptyBag
-              | otherwise       = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
+    aux_binds | no_tag_match_cons = emptyBag
+              | otherwise         = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
 
     method_binds = listToBag [eq_bind, ne_bind]
-    eq_bind = mk_FunBind loc eq_RDR (map pats_etc non_nullary_cons ++ fall_through_eqn)
+    eq_bind = mk_FunBind loc eq_RDR (map pats_etc pat_match_cons ++ fall_through_eqn)
     ne_bind = mk_easy_FunBind loc ne_RDR [a_Pat, b_Pat] (
                         nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
 
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index 2c752434f8..b058c283d7 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -628,8 +628,10 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
         mkBag l = foldr1 unionBags 
                     [ unitBag (L loc (mkFunBind (L loc name) matches)) 
                         | (name, matches) <- l ]
-        dtBinds       = mkBag [ (datatypeName_RDR, dtName_matches)
-                              , (moduleName_RDR, moduleName_matches)]
+        dtBinds       = mkBag ( [ (datatypeName_RDR, dtName_matches)
+                                , (moduleName_RDR, moduleName_matches)]
+                              ++ ifElseEmpty (isNewTyCon tycon)
+                                [ (isNewtypeName_RDR, isNewtype_matches) ] )
 
         allConBinds   = map conBinds datacons
         conBinds c    = mkBag ( [ (conName_RDR, conName_matches c)]
@@ -663,6 +665,7 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
                            $ tyConName_user
         moduleName_matches = mkStringLHS . moduleNameString . moduleName 
                            . nameModule . tyConName $ tycon
+        isNewtype_matches  = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)]
 
         conName_matches     c = mkStringLHS . occNameString . nameOccName
                               . dataConName $ c
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 484095d2db..c103385e4e 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -25,7 +25,6 @@ module TcRnDriver (
 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
 #endif
 
-import TypeRep
 import DynFlags
 import StaticFlags
 import HsSyn
@@ -1514,7 +1513,7 @@ isGHCiMonad hsc_env ictxt ty
                 let name = gre_name n
                 ghciClass <- tcLookupClass ghciIoClassName 
                 userTyCon <- tcLookupTyCon name
-                let userTy = TyConApp userTyCon []
+                let userTy = mkTyConApp userTyCon []
                 _ <- tcLookupInstance ghciClass [userTy]
                 return name
 
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index de19b912ac..b21888a76d 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -558,7 +558,7 @@ to compile, and it will run fine unless we evaluate `a`. This is what
 
 It does this by keeping track of which errors correspond to which coercion
 in TcErrors (with ErrEnv). TcErrors.reportTidyWanteds does not print the errors
-and does not fail if -fwarn-type-errors is on, so that we can continue
+and does not fail if -fdefer-type-errors is on, so that we can continue
 compilation. The errors are turned into warnings in `reportUnsolved`.
 
 Note [Zonk after solving]
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 31a92a8162..601135d303 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -896,7 +896,7 @@ checkTauTvUpdate dflags tv ty
 
     defer_me :: TcType -> Bool
     -- Checks for (a) occurrence of tv
-    --            (b) type family applicatios
+    --            (b) type family applications
     -- See Note [Conservative unification check]
     defer_me (LitTy {})        = False
     defer_me (TyVarTy tv')     = tv == tv'
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index 3de9c21951..4ade32b0e9 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -514,9 +514,8 @@ ppr_co p (AppCo co1 co2)       = maybeParen p TyConPrec $
 ppr_co p co@(ForAllCo {})      = ppr_forall_co p co
 ppr_co _ (CoVarCo cv)          = parenSymOcc (getOccName cv) (ppr cv)
 ppr_co p (AxiomInstCo con index cos)
-  = angleBrackets (pprPrefixApp p 
-                    (ppr (getName con) <> brackets (ppr index))
-                    (map (ppr_co TyConPrec) cos))
+  = pprPrefixApp p (ppr (getName con) <> brackets (ppr index))
+                   (map (ppr_co TyConPrec) cos)
 
 ppr_co p co@(TransCo {}) = maybeParen p FunPrec $
                            case trans_co_list co [] of