diff options
47 files changed, 261 insertions, 196 deletions
diff --git a/compiler/basicTypes/DataCon.hs-boot b/compiler/basicTypes/DataCon.hs-boot index ca20788a84..615ef53d09 100644 --- a/compiler/basicTypes/DataCon.hs-boot +++ b/compiler/basicTypes/DataCon.hs-boot @@ -17,6 +17,8 @@ dataConSourceArity :: DataCon -> Arity dataConFieldLabels :: DataCon -> [FieldLabel] dataConInstOrigArgTys :: DataCon -> [Type] -> [Type] dataConStupidTheta :: DataCon -> ThetaType +dataConFullSig :: DataCon + -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type], Type) instance Eq DataCon instance Ord DataCon diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 00a7fd0b19..d9116a6f9b 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1350,13 +1350,13 @@ lintCoercion (InstCo co arg_ty) lintCoercion co@(AxiomInstCo con ind cos) = do { unless (0 <= ind && ind < numBranches (coAxiomBranches con)) - (bad_ax (ptext (sLit "index out of range"))) + (bad_ax (text "index out of range")) -- See Note [Kind instantiation in coercions] ; let CoAxBranch { cab_tvs = ktvs , cab_roles = roles , cab_lhs = lhs , cab_rhs = rhs } = coAxiomNthBranch con ind - ; unless (equalLength ktvs cos) (bad_ax (ptext (sLit "lengths"))) + ; unless (equalLength ktvs cos) (bad_ax (text "lengths")) ; in_scope <- getInScope ; let empty_subst = mkTvSubst in_scope emptyTvSubstEnv ; (subst_l, subst_r) <- foldlM check_ki @@ -1365,11 +1365,12 @@ lintCoercion co@(AxiomInstCo con ind cos) ; let lhs' = Type.substTys subst_l lhs rhs' = Type.substTy subst_r rhs ; case checkAxInstCo co of - Just bad_branch -> bad_ax $ ptext (sLit "inconsistent with") <+> (pprCoAxBranch (coAxiomTyCon con) bad_branch) + Just bad_branch -> bad_ax $ text "inconsistent with" <+> + pprCoAxBranch con bad_branch Nothing -> return () ; return (typeKind rhs', mkTyConApp (coAxiomTyCon con) lhs', rhs', coAxiomRole con) } where - bad_ax what = addErrL (hang (ptext (sLit "Bad axiom application") <+> parens what) + bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) check_ki (subst_l, subst_r) (ktv, role, co) @@ -1379,7 +1380,8 @@ lintCoercion co@(AxiomInstCo con ind cos) -- Using subst_l is ok, because subst_l and subst_r -- must agree on kind equalities ; unless (k `isSubKind` ktv_kind) - (bad_ax (ptext (sLit "check_ki2") <+> vcat [ ppr co, ppr k, ppr ktv, ppr ktv_kind ] )) + (bad_ax (text "check_ki2" <+> + vcat [ ppr co, ppr k, ppr ktv, ppr ktv_kind ] )) ; return (Type.extendTvSubst subst_l ktv t1, Type.extendTvSubst subst_r ktv t2) } diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index a14c608d1c..98f7f0f051 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -463,7 +463,7 @@ mkErrorAppDs err_id ty msg = do src_loc <- getSrcSpanDs dflags <- getDynFlags let - full_msg = showSDoc dflags (hcat [ppr src_loc, text "|", msg]) + full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg]) core_msg = Lit (mkMachString full_msg) -- mkMachString returns a result of type String# return (mkApps (Var err_id) [Type ty, core_msg]) diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index ec46d0e0f2..91c04fa08c 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -906,7 +906,7 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr pp_inj = case mb_inj of Just (L _ (InjectivityAnn lhs rhs)) -> - hsep [ text "|", ppr lhs, text "->", hsep (map ppr rhs) ] + hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ] Nothing -> empty (pp_where, pp_eqns) = case info of ClosedTypeFamily mb_eqns -> diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index d02f2d57d0..e688d18a08 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -713,7 +713,7 @@ ppr_expr (HsIf _ e1 e2 e3) ppr_expr (HsMultiIf _ alts) = sep $ ptext (sLit "if") : map ppr_alt alts where ppr_alt (L _ (GRHS guards expr)) = - sep [ char '|' <+> interpp'SP guards + sep [ vbar <+> interpp'SP guards , ptext (sLit "->") <+> pprDeeper (ppr expr) ] -- special case: let ... in let ... @@ -1283,7 +1283,7 @@ pprGRHS ctxt (GRHS [] body) = pp_rhs ctxt body pprGRHS ctxt (GRHS guards body) - = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt body] + = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body] pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs) @@ -1707,7 +1707,7 @@ pprComp :: (OutputableBndr id, Outputable body) pprComp quals -- Prints: body | qual1, ..., qualn | not (null quals) , L _ (LastStmt body _ _) <- last quals - = hang (ppr body <+> char '|') 2 (pprQuals (dropTail 1 quals)) + = hang (ppr body <+> vbar) 2 (pprQuals (dropTail 1 quals)) | otherwise = pprPanic "pprComp" (pprQuals quals) @@ -1842,7 +1842,7 @@ pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <> - char '[' <> ppr quoter <> ptext (sLit "|") <> + char '[' <> ppr quoter <> vbar <> ppr quote <> ptext (sLit "|]") ppr_splice :: OutputableBndr id => SDoc -> id -> LHsExpr id -> SDoc @@ -1888,7 +1888,7 @@ pprHsBracket (VarBr False n) = ptext (sLit "''") <> ppr n pprHsBracket (TExpBr e) = thTyBrackets (ppr e) thBrackets :: SDoc -> SDoc -> SDoc -thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+> +thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+> pp_body <+> ptext (sLit "|]") thTyBrackets :: SDoc -> SDoc diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 3911786594..41d6779785 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -643,7 +643,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, -- See discussion on Trac #8672. add_bars [] = Outputable.empty - add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs) + add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs) ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc) @@ -741,7 +741,7 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars pp_inj_cond res inj = case filterByList inj tyvars of [] -> empty - tvs -> hsep [text "|", ppr res, text "->", interppSP (map fst tvs)] + tvs -> hsep [vbar, ppr res, text "->", interppSP (map fst tvs)] pp_rhs IfaceDataFamilyTyCon = ppShowIface ss (ptext (sLit "data")) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 48acd8dd28..f4a6a3d79d 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -910,9 +910,10 @@ When printing export lists, we print like this: pprExport :: IfaceExport -> SDoc pprExport (Avail _ n) = ppr n pprExport (AvailTC _ [] []) = Outputable.empty -pprExport (AvailTC n ns0 fs) = case ns0 of - (n':ns) | n==n' -> ppr n <> pp_export ns fs - _ -> ppr n <> char '|' <> pp_export ns0 fs +pprExport (AvailTC n ns0 fs) + = case ns0 of + (n':ns) | n==n' -> ppr n <> pp_export ns fs + _ -> ppr n <> vbar <> pp_export ns0 fs where pp_export [] [] = Outputable.empty pp_export names fs = braces (hsep (map ppr names ++ map (ppr . flLabel) fs)) diff --git a/compiler/nativeGen/Reg.hs b/compiler/nativeGen/Reg.hs index 862306f0bb..e8d0187641 100644 --- a/compiler/nativeGen/Reg.hs +++ b/compiler/nativeGen/Reg.hs @@ -135,8 +135,9 @@ instance Uniquable RealReg where instance Outputable RealReg where ppr reg = case reg of - RealRegSingle i -> text "%r" <> int i - RealRegPair r1 r2 -> text "%r(" <> int r1 <> text "|" <> int r2 <> text ")" + RealRegSingle i -> text "%r" <> int i + RealRegPair r1 r2 -> text "%r(" <> int r1 + <> vbar <> int r2 <> text ")" regNosOfRealReg :: RealReg -> [RegNo] regNosOfRealReg rr diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 93beabef10..eac88f8d0c 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -161,7 +161,7 @@ pprReg reg RealRegPair r1 r2 -> text "(" <> pprReg_ofRegNo r1 - <> text "|" <> pprReg_ofRegNo r2 + <> vbar <> pprReg_ofRegNo r2 <> text ")" diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 7023a4c1f9..93de5040f0 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -402,10 +402,10 @@ checkForInjectivityConflicts instEnvs famInst | isTypeFamilyTyCon tycon -- type family is injective in at least one argument , Injective inj <- familyTyConInjectivityInfo tycon = do - { let axiom = coAxiomSingleBranch (fi_axiom famInst) + { let axiom = coAxiomSingleBranch fi_ax conflicts = lookupFamInstEnvInjectivityConflicts inj instEnvs famInst -- see Note [Verifying injectivity annotation] in FamInstEnv - errs = makeInjectivityErrors tycon axiom inj conflicts + errs = makeInjectivityErrors fi_ax axiom inj conflicts ; mapM_ (\(err, span) -> setSrcSpan span $ addErr err) errs ; return (null errs) } @@ -414,15 +414,16 @@ checkForInjectivityConflicts instEnvs famInst -- type family we report no conflicts | otherwise = return True where tycon = famInstTyCon famInst + fi_ax = fi_axiom famInst -- | Build a list of injectivity errors together with their source locations. makeInjectivityErrors - :: TyCon -- ^ Type family tycon for which we generate errors + :: CoAxiom br -- ^ Type family for which we generate errors -> CoAxBranch -- ^ Currently checked equation (represented by axiom) -> [Bool] -- ^ Injectivity annotation -> [CoAxBranch] -- ^ List of injectivity conflicts -> [(SDoc, SrcSpan)] -makeInjectivityErrors tycon axiom inj conflicts +makeInjectivityErrors fi_ax axiom inj conflicts = ASSERT2( any id inj, text "No injective type variables" ) let lhs = coAxBranchLHS axiom rhs = coAxBranchRHS axiom @@ -435,7 +436,8 @@ makeInjectivityErrors tycon axiom inj conflicts wrong_bare_rhs = not $ null bare_variables err_builder herald eqns - = ( herald $$ vcat (map (pprCoAxBranch tycon) eqns) + = ( hang herald + 2 (vcat (map (pprCoAxBranch fi_ax) eqns)) , coAxBranchSpan (head eqns) ) errorIf p f = if p then [f err_builder axiom] else [] in errorIf are_conflicts (conflictInjInstErr conflicts ) diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 06cb42715a..51e00159b1 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -1288,7 +1288,8 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys error_msg dflags = L inst_loc (HsLit (HsStringPrim "" (unsafeMkByteString (error_string dflags)))) meth_tau = funResultTy (applyTys (idType sel_id) inst_tys) - error_string dflags = showSDoc dflags (hcat [ppr inst_loc, text "|", ppr sel_id ]) + error_string dflags = showSDoc dflags + (hcat [ppr inst_loc, vbar, ppr sel_id ]) lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars tc_default sel_id (DefMeth dm_name) -- A polymorphic default method diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 3b5d206a67..d3f8291881 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -35,6 +35,7 @@ import Class import TyCon -- others: +import Coercion ( pprCoAxBranch ) import HsSyn -- HsType import TcRnMonad -- TcType, amongst others import FunDeps @@ -1238,7 +1239,7 @@ wrongATArgErr ty instTy = -} checkValidCoAxiom :: CoAxiom Branched -> TcM () -checkValidCoAxiom (CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) +checkValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) = do { mapM_ (checkValidCoAxBranch Nothing fam_tc) branch_list ; foldlM_ check_branch_compat [] branch_list } where @@ -1254,7 +1255,7 @@ checkValidCoAxiom (CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) check_branch_compat prev_branches cur_branch | cur_branch `isDominatedBy` prev_branches = do { addWarnAt (coAxBranchSpan cur_branch) $ - inaccessibleCoAxBranch fam_tc cur_branch + inaccessibleCoAxBranch ax cur_branch ; return prev_branches } | otherwise = do { check_injectivity prev_branches cur_branch @@ -1270,7 +1271,7 @@ checkValidCoAxiom (CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) fst $ foldl (gather_conflicts inj prev_branches cur_branch) ([], 0) prev_branches ; mapM_ (\(err, span) -> setSrcSpan span $ addErr err) - (makeInjectivityErrors fam_tc cur_branch inj conflicts) } + (makeInjectivityErrors ax cur_branch inj conflicts) } | otherwise = return () @@ -1388,13 +1389,10 @@ isTyFamFree = null . tcTyFamInsts -- Error messages -inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc -inaccessibleCoAxBranch fam_tc (CoAxBranch { cab_tvs = tvs - , cab_lhs = lhs - , cab_rhs = rhs }) +inaccessibleCoAxBranch :: CoAxiom br -> CoAxBranch -> SDoc +inaccessibleCoAxBranch fi_ax cur_branch = ptext (sLit "Type family instance equation is overlapped:") $$ - hang (pprUserForAll tvs) - 2 (hang (pprTypeApp fam_tc lhs) 2 (equals <+> (ppr rhs))) + nest 2 (pprCoAxBranch fi_ax cur_branch) tyFamInstIllegalErr :: Type -> SDoc tyFamInstIllegalErr ty diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs index 9daa3722b8..34f6edbcec 100644 --- a/compiler/types/Class.hs +++ b/compiler/types/Class.hs @@ -290,7 +290,7 @@ instance Outputable DefMeth where pprFundeps :: Outputable a => [FunDep a] -> SDoc pprFundeps [] = empty -pprFundeps fds = hsep (ptext (sLit "|") : punctuate comma (map pprFunDep fds)) +pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds)) pprFunDep :: Outputable a => FunDep a -> SDoc pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs] diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index b73ca4969b..af05d5c1f8 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -754,29 +754,39 @@ ppr_forall_co p ty split1 tvs ty = (reverse tvs, ty) pprCoAxiom :: CoAxiom br -> SDoc -pprCoAxiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches }) - = hang (ptext (sLit "axiom") <+> ppr ax <+> dcolon) - 2 (vcat (map (pprCoAxBranch tc) $ fromBranches branches)) +pprCoAxiom ax@(CoAxiom { co_ax_branches = branches }) + = hang (text "axiom" <+> ppr ax <+> dcolon) + 2 (vcat (map (ppr_co_ax_branch (const ppr) ax) $ fromBranches branches)) -pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc -pprCoAxBranch fam_tc (CoAxBranch { cab_tvs = tvs - , cab_lhs = lhs - , cab_rhs = rhs }) - = hang (pprUserForAll tvs) - 2 (hang (pprTypeApp fam_tc lhs) 2 (equals <+> (ppr rhs))) +pprCoAxBranch :: CoAxiom br -> CoAxBranch -> SDoc +pprCoAxBranch = ppr_co_ax_branch pprRhs + where + pprRhs fam_tc (TyConApp tycon _) + | isDataFamilyTyCon fam_tc + = pprDataCons tycon + pprRhs _ rhs = ppr rhs pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc -pprCoAxBranchHdr ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_name = name }) index - | CoAxBranch { cab_lhs = tys, cab_loc = loc } <- coAxiomNthBranch ax index - = hang (pprTypeApp fam_tc tys) - 2 (ptext (sLit "-- Defined") <+> ppr_loc loc) +pprCoAxBranchHdr ax index = pprCoAxBranch ax (coAxiomNthBranch ax index) + +ppr_co_ax_branch :: (TyCon -> Type -> SDoc) -> CoAxiom br -> CoAxBranch -> SDoc +ppr_co_ax_branch ppr_rhs + (CoAxiom { co_ax_tc = fam_tc, co_ax_name = name }) + (CoAxBranch { cab_tvs = tvs + , cab_lhs = lhs + , cab_rhs = rhs + , cab_loc = loc }) + = foldr1 (flip hangNotEmpty 2) + [ pprUserForAll tvs + , pprTypeApp fam_tc lhs <+> equals <+> ppr_rhs fam_tc rhs + , text "-- Defined" <+> pprLoc loc ] where - ppr_loc loc + pprLoc loc | isGoodSrcSpan loc - = ptext (sLit "at") <+> ppr (srcSpanStart loc) + = text "at" <+> ppr (srcSpanStart loc) | otherwise - = ptext (sLit "in") <+> + = text "in" <+> quotes (ppr (nameModule name)) {- diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs index e09c9377b6..574e15367e 100644 --- a/compiler/types/TypeRep.hs +++ b/compiler/types/TypeRep.hs @@ -39,6 +39,7 @@ module TypeRep ( pprKind, pprParendKind, pprTyLit, suppressKinds, TyPrec(..), maybeParen, pprTcApp, pprPrefixApp, pprArrowChain, ppr_type, + pprDataCons, -- Free variables tyVarsOfType, tyVarsOfTypes, closeOverKinds, varSetElemsKvsFirst, @@ -59,7 +60,7 @@ module TypeRep ( #include "HsVersions.h" -import {-# SOURCE #-} DataCon( dataConTyCon ) +import {-# SOURCE #-} DataCon( DataCon, dataConTyCon, dataConFullSig ) import {-# SOURCE #-} ConLike ( ConLike(..) ) import {-# SOURCE #-} Type( isPredTy ) -- Transitively pulls in a LOT of stuff, better to break the loop @@ -77,6 +78,7 @@ import CoAxiom import PrelNames import Outputable import FastString +import ListSetOps import Util import DynFlags import StaticFlags( opt_PprStyle_Debug ) @@ -693,6 +695,20 @@ remember to parenthesise the operator, thus See Trac #2766. -} +pprDataCons :: TyCon -> SDoc +pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons + where + sepWithVBars [] = empty + sepWithVBars docs = sep (punctuate (space <> vbar) docs) + +pprDataConWithArgs :: DataCon -> SDoc +pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc] + where + (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc + forAllDoc = pprUserForAll ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) + thetaDoc = pprThetaArrowTy theta + argsDoc = hsep (fmap pprParendType arg_tys) + pprTypeApp :: TyCon -> [Type] -> SDoc pprTypeApp tc tys = pprTyTcApp TopPrec tc tys -- We have to use ppr on the TyCon (not its name) diff --git a/compiler/utils/BooleanFormula.hs b/compiler/utils/BooleanFormula.hs index 41ac13963e..382431e549 100644 --- a/compiler/utils/BooleanFormula.hs +++ b/compiler/utils/BooleanFormula.hs @@ -193,7 +193,7 @@ pprBooleanFormula :: (Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> pprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr where pprAnd p = cparen (p > 3) . fsep . punctuate comma - pprOr p = cparen (p > 2) . fsep . intersperse (text "|") + pprOr p = cparen (p > 2) . fsep . intersperse vbar -- Pretty print human in readable format, "either `a' or `b' or (`c', `d' and `e')"? pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 83febd5d04..fbd6760923 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -25,7 +25,7 @@ module Outputable ( int, intWithCommas, integer, float, double, rational, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, paBrackets, - semi, comma, colon, dcolon, space, equals, dot, + semi, comma, colon, dcolon, space, equals, dot, vbar, arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt, lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore, blankLine, forAllLit, @@ -33,7 +33,7 @@ module Outputable ( ($$), ($+$), vcat, sep, cat, fsep, fcat, - hang, punctuate, ppWhen, ppUnless, + hang, hangNotEmpty, punctuate, ppWhen, ppUnless, speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, coloured, PprColour, colType, colCoerc, colDataCon, @@ -521,7 +521,7 @@ quotes d = ('\'' : _, _) -> pp_d _other -> Pretty.quotes pp_d -semi, comma, colon, equals, space, dcolon, underscore, dot :: SDoc +semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc @@ -541,6 +541,7 @@ equals = docToSDoc $ Pretty.equals space = docToSDoc $ Pretty.space underscore = char '_' dot = char '.' +vbar = char '|' lparen = docToSDoc $ Pretty.lparen rparen = docToSDoc $ Pretty.rparen lbrack = docToSDoc $ Pretty.lbrack @@ -606,6 +607,12 @@ hang :: SDoc -- ^ The header -> SDoc hang d1 n d2 = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty) +-- | This behaves like 'hang', but does not indent the second document +-- when the header is empty. +hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc +hangNotEmpty d1 n d2 = + SDoc $ \sty -> Pretty.hangNotEmpty (runSDoc d1 sty) n (runSDoc d2 sty) + punctuate :: SDoc -- ^ The punctuation -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements -> [SDoc] -- ^ Punctuated list diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 4aae2c8c53..74d69f23d0 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -180,7 +180,7 @@ module Pretty ( sep, cat, fsep, fcat, nest, - hang, punctuate, + hang, hangNotEmpty, punctuate, -- * Predicates on documents isEmpty, @@ -563,6 +563,12 @@ nest k p = mkNest k (reduceDoc p) hang :: Doc -> Int -> Doc -> Doc hang d1 n d2 = sep [d1, nest n d2] +-- | Apply 'hang' to the arguments if the first 'Doc' is not empty. +hangNotEmpty :: Doc -> Int -> Doc -> Doc +hangNotEmpty d1 n d2 = if isEmpty d1 + then d2 + else hang d1 n d2 + -- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@ punctuate :: Doc -> [Doc] -> [Doc] punctuate _ [] = [] diff --git a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr index d1ebe58007..ff97c50957 100644 --- a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr +++ b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr @@ -1,62 +1,63 @@ <interactive>:10:15: error: Type family equations violate injectivity annotation: - F Char Bool Int = Int - F Bool Int Char = Int + F Char Bool Int = Int -- Defined at <interactive>:10:15 + F Bool Int Char = Int -- Defined at <interactive>:11:15 <interactive>:16:15: error: Type family equations violate injectivity annotation: - I Int Char Bool = Bool - I Int Int Int = Bool + I Int Char Bool = Bool -- Defined at <interactive>:16:15 + I Int Int Int = Bool -- Defined at <interactive>:17:15 <interactive>:26:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - IdProxy a = Id a + IdProxy a = Id a -- Defined at <interactive>:26:15 <interactive>:34:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘'Z’ - P 'Z m = m + P 'Z m = m -- Defined at <interactive>:34:15 <interactive>:40:15: error: Type family equation violates injectivity annotation. Type variable ‘b’ cannot be inferred from the right-hand side. In the type family equation: - J Int b c = Char + J Int b c = Char -- Defined at <interactive>:40:15 <interactive>:44:15: error: Type family equation violates injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - K ('S n) m = 'S m + K ('S n) m = 'S m -- Defined at <interactive>:44:15 <interactive>:49:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - L a = MaybeSyn a + L a = MaybeSyn a -- Defined at <interactive>:49:15 <interactive>:55:41: error: Type family equation violates injectivity annotation. Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - PolyKindVarsF '[] = '[] + PolyKindVarsF '[] = '[] -- Defined at <interactive>:55:41 <interactive>:60:15: error: Type family equation violates injectivity annotation. Kind variable ‘k1’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - PolyKindVars '[] = '[] + PolyKindVars '[] = '[] -- Defined at <interactive>:60:15 <interactive>:64:15: error: Type family equation violates injectivity annotation. Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (a :: k) (b :: k). Fc a b = Int + forall (k :: BOX) (a :: k) (b :: k). + Fc a b = Int -- Defined at <interactive>:64:15 <interactive>:68:15: error: Type family equation violates injectivity annotation. @@ -64,52 +65,53 @@ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (a :: k) (b :: k). Gc a b = Int + forall (k :: BOX) (a :: k) (b :: k). + Gc a b = Int -- Defined at <interactive>:68:15 <interactive>:81:15: error: Type family equations violate injectivity annotation: - F1 [a] = Maybe (GF1 a) - F1 (Maybe a) = Maybe (GF2 a) + F1 [a] = Maybe (GF1 a) -- Defined at <interactive>:81:15 + F1 (Maybe a) = Maybe (GF2 a) -- Defined at <interactive>:82:15 <interactive>:85:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘[a]’ - W1 [a] = a + W1 [a] = a -- Defined at <interactive>:85:15 <interactive>:88:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - W2 [a] = W2 a + W2 [a] = W2 a -- Defined at <interactive>:88:15 <interactive>:92:15: error: Type family equations violate injectivity annotation: - Z1 [a] = (a, a) - Z1 (Maybe b) = (b, [b]) + Z1 [a] = (a, a) -- Defined at <interactive>:92:15 + Z1 (Maybe b) = (b, [b]) -- Defined at <interactive>:93:15 <interactive>:96:15: error: Type family equations violate injectivity annotation: - G1 [a] = [a] - G1 (Maybe b) = [(b, b)] + G1 [a] = [a] -- Defined at <interactive>:96:15 + G1 (Maybe b) = [(b, b)] -- Defined at <interactive>:97:15 <interactive>:100:15: error: Type family equations violate injectivity annotation: - G3 a Int = (a, Int) - G3 a Bool = (Bool, a) + G3 a Int = (a, Int) -- Defined at <interactive>:100:15 + G3 a Bool = (Bool, a) -- Defined at <interactive>:101:15 <interactive>:104:15: error: Type family equation violates injectivity annotation. Type variable ‘b’ cannot be inferred from the right-hand side. In the type family equation: - G4 a b = [a] + G4 a b = [a] -- Defined at <interactive>:104:15 <interactive>:107:15: error: Type family equations violate injectivity annotation: - G5 [a] = [GF1 a] - G5 Int = [Bool] + G5 [a] = [GF1 a] -- Defined at <interactive>:107:15 + G5 Int = [Bool] -- Defined at <interactive>:108:15 <interactive>:111:15: error: Type family equation violates injectivity annotation. Type variable ‘a’ cannot be inferred from the right-hand side. In the type family equation: - G6 [a] = [HF1 a] + G6 [a] = [HF1 a] -- Defined at <interactive>:111:15 diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr index 0c31399360..d47accbe20 100644 --- a/testsuite/tests/indexed-types/should_compile/T3017.stderr +++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr @@ -11,7 +11,8 @@ TYPE CONSTRUCTORS data ListColl a = L [a] Promotable COERCION AXIOMS - axiom Foo.TFCo:R:ElemListColl :: Elem (ListColl a) = a + axiom Foo.TFCo:R:ElemListColl :: + Elem (ListColl a) = a -- Defined at T3017.hs:13:9 INSTANCES instance Coll (ListColl a) -- Defined at T3017.hs:12:11 FAMILY INSTANCES diff --git a/testsuite/tests/indexed-types/should_compile/T9085.stderr b/testsuite/tests/indexed-types/should_compile/T9085.stderr index 8a4ebdbb7a..79ecd91e28 100644 --- a/testsuite/tests/indexed-types/should_compile/T9085.stderr +++ b/testsuite/tests/indexed-types/should_compile/T9085.stderr @@ -1,4 +1,4 @@ T9085.hs:7:3: Warning: Type family instance equation is overlapped: - F Bool = Bool + F Bool = Bool -- Defined at T9085.hs:7:3 diff --git a/testsuite/tests/indexed-types/should_fail/NoGood.stderr b/testsuite/tests/indexed-types/should_fail/NoGood.stderr index bfb5814f8d..c4adb9ae9d 100644 --- a/testsuite/tests/indexed-types/should_fail/NoGood.stderr +++ b/testsuite/tests/indexed-types/should_fail/NoGood.stderr @@ -1,5 +1,5 @@ NoGood.hs:4:15: Conflicting family instance declarations: - F a a -- Defined at NoGood.hs:4:15 - F [a] a -- Defined at NoGood.hs:5:15 + F a a = Int -- Defined at NoGood.hs:4:15 + F [a] a = Bool -- Defined at NoGood.hs:5:15 diff --git a/testsuite/tests/indexed-types/should_fail/Over.stderr b/testsuite/tests/indexed-types/should_fail/Over.stderr index 3eef32231b..180bb954ef 100644 --- a/testsuite/tests/indexed-types/should_fail/Over.stderr +++ b/testsuite/tests/indexed-types/should_fail/Over.stderr @@ -1,10 +1,10 @@ OverB.hs:7:15:
Conflicting family instance declarations:
- OverA.C [Int] [a] -- Defined at OverB.hs:7:15
- OverA.C [a] [Int] -- Defined at OverC.hs:7:15
+ OverA.C [Int] [a] = CListList2 -- Defined at OverB.hs:7:15
+ OverA.C [a] [Int] = C9ListList -- Defined at OverC.hs:7:15
OverB.hs:9:15:
Conflicting family instance declarations:
- OverA.D [Int] [a] -- Defined at OverB.hs:9:15
- OverA.D [a] [Int] -- Defined at OverC.hs:9:15
+ OverA.D [Int] [a] = Int -- Defined at OverB.hs:9:15
+ OverA.D [a] [Int] = Char -- Defined at OverC.hs:9:15
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr index 2e6b9570ed..d467019760 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr @@ -1,10 +1,10 @@ SimpleFail11a.hs:6:15: Conflicting family instance declarations: - C9 Int Int -- Defined at SimpleFail11a.hs:6:15 - C9 Int Int -- Defined at SimpleFail11a.hs:8:15 + C9 Int Int = C9IntInt -- Defined at SimpleFail11a.hs:6:15 + C9 Int Int = C9IntInt2 -- Defined at SimpleFail11a.hs:8:15 SimpleFail11a.hs:11:15: Conflicting family instance declarations: - D9 Int Int -- Defined at SimpleFail11a.hs:11:15 - D9 Int Int -- Defined at SimpleFail11a.hs:13:15 + D9 Int Int = Char -- Defined at SimpleFail11a.hs:11:15 + D9 Int Int = Int -- Defined at SimpleFail11a.hs:13:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr index 6994b9bcd9..e40a3a6b4e 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr @@ -1,10 +1,10 @@ SimpleFail11b.hs:7:15: Conflicting family instance declarations: - C9 [a] Int -- Defined at SimpleFail11b.hs:7:15 - C9 [a] Int -- Defined at SimpleFail11b.hs:9:15 + C9 [a] Int = C9ListInt -- Defined at SimpleFail11b.hs:7:15 + C9 [a] Int = C9ListInt2 -- Defined at SimpleFail11b.hs:9:15 SimpleFail11b.hs:13:15: Conflicting family instance declarations: - D9 [a] Int -- Defined at SimpleFail11b.hs:13:15 - D9 [a] Int -- Defined at SimpleFail11b.hs:15:15 + D9 [a] Int = [a] -- Defined at SimpleFail11b.hs:13:15 + D9 [a] Int = Maybe a -- Defined at SimpleFail11b.hs:15:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr index a323efa250..d4a1bb4f30 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr @@ -1,10 +1,10 @@ SimpleFail11c.hs:7:15: Conflicting family instance declarations: - C9 [a] Int -- Defined at SimpleFail11c.hs:7:15 - C9 [Int] Int -- Defined at SimpleFail11c.hs:9:15 + C9 [a] Int = C9ListInt -- Defined at SimpleFail11c.hs:7:15 + C9 [Int] Int = C9ListInt2 -- Defined at SimpleFail11c.hs:9:15 SimpleFail11c.hs:13:15: Conflicting family instance declarations: - D9 [a] Int -- Defined at SimpleFail11c.hs:13:15 - D9 [Int] Int -- Defined at SimpleFail11c.hs:15:15 + D9 [a] Int = [a] -- Defined at SimpleFail11c.hs:13:15 + D9 [Int] Int = [Bool] -- Defined at SimpleFail11c.hs:15:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr index 72a9f79453..cdd8afda96 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr @@ -1,5 +1,5 @@ SimpleFail11d.hs:8:15: Conflicting family instance declarations: - C9 [Int] [a] -- Defined at SimpleFail11d.hs:8:15 - C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15 + C9 [Int] [a] = C9ListList2 -- Defined at SimpleFail11d.hs:8:15 + C9 [a] [Int] = C9ListList -- Defined at SimpleFail11d.hs:10:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr index 1b63dfe3f5..bb0aaca16c 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr @@ -1,5 +1,5 @@ SimpleFail2b.hs:9:11: Conflicting family instance declarations: - Sd Int -- Defined at SimpleFail2b.hs:9:11 - Sd Int -- Defined at SimpleFail2b.hs:10:11 + Sd Int = SdC1 Char -- Defined at SimpleFail2b.hs:9:11 + Sd Int = SdC2 Char -- Defined at SimpleFail2b.hs:10:11 diff --git a/testsuite/tests/indexed-types/should_fail/T2334A.stderr b/testsuite/tests/indexed-types/should_fail/T2334A.stderr index 6b4197bfb4..7b7d265d61 100644 --- a/testsuite/tests/indexed-types/should_fail/T2334A.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2334A.stderr @@ -13,5 +13,5 @@ T2334A.hs:10:27: T2334A.hs:12:15: Conflicting family instance declarations: - F Bool -- Defined at T2334A.hs:12:15 - F Bool -- Defined at T2334A.hs:13:15 + F Bool = K1 -- Defined at T2334A.hs:12:15 + F Bool = K2 -- Defined at T2334A.hs:13:15 diff --git a/testsuite/tests/indexed-types/should_fail/T2677.stderr b/testsuite/tests/indexed-types/should_fail/T2677.stderr index fcc6f8aaf9..1f08b366b1 100644 --- a/testsuite/tests/indexed-types/should_fail/T2677.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2677.stderr @@ -1,5 +1,5 @@ T2677.hs:6:15: Conflicting family instance declarations: - A a -- Defined at T2677.hs:6:15 - A Int -- Defined at T2677.hs:7:15 + A a = Bool -- Defined at T2677.hs:6:15 + A Int = Char -- Defined at T2677.hs:7:15 diff --git a/testsuite/tests/indexed-types/should_fail/T3330b.stderr b/testsuite/tests/indexed-types/should_fail/T3330b.stderr index 5f06978d1c..faa5d1a1a7 100644 --- a/testsuite/tests/indexed-types/should_fail/T3330b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T3330b.stderr @@ -1,5 +1,5 @@ T3330b.hs:14:10: Conflicting family instance declarations: - Res c a b -- Defined at T3330b.hs:14:10 - Res [c] a b -- Defined at T3330b.hs:18:10 + Res c a b = b -- Defined at T3330b.hs:14:10 + Res [c] a b = [b] -- Defined at T3330b.hs:18:10 diff --git a/testsuite/tests/indexed-types/should_fail/T4246.stderr b/testsuite/tests/indexed-types/should_fail/T4246.stderr index 26e967a672..b653f9a052 100644 --- a/testsuite/tests/indexed-types/should_fail/T4246.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4246.stderr @@ -1,10 +1,10 @@ T4246.hs:8:9: Conflicting family instance declarations: - F a -- Defined at T4246.hs:8:9 - F Int -- Defined at T4246.hs:11:9 + F a = a -- Defined at T4246.hs:8:9 + F Int = Bool -- Defined at T4246.hs:11:9 T4246.hs:14:15: Conflicting family instance declarations: - G Int -- Defined at T4246.hs:14:15 - G Int -- Defined at T4246.hs:15:15 + G Int = Int -- Defined at T4246.hs:14:15 + G Int = Bool -- Defined at T4246.hs:15:15 diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr index 695a7b4142..729ee3a8c0 100644 --- a/testsuite/tests/indexed-types/should_fail/T9371.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr @@ -1,5 +1,5 @@ T9371.hs:14:10: Conflicting family instance declarations: - D -- Defined at T9371.hs:14:10 - D (x, y) -- Defined at T9371.hs:18:10 + D = D1 (Either x ()) -- Defined at T9371.hs:14:10 + D (x, y) = D2 (x, y) -- Defined at T9371.hs:18:10 diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr index dd1de7ed3b..ec41b123f1 100644 --- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr @@ -6,7 +6,8 @@ TYPE CONSTRUCTORS data family Sing (a :: k) COERCION AXIOMS axiom DataFamilyInstanceLHS.TFCo:R:SingMyKind_ :: - Sing = DataFamilyInstanceLHS.R:SingMyKind_ + Sing = DataFamilyInstanceLHS.R:SingMyKind_ + -- Defined at DataFamilyInstanceLHS.hs:8:15 FAMILY INSTANCES data instance Sing Dependent modules: [] diff --git a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr index 44f05a7a68..ebd327c98f 100644 --- a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr @@ -3,8 +3,10 @@ TYPE SIGNATURES TYPE CONSTRUCTORS type family F a b :: * open COERCION AXIOMS - axiom TypeFamilyInstanceLHS.TFCo:R:FBool_ :: F Bool _ = Bool - axiom TypeFamilyInstanceLHS.TFCo:R:FInt_ :: F Int _ = Int + axiom TypeFamilyInstanceLHS.TFCo:R:FBool_ :: + F Bool _ = Bool -- Defined at TypeFamilyInstanceLHS.hs:6:15 + axiom TypeFamilyInstanceLHS.TFCo:R:FInt_ :: + F Int _ = Int -- Defined at TypeFamilyInstanceLHS.hs:5:15 FAMILY INSTANCES type instance F Int _ type instance F Bool _ diff --git a/testsuite/tests/polykinds/T7524.stderr b/testsuite/tests/polykinds/T7524.stderr index 3a38ed4d33..83b355e312 100644 --- a/testsuite/tests/polykinds/T7524.stderr +++ b/testsuite/tests/polykinds/T7524.stderr @@ -1,5 +1,6 @@ T7524.hs:5:15:
Conflicting family instance declarations:
- F a a -- Defined at T7524.hs:5:15
- F a b -- Defined at T7524.hs:6:15
+ forall (k :: BOX) (a :: k). F a a = Int -- Defined at T7524.hs:5:15
+ forall (k :: BOX) (k1 :: BOX) (a :: k) (b :: k1).
+ F a b = Bool -- Defined at T7524.hs:6:15
diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index ca1f817d15..08e3b8c504 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -5,7 +5,7 @@ TYPE CONSTRUCTORS meth2 :: a -> a {-# MINIMAL meth2 #-} COERCION AXIOMS - axiom Roles12.NTCo:C2 :: C2 a = a -> a + axiom Roles12.NTCo:C2 :: C2 a = a -> a -- Defined at Roles14.hs:6:1 Dependent modules: [] Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, integer-gmp-1.0.0.0] diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index b44929979d..f09760224a 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -17,10 +17,13 @@ TYPE CONSTRUCTORS type Syn1 a = F4 a type Syn2 a = [a] COERCION AXIOMS - axiom Roles3.NTCo:C1 :: C1 a = a -> a - axiom Roles3.NTCo:C2 :: C2 a b = (a ~ b) => a -> b - axiom Roles3.NTCo:C3 :: C3 a b = a -> F3 b -> F3 b - axiom Roles3.NTCo:C4 :: C4 a b = a -> F4 b -> F4 b + axiom Roles3.NTCo:C1 :: C1 a = a -> a -- Defined at Roles3.hs:6:1 + axiom Roles3.NTCo:C2 :: + C2 a b = (a ~ b) => a -> b -- Defined at Roles3.hs:9:1 + axiom Roles3.NTCo:C3 :: + C3 a b = a -> F3 b -> F3 b -- Defined at Roles3.hs:12:1 + axiom Roles3.NTCo:C4 :: + C4 a b = a -> F4 b -> F4 b -- Defined at Roles3.hs:18:1 Dependent modules: [] Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, integer-gmp-1.0.0.0] diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index bcc1f44460..67b75cde86 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -8,8 +8,9 @@ TYPE CONSTRUCTORS {-# MINIMAL meth3 #-} type Syn1 a = [a] COERCION AXIOMS - axiom Roles4.NTCo:C1 :: C1 a = a -> a - axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a + axiom Roles4.NTCo:C1 :: C1 a = a -> a -- Defined at Roles4.hs:6:1 + axiom Roles4.NTCo:C3 :: + C3 a = a -> Syn1 a -- Defined at Roles4.hs:11:1 Dependent modules: [] Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, integer-gmp-1.0.0.0] diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index 7d59803880..efb7488564 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -10,7 +10,8 @@ TYPE CONSTRUCTORS type role Representational representational class Representational a COERCION AXIOMS - axiom T8958.NTCo:Map :: Map k v = [(k, v)] + axiom T8958.NTCo:Map :: + Map k v = [(k, v)] -- Defined at T8958.hs:13:1 INSTANCES instance [incoherent] Nominal a -- Defined at T8958.hs:7:10 instance [incoherent] Representational a diff --git a/testsuite/tests/th/T6018th.stderr b/testsuite/tests/th/T6018th.stderr index 4579ea54c3..7193fb5948 100644 --- a/testsuite/tests/th/T6018th.stderr +++ b/testsuite/tests/th/T6018th.stderr @@ -1,5 +1,5 @@ T6018th.hs:97:4: Type family equations violate injectivity annotation: - H Int Int Int = Bool - H Int Char Bool = Bool + H Int Int Int = Bool -- Defined at T6018th.hs:97:4 + H Int Char Bool = Bool -- Defined at T6018th.hs:97:4 diff --git a/testsuite/tests/typecheck/should_compile/T6018.stderr b/testsuite/tests/typecheck/should_compile/T6018.stderr index 41e94d8670..b843f5f53d 100644 --- a/testsuite/tests/typecheck/should_compile/T6018.stderr +++ b/testsuite/tests/typecheck/should_compile/T6018.stderr @@ -4,8 +4,8 @@ T6018.hs:75:5: Warning: Type family instance equation is overlapped: - Foo Bool = Bool + Foo Bool = Bool -- Defined at T6018.hs:75:5 T6018.hs:82:5: Warning: Type family instance equation is overlapped: - Bar Bool = Char + Bar Bool = Char -- Defined at T6018.hs:82:5 diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr index b71342335b..2377c13a0f 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.stderr +++ b/testsuite/tests/typecheck/should_compile/tc231.stderr @@ -14,7 +14,8 @@ TYPE CONSTRUCTORS {-# MINIMAL huh #-} COERCION AXIOMS axiom NTCo:Zork :: - Zork s a b = forall chain. Q s a chain -> ST s () + Zork s a b = forall chain. Q s a chain -> ST s () + -- Defined at tc231.hs:25:1 Dependent modules: [] Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0, integer-gmp-1.0.0.0] diff --git a/testsuite/tests/typecheck/should_compile/tc265.stderr b/testsuite/tests/typecheck/should_compile/tc265.stderr index 64099721b8..24aeed0392 100644 --- a/testsuite/tests/typecheck/should_compile/tc265.stderr +++ b/testsuite/tests/typecheck/should_compile/tc265.stderr @@ -1,4 +1,4 @@ tc265.hs:8:3: warning: Type family instance equation is overlapped: - F (T Int) = Bool + F (T Int) = Bool -- Defined at tc265.hs:8:3 diff --git a/testsuite/tests/typecheck/should_fail/T10836.stderr b/testsuite/tests/typecheck/should_fail/T10836.stderr index b96d3714e2..2e92e6135a 100644 --- a/testsuite/tests/typecheck/should_fail/T10836.stderr +++ b/testsuite/tests/typecheck/should_fail/T10836.stderr @@ -1,14 +1,14 @@ T10836.hs:5:5: error: Type family equations violate injectivity annotation: - Foo Int = Int - Foo Bool = Int + Foo Int = Int -- Defined at T10836.hs:5:5 + Foo Bool = Int -- Defined at T10836.hs:6:5 In the equations for closed type family ‘Foo’ In the type family declaration for ‘Foo’ T10836.hs:9:5: error: Type family equations violate injectivity annotation: - Bar Int = Int - Bar Bool = Int + Bar Int = Int -- Defined at T10836.hs:9:5 + Bar Bool = Int -- Defined at T10836.hs:10:5 In the equations for closed type family ‘Bar’ In the type family declaration for ‘Bar’ diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr index a86ad808c8..a0f5439a7d 100644 --- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr @@ -6,77 +6,78 @@ T6018Afail.hs:7:15: error: Type family equations violate injectivity annotation: - G Char Bool Int = Int - G Bool Int Char = Int + G Char Bool Int = Int -- Defined at T6018Afail.hs:7:15 + G Bool Int Char = Int -- Defined at T6018fail.hs:15:15 T6018Dfail.hs:7:15: error: Type family equations violate injectivity annotation: - T6018Bfail.H Bool Int Char = Int - T6018Bfail.H Char Bool Int = Int + T6018Bfail.H Bool Int Char = Int -- Defined at T6018Dfail.hs:7:15 + T6018Bfail.H Char Bool Int = Int -- Defined at T6018Cfail.hs:8:15 T6018fail.hs:13:15: error: Type family equations violate injectivity annotation: - F Bool Int Char = Int - F Char Bool Int = Int + F Bool Int Char = Int -- Defined at T6018fail.hs:13:15 + F Char Bool Int = Int -- Defined at T6018fail.hs:12:15 T6018fail.hs:19:15: error: Type family equations violate injectivity annotation: - I Int Int Int = Bool - I Int Char Bool = Bool + I Int Int Int = Bool -- Defined at T6018fail.hs:19:15 + I Int Char Bool = Bool -- Defined at T6018fail.hs:18:15 T6018fail.hs:28:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - IdProxy a = Id a + IdProxy a = Id a -- Defined at T6018fail.hs:28:15 T6018fail.hs:36:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘'Z’ - P 'Z m = m + P 'Z m = m -- Defined at T6018fail.hs:36:15 T6018fail.hs:37:15: error: Type family equations violate injectivity annotation: - P ('S n) m = 'S (P n m) - P 'Z m = m + P ('S n) m = 'S (P n m) -- Defined at T6018fail.hs:37:15 + P 'Z m = m -- Defined at T6018fail.hs:36:15 T6018fail.hs:42:15: error: Type family equation violates injectivity annotation. Type variable ‘b’ cannot be inferred from the right-hand side. In the type family equation: - J Int b c = Char + J Int b c = Char -- Defined at T6018fail.hs:42:15 T6018fail.hs:46:15: error: Type family equation violates injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - K ('S n) m = 'S m + K ('S n) m = 'S m -- Defined at T6018fail.hs:46:15 T6018fail.hs:51:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - L a = MaybeSyn a + L a = MaybeSyn a -- Defined at T6018fail.hs:51:15 T6018fail.hs:59:10: error: Type family equation violates injectivity annotation. Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - PolyKindVarsF '[] = '[] + PolyKindVarsF '[] = '[] -- Defined at T6018fail.hs:59:10 T6018fail.hs:62:15: error: Type family equation violates injectivity annotation. Kind variable ‘k1’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - PolyKindVars '[] = '[] + PolyKindVars '[] = '[] -- Defined at T6018fail.hs:62:15 T6018fail.hs:66:15: error: Type family equation violates injectivity annotation. Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (a :: k) (b :: k). Fc a b = Int + forall (k :: BOX) (a :: k) (b :: k). + Fc a b = Int -- Defined at T6018fail.hs:66:15 T6018fail.hs:70:15: error: Type family equation violates injectivity annotation. @@ -84,55 +85,56 @@ T6018fail.hs:70:15: error: cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (a :: k) (b :: k). Gc a b = Int + forall (k :: BOX) (a :: k) (b :: k). + Gc a b = Int -- Defined at T6018fail.hs:70:15 T6018fail.hs:75:15: error: Type family equations violate injectivity annotation: - F1 (Maybe a) = Maybe (GF2 a) - F1 [a] = Maybe (GF1 a) + F1 (Maybe a) = Maybe (GF2 a) -- Defined at T6018fail.hs:75:15 + F1 [a] = Maybe (GF1 a) -- Defined at T6018fail.hs:74:15 T6018fail.hs:87:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘[a]’ - W1 [a] = a + W1 [a] = a -- Defined at T6018fail.hs:87:15 T6018fail.hs:90:15: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - W2 [a] = W2 a + W2 [a] = W2 a -- Defined at T6018fail.hs:90:15 T6018fail.hs:95:15: error: Type family equations violate injectivity annotation: - Z1 (Maybe b) = (b, [b]) - Z1 [a] = (a, a) + Z1 (Maybe b) = (b, [b]) -- Defined at T6018fail.hs:95:15 + Z1 [a] = (a, a) -- Defined at T6018fail.hs:94:15 T6018fail.hs:99:15: error: Type family equations violate injectivity annotation: - G1 (Maybe b) = [(b, b)] - G1 [a] = [a] + G1 (Maybe b) = [(b, b)] -- Defined at T6018fail.hs:99:15 + G1 [a] = [a] -- Defined at T6018fail.hs:98:15 T6018fail.hs:103:15: error: Type family equations violate injectivity annotation: - G3 a Bool = (Bool, a) - G3 a Int = (a, Int) + G3 a Bool = (Bool, a) -- Defined at T6018fail.hs:103:15 + G3 a Int = (a, Int) -- Defined at T6018fail.hs:102:15 T6018fail.hs:106:15: error: Type family equation violates injectivity annotation. Type variable ‘b’ cannot be inferred from the right-hand side. In the type family equation: - G4 a b = [a] + G4 a b = [a] -- Defined at T6018fail.hs:106:15 T6018fail.hs:110:15: error: Type family equations violate injectivity annotation: - G5 Int = [Bool] - G5 [a] = [GF1 a] + G5 Int = [Bool] -- Defined at T6018fail.hs:110:15 + G5 [a] = [GF1 a] -- Defined at T6018fail.hs:109:15 T6018fail.hs:113:15: error: Type family equation violates injectivity annotation. Type variable ‘a’ cannot be inferred from the right-hand side. In the type family equation: - G6 [a] = [HF1 a] + G6 [a] = [HF1 a] -- Defined at T6018fail.hs:113:15 T6018fail.hs:118:15: error: Type family equation violates injectivity annotation. @@ -140,15 +142,16 @@ T6018fail.hs:118:15: error: cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) a b (c :: k). G7 a b c = [G7a a b c] + forall (k :: BOX) a b (c :: k). + G7 a b c = [G7a a b c] -- Defined at T6018fail.hs:118:15 T6018fail.hs:129:1: error: Type family equations violate injectivity annotation: - FC Int Bool = Bool - FC Int Char = Bool + FC Int Bool = Bool -- Defined at T6018fail.hs:129:1 + FC Int Char = Bool -- Defined at T6018fail.hs:125:10 T6018fail.hs:134:1: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘*’, ‘Char’ - FC Char a = a + FC Char a = a -- Defined at T6018fail.hs:134:1 diff --git a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr index 674440046e..2afafbe4cd 100644 --- a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr @@ -2,7 +2,7 @@ T6018failclosed.hs:11:5: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - IdProxyClosed a = IdClosed a + IdProxyClosed a = IdClosed a -- Defined at T6018failclosed.hs:11:5 In the equations for closed type family ‘IdProxyClosed’ In the type family declaration for ‘IdProxyClosed’ @@ -10,14 +10,15 @@ T6018failclosed.hs:19:5: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘'Z’ - PClosed 'Z m = m + PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 In the equations for closed type family ‘PClosed’ In the type family declaration for ‘PClosed’ T6018failclosed.hs:19:5: error: Type family equations violate injectivity annotation: - PClosed 'Z m = m + PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 PClosed ('S n) m = 'S (PClosed n m) + -- Defined at T6018failclosed.hs:20:5 In the equations for closed type family ‘PClosed’ In the type family declaration for ‘PClosed’ @@ -27,8 +28,8 @@ T6018failclosed.hs:25:5: error: cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (k1 :: BOX) (b :: k) (c :: k1). - JClosed Int b c = Char + forall (k :: BOX) (k1 :: BOX) (b :: k) (c :: k1). + JClosed Int b c = Char -- Defined at T6018failclosed.hs:25:5 In the equations for closed type family ‘JClosed’ In the type family declaration for ‘JClosed’ @@ -36,28 +37,29 @@ T6018failclosed.hs:30:5: error: Type family equation violates injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - KClosed ('S n) m = 'S m + KClosed ('S n) m = 'S m -- Defined at T6018failclosed.hs:30:5 In the equations for closed type family ‘KClosed’ In the type family declaration for ‘KClosed’ T6018failclosed.hs:35:5: error: Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: - forall (k :: BOX) (a :: k). LClosed a = MaybeSynClosed a + forall (k :: BOX) (a :: k). + LClosed a = MaybeSynClosed a -- Defined at T6018failclosed.hs:35:5 In the equations for closed type family ‘LClosed’ In the type family declaration for ‘LClosed’ T6018failclosed.hs:39:5: error: Type family equations violate injectivity annotation: - FClosed Char Bool Int = Int - FClosed Bool Int Char = Int + FClosed Char Bool Int = Int -- Defined at T6018failclosed.hs:39:5 + FClosed Bool Int Char = Int -- Defined at T6018failclosed.hs:40:5 In the equations for closed type family ‘FClosed’ In the type family declaration for ‘FClosed’ T6018failclosed.hs:43:5: error: Type family equations violate injectivity annotation: - IClosed Int Char Bool = Bool - IClosed Int Int Int = Bool + IClosed Int Char Bool = Bool -- Defined at T6018failclosed.hs:43:5 + IClosed Int Int Int = Bool -- Defined at T6018failclosed.hs:44:5 In the equations for closed type family ‘IClosed’ In the type family declaration for ‘IClosed’ @@ -65,14 +67,14 @@ T6018failclosed.hs:50:3: error: Type family equation violates injectivity annotation. Type variable ‘a’ cannot be inferred from the right-hand side. In the type family equation: - E2 a = 'False + E2 a = 'False -- Defined at T6018failclosed.hs:50:3 In the equations for closed type family ‘E2’ In the type family declaration for ‘E2’ T6018failclosed.hs:61:3: error: Type family equations violate injectivity annotation: - F a IO = IO a - F Char b = b Int + F a IO = IO a -- Defined at T6018failclosed.hs:61:3 + F Char b = b Int -- Defined at T6018failclosed.hs:62:3 In the equations for closed type family ‘F’ In the type family declaration for ‘F’ @@ -81,6 +83,7 @@ T6018failclosed.hs:66:5: error: Kind variable ‘k’ cannot be inferred from the right-hand side. (enabling -fprint-explicit-kinds might help) In the type family equation: - forall (k :: BOX) (a :: k) (b :: k). Gc a b = Int + forall (k :: BOX) (a :: k) (b :: k). + Gc a b = Int -- Defined at T6018failclosed.hs:66:5 In the equations for closed type family ‘Gc’ In the type family declaration for ‘Gc’ |