diff options
43 files changed, 191 insertions, 128 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index b67e6628ee..90a043de76 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -700,13 +700,68 @@ data TyPrec -- See Note [Precedence in types] in TyCoRep.hs | FunPrec -- Function args; no parens for tycon apps | TyOpPrec -- Infix operator | TyConPrec -- Tycon args; no parens for atomic - deriving( Eq, Ord ) + +instance Eq TyPrec where + (==) a b = case compare a b of + EQ -> True + _ -> False + +instance Ord TyPrec where + compare TopPrec TopPrec = EQ + compare TopPrec _ = LT + + compare FunPrec TopPrec = GT + compare FunPrec FunPrec = EQ + compare FunPrec TyOpPrec = EQ -- See Note [Type operator precedence] + compare FunPrec TyConPrec = LT + + compare TyOpPrec TopPrec = GT + compare TyOpPrec FunPrec = EQ -- See Note [Type operator precedence] + compare TyOpPrec TyOpPrec = EQ + compare TyOpPrec TyConPrec = LT + + compare TyConPrec TyConPrec = EQ + compare TyConPrec _ = GT maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc maybeParen ctxt_prec inner_prec pretty | ctxt_prec < inner_prec = pretty | otherwise = parens pretty +{- Note [Precedence in types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Many pretty-printing functions have type + ppr_ty :: TyPrec -> Type -> SDoc + +The TyPrec gives the binding strength of the context. For example, in + T ty1 ty2 +we will pretty-print 'ty1' and 'ty2' with the call + (ppr_ty TyConPrec ty) +to indicate that the context is that of an argument of a TyConApp. + +We use this consistently for Type and HsType. + +Note [Type operator precedence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't keep the fixity of type operators in the operator. So the +pretty printer follows the following precedence order: + + TyConPrec Type constructor application + TyOpPrec/FunPrec Operator application and function arrow + +We have FunPrec and TyOpPrec to represent the precedence of function +arrow and type operators respectively, but currently we implement +FunPred == TyOpPrec, so that we don't distinguish the two. Reason: +it's hard to parse a type like + a ~ b => c * d -> e - f + +By treating TyOpPrec = FunPrec we end up with more parens + (a ~ b) => (c * d) -> (e - f) + +But the two are different constructors of TyPrec so we could make +(->) bind more or less tightly if we wanted. +-} + {- ************************************************************************ * * diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 8ea6b0b3a0..2144a28597 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -1286,7 +1286,7 @@ ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty TopPrec ty) ppr_mono_ty _ (HsPArrTy ty) = paBrackets (ppr_mono_lty TopPrec ty) ppr_mono_ty prec (HsIParamTy n ty) = maybeParen prec FunPrec (ppr n <+> dcolon <+> ppr_mono_lty TopPrec ty) ppr_mono_ty _ (HsSpliceTy s _) = pprSplice s -ppr_mono_ty _ (HsCoreTy ty) = ppr ty +ppr_mono_ty prec (HsCoreTy ty) = pprPrecType prec ty ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) = quote $ brackets (interpp'SP tys) ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) @@ -1300,7 +1300,7 @@ ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) ppr_mono_lty TyOpPrec ty1 <+> char '~' <+> ppr_mono_lty TyOpPrec ty2 ppr_mono_ty _ctxt_prec (HsAppsTy tys) - = hsep (map (ppr_app_ty TopPrec . unLoc) tys) + = hsep (map (ppr_app_ty TyConPrec . unLoc) tys) ppr_mono_ty _ctxt_prec (HsAppTy fun_ty arg_ty) = hsep [ppr_mono_lty FunPrec fun_ty, ppr_mono_lty TyConPrec arg_ty] diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 95d6369d45..39e30283db 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -30,7 +30,7 @@ module IfaceType ( tcArgsIfaceTypes, -- Printing - pprIfaceType, pprParendIfaceType, + pprIfaceType, pprParendIfaceType, pprPrecIfaceType, pprIfaceContext, pprIfaceContextArr, pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders, pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs, @@ -227,6 +227,7 @@ Namely we handle these cases, eqPrimTyCon ~# ~~ eqReprPrimTyCon Coercible Coercible +See Note [The equality types story] in TysPrim. -} data IfaceTyConInfo -- Used to guide pretty-printing @@ -492,15 +493,15 @@ if_print_coercions yes no then yes else no -pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc -pprIfaceInfixApp pp p pp_tc ty1 ty2 - = maybeParen p FunPrec $ - sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2] +pprIfaceInfixApp :: TyPrec -> SDoc -> SDoc -> SDoc -> SDoc +pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2 + = maybeParen ctxt_prec TyOpPrec $ + sep [pp_ty1, pp_tc <+> pp_ty2] pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc -pprIfacePrefixApp p pp_fun pp_tys +pprIfacePrefixApp ctxt_prec pp_fun pp_tys | null pp_tys = pp_fun - | otherwise = maybeParen p TyConPrec $ + | otherwise = maybeParen ctxt_prec TyConPrec $ hang pp_fun 2 (sep pp_tys) -- ----------------------------- Printing binders ------------------------------------ @@ -565,8 +566,11 @@ instance Outputable IfaceType where ppr ty = pprIfaceType ty pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc -pprIfaceType = eliminateRuntimeRep (ppr_ty TopPrec) -pprParendIfaceType = eliminateRuntimeRep (ppr_ty TyConPrec) +pprIfaceType = pprPrecIfaceType TopPrec +pprParendIfaceType = pprPrecIfaceType TyConPrec + +pprPrecIfaceType :: TyPrec -> IfaceType -> SDoc +pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty ppr_ty :: TyPrec -> IfaceType -> SDoc ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceFreeTyVar! @@ -880,8 +884,8 @@ pprTyTcApp' ctxt_prec tc tys dflags style -- Suppress detail unles you _really_ want to see -> text "(TypeError ...)" - | Just doc <- ppr_equality tc (tcArgsIfaceTypes tys) - -> maybeParen ctxt_prec TyConPrec doc + | Just doc <- ppr_equality ctxt_prec tc (tcArgsIfaceTypes tys) + -> doc | otherwise -> ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds @@ -891,9 +895,10 @@ pprTyTcApp' ctxt_prec tc tys dflags style -- | Pretty-print a type-level equality. -- --- See Note [Equality predicates in IfaceType]. -ppr_equality :: IfaceTyCon -> [IfaceType] -> Maybe SDoc -ppr_equality tc args +-- See Note [Equality predicates in IfaceType] +-- and Note [The equality types story] in TysPrim +ppr_equality :: TyPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc +ppr_equality ctxt_prec tc args | hetero_eq_tc , [k1, k2, t1, t2] <- args = Just $ print_equality (k1, k2, t1, t2) @@ -914,11 +919,10 @@ ppr_equality tc args hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#) || tc_name `hasKey` eqReprPrimTyConKey -- (~R#) || tc_name `hasKey` heqTyConKey -- (~~) - print_equality args = - sdocWithDynFlags - $ \dflags -> getPprStyle - $ \style -> print_equality' args style dflags + sdocWithDynFlags $ \dflags -> + getPprStyle $ \style -> + print_equality' args style dflags print_equality' (ki1, ki2, ty1, ty2) style dflags | print_eqs @@ -930,14 +934,15 @@ ppr_equality tc args | otherwise = if tc_name `hasKey` eqReprPrimTyConKey - then text "Coercible" - <+> sep [ pp TyConPrec ty1, pp TyConPrec ty2 ] - else sep [pp TyOpPrec ty1, char '~', pp TyOpPrec ty2] + then pprIfacePrefixApp ctxt_prec (text "Coercible") + [pp TyConPrec ty1, pp TyConPrec ty2] + else pprIfaceInfixApp ctxt_prec (char '~') + (pp TyOpPrec ty1) (pp TyOpPrec ty2) where ppr_infix_eq eq_op - = sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1) - , eq_op - , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2) ] + = pprIfaceInfixApp ctxt_prec eq_op + (parens (pp TopPrec ty1 <+> dcolon <+> pp TyOpPrec ki1)) + (parens (pp TopPrec ty2 <+> dcolon <+> pp TyOpPrec ki2)) print_kinds = gopt Opt_PrintExplicitKinds dflags print_eqs = gopt Opt_PrintEqualityRelations dflags || @@ -963,7 +968,8 @@ ppr_iface_tc_app pp ctxt_prec tc tys | [ty1,ty2] <- tys -- Infix, two arguments; -- we know nothing of precedence though - = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2 + = pprIfaceInfixApp ctxt_prec (ppr tc) + (pp TyOpPrec ty1) (pp TyOpPrec ty2) | otherwise = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys) @@ -1024,7 +1030,8 @@ ppr_co ctxt_prec (IfaceAppCo co1 co2) = maybeParen ctxt_prec TyConPrec $ ppr_co FunPrec co1 <+> pprParendIfaceCoercion co2 ppr_co ctxt_prec co@(IfaceForAllCo {}) - = maybeParen ctxt_prec FunPrec (pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)) + = maybeParen ctxt_prec FunPrec $ + pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co) where (tvs, inner_co) = split_co co @@ -1208,20 +1215,24 @@ instance Binary IfaceTcArgs where --- | Prints "(C a, D b) =>", including the arrow. This is used when we want to --- print a context in a type. +-- | Prints "(C a, D b) =>", including the arrow. +-- Used when we want to print a context in a type, so we +-- use FunPrec to decide whether to parenthesise a singleton +-- predicate; e.g. Num a => a -> a pprIfaceContextArr :: [IfacePredType] -> SDoc pprIfaceContextArr [] = empty -pprIfaceContextArr [pred] = ppr_ty TyOpPrec pred <+> darrow -pprIfaceContextArr preds = - parens (fsep (punctuate comma (map ppr preds))) <+> darrow - --- | Prints a context or @()@ if empty. This is used when, e.g., we want to --- display a context in an error message. -pprIfaceContext :: [IfacePredType] -> SDoc -pprIfaceContext [] = parens empty -pprIfaceContext [pred] = ppr_ty TyOpPrec pred -pprIfaceContext preds = parens (fsep (punctuate comma (map ppr preds))) +pprIfaceContextArr [pred] = ppr_ty FunPrec pred <+> darrow +pprIfaceContextArr preds = ppr_parend_preds preds <+> darrow + +-- | Prints a context or @()@ if empty +-- You give it the context precedence +pprIfaceContext :: TyPrec -> [IfacePredType] -> SDoc +pprIfaceContext _ [] = text "()" +pprIfaceContext prec [pred] = ppr_ty prec pred +pprIfaceContext _ preds = ppr_parend_preds preds + +ppr_parend_preds :: [IfacePredType] -> SDoc +ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds))) instance Binary IfaceType where put_ _ (IfaceFreeTyVar tv) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index c9e07fc43d..6d422a4c44 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1236,7 +1236,7 @@ mkIPErr ctxt cts msg | null givens = addArising orig $ sep [ text "Unbound implicit parameter" <> plural cts - , nest 2 (pprTheta preds) ] + , nest 2 (pprParendTheta preds) ] | otherwise = couldNotDeduce givens (preds, orig) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index e22dfc3822..e12b70b6d1 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -183,7 +183,7 @@ module TcType ( pprKind, pprParendKind, pprSigmaType, pprType, pprParendType, pprTypeApp, pprTyThingCategory, tyThingCategory, - pprTheta, pprThetaArrowTy, pprClassPred, + pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred, pprTvBndr, pprTvBndrs, TypeSize, sizeType, sizeTypes, toposortTyVars diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 300ef80a8f..74ebfbeb9a 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -55,9 +55,10 @@ module TyCoRep ( pickLR, -- * Pretty-printing - pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs, + pprType, pprParendType, pprPrecType, + pprTypeApp, pprTvBndr, pprTvBndrs, pprSigmaType, - pprTheta, pprForAll, pprUserForAll, + pprTheta, pprParendTheta, pprForAll, pprUserForAll, pprTyVar, pprTyVars, pprThetaArrowTy, pprClassPred, pprKind, pprParendKind, pprTyLit, @@ -2424,27 +2425,17 @@ defined to use this. @pprParendType@ is the same, except it puts parens around the type, except for the atomic cases. @pprParendType@ works just by setting the initial context precedence very high. -Note [Precedence in types] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't keep the fixity of type operators in the operator. So the pretty printer -follows the following precedence order: - Type constructor application binds more tightly than - Operator applications which bind more tightly than - Function arrow - -So we might see a :+: T b -> c -meaning (a :+: (T b)) -> c - -Maybe operator applications should bind a bit less tightly? - -Anyway, that's the current story; it is used consistently for Type and HsType. +See Note [Precedence in types] in BasicTypes. -} ------------------ pprType, pprParendType :: Type -> SDoc -pprType = pprIfaceType . tidyToIfaceType -pprParendType = pprParendIfaceType . tidyToIfaceType +pprType = pprPrecType TopPrec +pprParendType = pprPrecType TyConPrec + +pprPrecType :: TyPrec -> Type -> SDoc +pprPrecType prec ty = pprPrecIfaceType prec (tidyToIfaceType ty) pprTyLit :: TyLit -> SDoc pprTyLit = pprIfaceTyLit . toIfaceTyLit @@ -2471,7 +2462,10 @@ pprClassPred clas tys = pprTypeApp (classTyCon clas) tys ------------ pprTheta :: ThetaType -> SDoc -pprTheta = pprIfaceContext . map tidyToIfaceType +pprTheta = pprIfaceContext TopPrec . map tidyToIfaceType + +pprParendTheta :: ThetaType -> SDoc +pprParendTheta = pprIfaceContext TyConPrec . map tidyToIfaceType pprThetaArrowTy :: ThetaType -> SDoc pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 7750a35072..65c02ba719 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -182,7 +182,8 @@ module Type ( cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar, -- * Pretty-printing - pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprShortTyThing, + pprType, pprParendType, pprPrecType, + pprTypeApp, pprTyThingCategory, pprShortTyThing, pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType, ppSuggestExplicitKinds, pprTheta, pprThetaArrowTy, pprClassPred, diff --git a/testsuite/tests/backpack/should_fail/bkpfail24.stderr b/testsuite/tests/backpack/should_fail/bkpfail24.stderr index ef6a7d6c01..484ebf144b 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail24.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail24.stderr @@ -7,15 +7,15 @@ bkpfail24.bkp:14:15: error: • Could not deduce: a ~ b from the context: {H1.T} ~ {H2.T} bound by the type signature for: - f :: forall a b. {H1.T} ~ {H2.T} => a -> b + f :: forall a b. ({H1.T} ~ {H2.T}) => a -> b at bkpfail24.bkp:13:9-34 ‘a’ is a rigid type variable bound by the type signature for: - f :: forall a b. {H1.T} ~ {H2.T} => a -> b + f :: forall a b. ({H1.T} ~ {H2.T}) => a -> b at bkpfail24.bkp:13:9-34 ‘b’ is a rigid type variable bound by the type signature for: - f :: forall a b. {H1.T} ~ {H2.T} => a -> b + f :: forall a b. ({H1.T} ~ {H2.T}) => a -> b at bkpfail24.bkp:13:9-34 • In the expression: x In an equation for ‘f’: f x = x diff --git a/testsuite/tests/gadt/T7558.stderr b/testsuite/tests/gadt/T7558.stderr index 568f64fcee..f3d74362a5 100644 --- a/testsuite/tests/gadt/T7558.stderr +++ b/testsuite/tests/gadt/T7558.stderr @@ -3,7 +3,7 @@ T7558.hs:8:4: error: • Occurs check: cannot construct the infinite type: a ~ Maybe a Inaccessible code in a pattern with constructor: - MkT :: forall a b. a ~ Maybe b => a -> Maybe b -> T a b, + MkT :: forall a b. (a ~ Maybe b) => a -> Maybe b -> T a b, in an equation for ‘f’ • In the pattern: MkT x y In an equation for ‘f’: f (MkT x y) = [x, y] `seq` True diff --git a/testsuite/tests/generics/T10604/T10604_deriving.stderr b/testsuite/tests/generics/T10604/T10604_deriving.stderr index 59be21fd45..20417e37a5 100644 --- a/testsuite/tests/generics/T10604/T10604_deriving.stderr +++ b/testsuite/tests/generics/T10604/T10604_deriving.stderr @@ -521,6 +521,6 @@ Derived type family instances: ==================== Filling in method body ==================== GHC.Base.Functor [T10604_deriving.Proxy *] - GHC.Base.<$ = GHC.Base.$dm<$ @T10604_deriving.Proxy * + GHC.Base.<$ = GHC.Base.$dm<$ @(T10604_deriving.Proxy *) diff --git a/testsuite/tests/ghci/scripts/T12024.stdout b/testsuite/tests/ghci/scripts/T12024.stdout index e01f43a511..818d9fe5ee 100644 --- a/testsuite/tests/ghci/scripts/T12024.stdout +++ b/testsuite/tests/ghci/scripts/T12024.stdout @@ -1 +1,2 @@ -pattern X' :: () => a ~ [x] => A a -- Defined at <interactive>:4:1 +pattern X' :: () => (a ~ [x]) => A a + -- Defined at <interactive>:4:1 diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index 8f06390348..49618904a2 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -151,26 +151,26 @@ data Ex a Ex4 (forall a. a -> a) <document comment> k :: - T () () This argument has type 'T' - -> (T2 Int Int) This argument has type 'T2 Int Int' - -> (T3 Bool Bool - -> T4 Float Float) This argument has type @T3 Bool Bool -> T4 Float Float@ - -> T5 () () This argument has a very long description that should + (T () () This argument has type 'T') + -> ((T2 Int Int) This argument has type 'T2 Int Int') + -> ((T3 Bool Bool + -> T4 Float Float) This argument has type @T3 Bool Bool -> T4 Float Float@) + -> (T5 () () This argument has a very long description that should hopefully cause some wrapping to happen when it is finally - rendered by Haddock in the generated HTML page. + rendered by Haddock in the generated HTML page.) -> IO () This is the result type -l :: (Int, Int, Float) takes a triple -> Int returns an 'Int' +l :: ((Int, Int, Float) takes a triple) -> Int returns an 'Int' <document comment> m :: - R -> N1 () one of the arguments -> IO Int and the return value + R -> (N1 () one of the arguments) -> IO Int and the return value <document comment> newn :: - R one of the arguments, an 'R' - -> N1 () one of the arguments -> IO Int + (R one of the arguments, an 'R') + -> (N1 () one of the arguments) -> IO Int newn = undefined <document comment> foreign import ccall unsafe "header.h" o - :: Float The input float -> IO Float The output float + :: (Float The input float) -> IO Float The output float <document comment> newp :: Int newp = undefined diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr index 63c2b2f74b..c0233de0d5 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test :: (Eq a) => [a] doc1 -> [a] doc2 -> [a] doc3 +test :: (Eq a) => ([a] doc1) -> ([a] doc2 ) -> [a] doc3 test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr index b3caa71b9e..f1db2374b1 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test2 :: a doc1 -> b doc2 -> a doc 3 +test2 :: (a doc1 ) -> (b doc2 ) -> a doc 3 test2 x y = x diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr index 472ec1a1eb..4b208f858a 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test2 :: a doc1 -> a +test2 :: (a doc1 ) -> a test2 x = x diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr index 769da3f0d3..fcf9e0c2d6 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr @@ -1,7 +1,8 @@ ==================== Parser ==================== module ShouldCompile where -test :: (Eq a) => [a] doc1 -> forall b. [b] doc2 -> [a] doc3 +test :: + (Eq a) => ([a] doc1) -> forall b. ([b] doc2 ) -> [a] doc3 test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr index e7707c5ec0..cd8884080f 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr @@ -2,9 +2,9 @@ ==================== Parser ==================== module ShouldCompile where test :: - [a] doc1 + ([a] doc1) -> forall b. - (Ord b) => [b] doc2 -> forall c. (Num c) => [c] doc3 -> [a] + (Ord b) => ([b] doc2 ) -> forall c. (Num c) => ([c] doc3) -> [a] test xs ys zs = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr index 47d2468ea5..9e1edc661b 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr @@ -2,7 +2,7 @@ ==================== Parser ==================== module ShouldCompile where data a <--> b = Mk a b -test :: [a] doc1 -> a <--> b -> [a] blabla +test :: ([a] doc1 ) -> a <--> b -> [a] blabla test xs ys = xs diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr index 32e0138fe6..fa19be483c 100644 --- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr +++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr @@ -4,7 +4,7 @@ PushedInAsGivens.hs:10:31: error: because type variable ‘a1’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: - foo :: forall a1. F Int ~ [a1] => a1 -> Int + foo :: forall a1. (F Int ~ [a1]) => a1 -> Int at PushedInAsGivens.hs:9:13-44 • In the expression: y In the first argument of ‘length’, namely ‘[x, y]’ diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr index 7e08b2f11f..0c600e378f 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr +++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr @@ -4,14 +4,14 @@ Simple14.hs:8:8: error: ‘z0’ is untouchable inside the constraints: x ~ y bound by the type signature for: - eqE :: x ~ y => EQ_ z0 z0 + eqE :: (x ~ y) => EQ_ z0 z0 at Simple14.hs:8:8-39 ‘z’ is a rigid type variable bound by the type signature for: - eqE :: forall x y z p. EQ_ x y -> (x ~ y => EQ_ z z) -> p + eqE :: forall x y z p. EQ_ x y -> ((x ~ y) => EQ_ z z) -> p at Simple14.hs:8:8-39 Expected type: EQ_ z0 z0 Actual type: EQ_ z z • In the ambiguity check for ‘eqE’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: eqE :: EQ_ x y -> (x ~ y => EQ_ z z) -> p + In the type signature: eqE :: EQ_ x y -> ((x ~ y) => EQ_ z z) -> p diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr index 48d897dea0..fd0b98799a 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr @@ -1,6 +1,5 @@ SimpleFail15.hs:5:8: error: - • Illegal qualified type: a ~ b => t + • Illegal qualified type: (a ~ b) => t Perhaps you intended to use RankNTypes or Rank2Types - • In the type signature: - foo :: (a, b) -> (a ~ b => t) -> (a, b) + • In the type signature: foo :: (a, b) -> ((a ~ b) => t) -> (a, b) diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr index 7b2d92f8ed..826fe1934a 100644 --- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr @@ -3,11 +3,11 @@ T4093a.hs:8:8: error: • Could not deduce: e ~ () from the context: Foo e ~ Maybe e bound by the type signature for: - hang :: forall e. Foo e ~ Maybe e => Foo e + hang :: forall e. (Foo e ~ Maybe e) => Foo e at T4093a.hs:7:1-34 ‘e’ is a rigid type variable bound by the type signature for: - hang :: forall e. Foo e ~ Maybe e => Foo e + hang :: forall e. (Foo e ~ Maybe e) => Foo e at T4093a.hs:7:1-34 Expected type: Foo e Actual type: Maybe () diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr index 7a76170f17..4c946a70bb 100644 --- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr @@ -3,11 +3,11 @@ TYPE SIGNATURES DataFamilyInstanceLHS.B :: MyKind DataFamilyInstanceLHS.SingA :: forall (_ :: MyKind). - _ ~ 'A => + (_ ~ 'A) => DataFamilyInstanceLHS.R:SingMyKind_ _ DataFamilyInstanceLHS.SingB :: forall (_ :: MyKind). - _ ~ 'B => + (_ ~ 'B) => DataFamilyInstanceLHS.R:SingMyKind_ _ foo :: Sing 'A TYPE CONSTRUCTORS diff --git a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr index 3ba61f598e..17e9d5a3ff 100644 --- a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr +++ b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - foo :: forall a. a ~ Bool => (a, Bool) + foo :: forall a. (a ~ Bool) => (a, Bool) TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr index 8b8bebe55f..2990f7eb5e 100644 --- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr @@ -3,11 +3,11 @@ TYPE SIGNATURES NamedWildcardInDataFamilyInstanceLHS.B :: MyKind NamedWildcardInDataFamilyInstanceLHS.SingA :: forall (_a :: MyKind). - _a ~ 'A => + (_a ~ 'A) => NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a _a NamedWildcardInDataFamilyInstanceLHS.SingB :: forall (_a :: MyKind). - _a ~ 'B => + (_a ~ 'B) => NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a _a TYPE CONSTRUCTORS data MyKind = A | B diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr index ac8972dec6..b0f17adaad 100644 --- a/testsuite/tests/polykinds/T10503.stderr +++ b/testsuite/tests/polykinds/T10503.stderr @@ -3,15 +3,16 @@ T10503.hs:8:6: error: • Could not deduce: k ~ * from the context: Proxy 'KProxy ~ Proxy 'KProxy bound by the type signature for: - h :: Proxy 'KProxy ~ Proxy 'KProxy => r + h :: (Proxy 'KProxy ~ Proxy 'KProxy) => r at T10503.hs:8:6-85 ‘k’ is a rigid type variable bound by the type signature for: - h :: forall k r. (Proxy 'KProxy ~ Proxy 'KProxy => r) -> r + h :: forall k r. ((Proxy 'KProxy ~ Proxy 'KProxy) => r) -> r at T10503.hs:8:6-85 • In the ambiguity check for ‘h’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: h :: forall r. - (Proxy ( 'KProxy :: KProxy k) ~ Proxy ( 'KProxy :: KProxy *) => r) + ((Proxy ( 'KProxy :: KProxy k) ~ Proxy ( 'KProxy :: KProxy *)) => + r) -> r diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr index f0a29bb2d6..48781e8f7f 100644 --- a/testsuite/tests/polykinds/T7230.stderr +++ b/testsuite/tests/polykinds/T7230.stderr @@ -4,7 +4,7 @@ T7230.hs:48:32: error: from the context: Increasing xs ~ 'True bound by the type signature for: crash :: forall (xs :: [Nat]). - Increasing xs ~ 'True => + (Increasing xs ~ 'True) => SList xs -> SBool (Increasing xs) at T7230.hs:47:1-68 or from: xs ~ (x : xs1) diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr index 76f81555dd..e6accc56f4 100644 --- a/testsuite/tests/polykinds/T7328.stderr +++ b/testsuite/tests/polykinds/T7328.stderr @@ -3,4 +3,4 @@ T7328.hs:8:34: error: • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1 • In the first argument of ‘Foo’, namely ‘f’ In the first argument of ‘Proxy’, namely ‘(Foo f)’ - In the type signature: foo :: a ~ f i => Proxy (Foo f) + In the type signature: foo :: (a ~ f i) => Proxy (Foo f) diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr index dc1b92c202..6e143e0cf9 100644 --- a/testsuite/tests/polykinds/T9222.stderr +++ b/testsuite/tests/polykinds/T9222.stderr @@ -4,12 +4,12 @@ T9222.hs:13:3: error: ‘c0’ is untouchable inside the constraints: a ~ '(b0, c0) bound by the type of the constructor ‘Want’: - a ~ '(b0, c0) => Proxy b0 + (a ~ '(b0, c0)) => Proxy b0 at T9222.hs:13:3 ‘c’ is a rigid type variable bound by the type of the constructor ‘Want’: forall i1 j1 (a :: (i1, j1)) (b :: i1) (c :: j1). - (a ~ '(b, c) => Proxy b) -> Want a + ((a ~ '(b, c)) => Proxy b) -> Want a at T9222.hs:13:3 • In the ambiguity check for ‘Want’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index 6b7bb557f4..f4b44a28c4 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -14,7 +14,7 @@ convert :: Wrap Age -> Int convert = convert1 `cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0] - :: ((Wrap Age -> Wrap Age) :: *) ~R# ((Wrap Age -> Int) :: *)) + :: (Wrap Age -> Wrap Age :: *) ~R# (Wrap Age -> Int :: *)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Prim.Addr# diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 11abd0cd4c..32fcea0abd 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -8,7 +8,7 @@ TYPE CONSTRUCTORS meth1 :: a -> a {-# MINIMAL meth1 #-} class C2 a b where - meth2 :: a ~ b => a -> b + meth2 :: (a ~ b) => a -> b {-# MINIMAL meth2 #-} class C3 a b where type family F3 b :: * open @@ -23,7 +23,7 @@ TYPE CONSTRUCTORS COERCION AXIOMS axiom Roles3.N:C1 :: C1 a = a -> a -- Defined at Roles3.hs:6:1 axiom Roles3.N:C2 :: - C2 a b = a ~ b => a -> b -- Defined at Roles3.hs:9:1 + C2 a b = (a ~ b) => a -> b -- Defined at Roles3.hs:9:1 axiom Roles3.N:C3 :: C3 a b = a -> F3 b -> F3 b -- Defined at Roles3.hs:12:1 axiom Roles3.N:C4 :: diff --git a/testsuite/tests/typecheck/should_compile/T10632.stderr b/testsuite/tests/typecheck/should_compile/T10632.stderr index 0796146b17..1733f0ae7a 100644 --- a/testsuite/tests/typecheck/should_compile/T10632.stderr +++ b/testsuite/tests/typecheck/should_compile/T10632.stderr @@ -1,5 +1,5 @@ T10632.hs:4:1: warning: [-Wredundant-constraints] - • Redundant constraint: (?file1::String) + • Redundant constraint: ?file1::String • In the type signature for: f :: (?file1::String) => IO () diff --git a/testsuite/tests/typecheck/should_fail/ClassOperator.stderr b/testsuite/tests/typecheck/should_fail/ClassOperator.stderr index 890783d3c1..bc4eb7c598 100644 --- a/testsuite/tests/typecheck/should_fail/ClassOperator.stderr +++ b/testsuite/tests/typecheck/should_fail/ClassOperator.stderr @@ -1,7 +1,7 @@ ClassOperator.hs:12:3: error: • Could not deduce (a ><> b0) - from the context: (a ><> b) + from the context: a ><> b bound by the type signature for: (**>) :: forall a b. (a ><> b) => a -> a -> () at ClassOperator.hs:12:3-44 @@ -14,7 +14,7 @@ ClassOperator.hs:12:3: error: ClassOperator.hs:12:3: error: • Could not deduce (a ><> b0) - from the context: (a ><> b) + from the context: a ><> b bound by the type signature for: (**<) :: forall a b. (a ><> b) => a -> a -> () at ClassOperator.hs:12:3-44 @@ -27,7 +27,7 @@ ClassOperator.hs:12:3: error: ClassOperator.hs:12:3: error: • Could not deduce (a ><> b0) - from the context: (a ><> b) + from the context: a ><> b bound by the type signature for: (>**) :: forall a b. (a ><> b) => a -> a -> () at ClassOperator.hs:12:3-44 @@ -40,7 +40,7 @@ ClassOperator.hs:12:3: error: ClassOperator.hs:12:3: error: • Could not deduce (a ><> b0) - from the context: (a ><> b) + from the context: a ><> b bound by the type signature for: (<**) :: forall a b. (a ><> b) => a -> a -> () at ClassOperator.hs:12:3-44 diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr index bff6ba544f..6abb044c8e 100644 --- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr +++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr @@ -2,7 +2,7 @@ FrozenErrorTests.hs:12:12: error: • Couldn't match type ‘Int’ with ‘Bool’ Inaccessible code in - a pattern with constructor: MkT3 :: forall a. a ~ Bool => T a, + a pattern with constructor: MkT3 :: forall a. (a ~ Bool) => T a, in a case alternative • In the pattern: MkT3 In a case alternative: MkT3 -> () diff --git a/testsuite/tests/typecheck/should_fail/IPFail.stderr b/testsuite/tests/typecheck/should_fail/IPFail.stderr index 0ba5bce32a..72c11b0c0d 100644 --- a/testsuite/tests/typecheck/should_fail/IPFail.stderr +++ b/testsuite/tests/typecheck/should_fail/IPFail.stderr @@ -1,7 +1,7 @@ IPFail.hs:6:18: error: • Could not deduce (Num Bool) arising from the literal ‘5’ - from the context: (?x::Int) + from the context: ?x::Int bound by the type signature for: f0 :: (?x::Int) => () -> Bool at IPFail.hs:5:1-31 diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr index 422ec7dbd3..bd0ba8e43d 100644 --- a/testsuite/tests/typecheck/should_fail/T12921.stderr +++ b/testsuite/tests/typecheck/should_fail/T12921.stderr @@ -21,7 +21,7 @@ T12921.hs:4:16: error: p0)’ from being solved. Probable fix: use a type annotation to specify what ‘p0’ should be. These potential instances exist: - instance a ~ Char => Data.String.IsString [a] + instance (a ~ Char) => Data.String.IsString [a] -- Defined in ‘Data.String’ ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) diff --git a/testsuite/tests/typecheck/should_fail/T5858.stderr b/testsuite/tests/typecheck/should_fail/T5858.stderr index dc3ee90189..829c027135 100644 --- a/testsuite/tests/typecheck/should_fail/T5858.stderr +++ b/testsuite/tests/typecheck/should_fail/T5858.stderr @@ -5,7 +5,7 @@ T5858.hs:11:7: error: ([a0], [a1]))’ from being solved. Probable fix: use a type annotation to specify what ‘a0’, ‘a1’ should be. These potential instance exist: - instance t1 ~ String => InferOverloaded (t1, t1) + instance (t1 ~ String) => InferOverloaded (t1, t1) -- Defined at T5858.hs:8:10 • In the expression: infer ([], []) In an equation for ‘foo’: foo = infer ([], []) diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr index 9772b85e58..a50fbcf240 100644 --- a/testsuite/tests/typecheck/should_fail/T7019a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr @@ -2,6 +2,6 @@ T7019a.hs:11:1: error: • Illegal polymorphic type: forall b. Context (Associated a b) A constraint must be a monotype - • In the context: (forall b. Context (Associated a b)) + • In the context: forall b. Context (Associated a b) While checking the super-classes of class ‘Class’ In the class declaration for ‘Class’ diff --git a/testsuite/tests/typecheck/should_fail/T7525.stderr b/testsuite/tests/typecheck/should_fail/T7525.stderr index 99b9c2861d..11028ef3bd 100644 --- a/testsuite/tests/typecheck/should_fail/T7525.stderr +++ b/testsuite/tests/typecheck/should_fail/T7525.stderr @@ -1,8 +1,8 @@ T7525.hs:5:30: error: - • Could not deduce: (?b::Bool) + • Could not deduce: ?b::Bool arising from a use of implicit parameter ‘?b’ - from the context: (?a::Bool) + from the context: ?a::Bool bound by the implicit-parameter binding for ?a at T7525.hs:5:7-31 • In the second argument of ‘(&&)’, namely ‘?b’ In the expression: ?a && ?b diff --git a/testsuite/tests/typecheck/should_fail/T7857.stderr b/testsuite/tests/typecheck/should_fail/T7857.stderr index ef723a703b..2596efb51f 100644 --- a/testsuite/tests/typecheck/should_fail/T7857.stderr +++ b/testsuite/tests/typecheck/should_fail/T7857.stderr @@ -6,7 +6,7 @@ T7857.hs:8:11: error: at T7857.hs:8:1-21 The type variable ‘a0’ is ambiguous These potential instances exist: - instance [safe] a ~ () => PrintfType (IO a) + instance [safe] (a ~ ()) => PrintfType (IO a) -- Defined in ‘Text.Printf’ instance [safe] (PrintfArg a, PrintfType r) => PrintfType (a -> r) -- Defined in ‘Text.Printf’ diff --git a/testsuite/tests/typecheck/should_fail/T8912.stderr b/testsuite/tests/typecheck/should_fail/T8912.stderr index 78fdd108dd..bfe06c1511 100644 --- a/testsuite/tests/typecheck/should_fail/T8912.stderr +++ b/testsuite/tests/typecheck/should_fail/T8912.stderr @@ -1,6 +1,6 @@ T8912.hs:7:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: (?imp::Int) + • In the context: ?imp::Int While checking an instance declaration In the instance declaration for ‘C [a]’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.stderr b/testsuite/tests/typecheck/should_fail/tcfail041.stderr index d2d3214d9e..75cd754d8f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail041.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail041.stderr @@ -1,6 +1,6 @@ tcfail041.hs:5:1: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: (?imp::Int) + • In the context: ?imp::Int While checking the super-classes of class ‘D’ In the class declaration for ‘D’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr index a88cc35507..7a5053a092 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail211.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail211.stderr @@ -1,12 +1,12 @@ tcfail211.hs:5:1: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: (?imp::Int) + • In the context: ?imp::Int While checking the super-classes of class ‘D’ In the class declaration for ‘D’ tcfail211.hs:8:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: (?imp::Int) + • In the context: ?imp::Int While checking an instance declaration In the instance declaration for ‘D Int’ |