From ae2c9b40f5b6bf272251d1f4107c60003f541b62 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 15 Nov 2018 09:02:11 +0000 Subject: Smarter HsType pretty-print for promoted datacons Fix Trac #15898, by being smarter about when to print a space before a promoted data constructor, in a HsType. I had to implement a mildly tiresome function HsType.lhsTypeHasLeadingPromotionQuote It has multiple cases, of course, but it's very simple. The patch improves the error-message output in a bunch of cases, and (to my surprise) actually fixes a bug in the output of T14343 (Trac #14343), thus - In the expression: _ :: Proxy '('( 'True, 'False), 'False) + In the expression: _ :: Proxy '( '( 'True, 'False), 'False) I discovered that there were two copies of the PromotionFlag type (a boolean, with helpfully named data cons), one in IfaceType and one in HsType. So I combined into one, PromotionFlag, and moved it to BasicTypes. That's why quite a few files are touched, but it's all routine. --- compiler/basicTypes/BasicTypes.hs | 19 ++++++ compiler/hsSyn/Convert.hs | 12 ++-- compiler/hsSyn/HsTypes.hs | 75 +++++++++++++++------- compiler/iface/IfaceType.hs | 44 ++++++------- compiler/iface/TcIface.hs | 6 +- compiler/iface/ToIface.hs | 8 +-- compiler/parser/Parser.y | 6 +- compiler/utils/Binary.hs | 11 ++++ .../dependent/should_fail/PromotedClass.stderr | 4 +- .../tests/dependent/should_fail/T15245.stderr | 6 +- testsuite/tests/ghci/scripts/T15898.script | 6 ++ testsuite/tests/ghci/scripts/T15898.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 1 + .../parser/should_compile/DumpParsedAst.stderr | 2 +- .../parser/should_compile/DumpRenamedAst.stderr | 2 +- .../tests/parser/should_compile/KindSigs.stderr | 2 +- testsuite/tests/polykinds/PolyKinds07.stderr | 12 ++-- testsuite/tests/polykinds/T10503.stderr | 2 +- testsuite/tests/polykinds/T15116a.stderr | 4 +- testsuite/tests/polykinds/T7433.stderr | 2 +- testsuite/tests/printer/T14343.stderr | 8 +-- testsuite/tests/printer/T14343b.stderr | 12 ++-- .../tests/typecheck/should_fail/T14607.stderr | 12 ++-- 23 files changed, 162 insertions(+), 95 deletions(-) create mode 100644 testsuite/tests/ghci/scripts/T15898.script create mode 100644 testsuite/tests/ghci/scripts/T15898.stdout diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index cf56957f7b..200e5c9b8a 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -28,6 +28,7 @@ module BasicTypes( Alignment, + PromotionFlag(..), isPromoted, FunctionOrData(..), WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..), @@ -270,6 +271,24 @@ unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b unSwap NotSwapped f a b = f a b unSwap IsSwapped f a b = f b a + +{- ********************************************************************* +* * + Promotion flag +* * +********************************************************************* -} + +-- | Is a TyCon a promoted data constructor or just a normal type constructor? +data PromotionFlag + = NotPromoted + | IsPromoted + deriving ( Eq, Data ) + +isPromoted :: PromotionFlag -> Bool +isPromoted IsPromoted = True +isPromoted NotPromoted = False + + {- ************************************************************************ * * diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 06d5d6ca7a..8bd33d6a5b 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1350,7 +1350,7 @@ cvtTypeKind ty_str ty -- names, as opposed to PromotedT, which can only -- contain data constructor names. See #15572. let prom = if isRdrDataCon nm' - then Promoted + then IsPromoted else NotPromoted ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'} @@ -1398,8 +1398,8 @@ cvtTypeKind ty_str ty } PromotedT nm -> do { nm' <- cName nm - ; mk_apps (HsTyVar noExt Promoted - (noLoc nm')) tys' } + ; let hs_ty = HsTyVar noExt IsPromoted (noLoc nm') + ; mk_apps hs_ty tys' } -- Promoted data constructor; hence cName PromotedTupleT n @@ -1408,20 +1408,20 @@ cvtTypeKind ty_str ty | m == n -- Saturated -> returnL (HsExplicitTupleTy noExt tys') | otherwise - -> mk_apps (HsTyVar noExt Promoted + -> mk_apps (HsTyVar noExt IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n)))) tys' where m = length tys' PromotedNilT - -> mk_apps (HsExplicitListTy noExt Promoted []) tys' + -> mk_apps (HsExplicitListTy noExt IsPromoted []) tys' PromotedConsT -- See Note [Representing concrete syntax in types] -- in Language.Haskell.TH.Syntax | [ty1, L _ (HsExplicitListTy _ ip tys2)] <- tys' -> returnL (HsExplicitListTy noExt ip (ty1:tys2)) | otherwise - -> mk_apps (HsTyVar noExt Promoted + -> mk_apps (HsTyVar noExt IsPromoted (noLoc (getRdrName consDataCon))) tys' diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 8200707e16..f0f71be738 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -24,7 +24,6 @@ module HsTypes ( HsWildCardBndrs(..), LHsSigType, LHsSigWcType, LHsWcType, HsTupleSort(..), - Promoted(..), HsContext, LHsContext, HsTyLit(..), HsIPName(..), hsIPNameFS, @@ -515,10 +514,10 @@ data HsType pass , hst_ctxt :: LHsContext pass -- Context C => blah , hst_body :: LHsType pass } - | HsTyVar (XTyVar pass) - Promoted -- whether explicitly promoted, for the pretty - -- printer - (Located (IdP pass)) + | HsTyVar (XTyVar pass) + PromotionFlag -- Whether explicitly promoted, + -- for the pretty printer + (Located (IdP pass)) -- Type variable, type constructor, or data constructor -- see Note [Promotions (HsTyVar)] -- See Note [Located RdrNames] in HsExpr @@ -641,7 +640,7 @@ data HsType pass | HsExplicitListTy -- A promoted explicit list (XExplicitListTy pass) - Promoted -- whether explcitly promoted, for pretty printer + PromotionFlag -- whether explcitly promoted, for pretty printer [LHsType pass] -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@, -- 'ApiAnnotation.AnnClose' @']'@ @@ -854,12 +853,6 @@ data HsTupleSort = HsUnboxedTuple | HsBoxedOrConstraintTuple deriving Data - --- | Promoted data types. -data Promoted = Promoted - | NotPromoted - deriving (Data, Eq, Show) - -- | Located Constructor Declaration Field type LConDeclField pass = Located (ConDeclField pass) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when @@ -1401,11 +1394,9 @@ ppr_mono_ty (HsQualTy { hst_ctxt = L _ ctxt, hst_body = ty }) ppr_mono_ty (HsBangTy _ b ty) = ppr b <> ppr_mono_lty ty ppr_mono_ty (HsRecTy _ flds) = pprConDeclFields flds -ppr_mono_ty (HsTyVar _ NotPromoted (L _ name))= pprPrefixOcc name -ppr_mono_ty (HsTyVar _ Promoted (L _ name)) - = space <> quote (pprPrefixOcc name) - -- We need a space before the ' above, so the parser - -- does not attach it to the previous symbol +ppr_mono_ty (HsTyVar _ prom (L _ name)) + | isPromoted prom = quote (pprPrefixOcc name) + | otherwise = pprPrefixOcc name ppr_mono_ty (HsFunTy _ ty1 ty2) = ppr_fun_ty ty1 ty2 ppr_mono_ty (HsTupleTy _ con tys) = tupleParens std_con (pprWithCommas ppr tys) where std_con = case con of @@ -1418,11 +1409,11 @@ ppr_mono_ty (HsKindSig _ ty kind) ppr_mono_ty (HsListTy _ ty) = brackets (ppr_mono_lty ty) ppr_mono_ty (HsIParamTy _ n ty) = (ppr n <+> dcolon <+> ppr_mono_lty ty) ppr_mono_ty (HsSpliceTy _ s) = pprSplice s -ppr_mono_ty (HsExplicitListTy _ Promoted tys) - = quote $ brackets (interpp'SP tys) -ppr_mono_ty (HsExplicitListTy _ NotPromoted tys) - = brackets (interpp'SP tys) -ppr_mono_ty (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys) +ppr_mono_ty (HsExplicitListTy _ prom tys) + | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys) + | otherwise = brackets (interpp'SP tys) +ppr_mono_ty (HsExplicitTupleTy _ tys) + = quote $ parens (maybeAddSpace tys $ interpp'SP tys) ppr_mono_ty (HsTyLit _ t) = ppr_tylit t ppr_mono_ty (HsWildCardTy {}) = char '_' @@ -1492,6 +1483,46 @@ hsTypeNeedsParens p = go go (HsDocTy _ (L _ t) _) = go t go (XHsType{}) = False +maybeAddSpace :: [LHsType pass] -> SDoc -> SDoc +-- See Note [Printing promoted type constructors] +-- in IfaceType. This code implements the same +-- logic for printing HsType +maybeAddSpace tys doc + | (ty : _) <- tys + , lhsTypeHasLeadingPromotionQuote ty = space <> doc + | otherwise = doc + +lhsTypeHasLeadingPromotionQuote :: LHsType pass -> Bool +lhsTypeHasLeadingPromotionQuote ty + = goL ty + where + goL (L _ ty) = go ty + + go (HsForAllTy{}) = False + go (HsQualTy{ hst_ctxt = ctxt, hst_body = body}) + | L _ (c:_) <- ctxt = goL c + | otherwise = goL body + go (HsBangTy{}) = False + go (HsRecTy{}) = False + go (HsTyVar _ p _) = isPromoted p + go (HsFunTy _ arg _) = goL arg + go (HsListTy{}) = False + go (HsTupleTy{}) = False + go (HsSumTy{}) = False + go (HsOpTy _ t1 _ _) = goL t1 + go (HsKindSig _ t _) = goL t + go (HsIParamTy{}) = False + go (HsSpliceTy{}) = False + go (HsExplicitListTy _ p _) = isPromoted p + go (HsExplicitTupleTy{}) = True + go (HsTyLit{}) = False + go (HsWildCardTy{}) = False + go (HsStarTy{}) = False + go (HsAppTy _ t _) = goL t + go (HsParTy{}) = False + go (HsDocTy _ t _) = goL t + go (XHsType{}) = False + -- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is -- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply -- returns @ty@. diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 264dfa0c57..4d6a3b3be3 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -16,7 +16,7 @@ module IfaceType ( IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..), IfaceMCoercion(..), IfaceUnivCoProv(..), - IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IsPromoted(..), + IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IfaceTyLit(..), IfaceAppArgs(..), IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder, @@ -143,7 +143,7 @@ data IfaceType | IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp) TupleSort -- What sort of tuple? - IsPromoted -- A bit like IfaceTyCon + PromotionFlag -- A bit like IfaceTyCon IfaceAppArgs -- arity = length args -- For promoted data cons, the kind args are omitted @@ -186,10 +186,6 @@ data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName , ifaceTyConInfo :: IfaceTyConInfo } deriving (Eq) --- | Is a TyCon a promoted data constructor or just a normal type constructor? -data IsPromoted = IsNotPromoted | IsPromoted - deriving (Eq) - -- | The various types of TyCons which have special, built-in syntax. data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon @@ -290,7 +286,7 @@ See Note [The equality types story] in TysPrim. data IfaceTyConInfo -- Used to guide pretty-printing -- and to disambiguate D from 'D (they share a name) - = IfaceTyConInfo { ifaceTyConIsPromoted :: IsPromoted + = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag , ifaceTyConSort :: IfaceTyConSort } deriving (Eq) @@ -1033,11 +1029,24 @@ criteria are met: in TyCoRep. N.B. Until now (Aug 2018) we didn't check anything for coercion variables. + +Note [Printing promoted type constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this GHCi session (Trac #14343) + > _ :: Proxy '[ 'True ] + error: + Found hole: _ :: Proxy '['True] + +This would be bad, because the '[' looks like a character literal. +Solution: in type-level lists and tuples, add a leading space +if the first type is itself promoted. See pprSpaceIfPromotedTyCon. -} + ------------------- -- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'. +-- See Note [Printing promoted type constructors] pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _) = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of @@ -1229,7 +1238,7 @@ ppr_iface_tc_app pp ctxt_prec tc tys | otherwise = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys) -pprSum :: Arity -> IsPromoted -> IfaceAppArgs -> SDoc +pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc pprSum _arity is_promoted args = -- drop the RuntimeRep vars. -- See Note [Unboxed tuple RuntimeRep vars] in TyCon @@ -1238,8 +1247,8 @@ pprSum _arity is_promoted args in pprPromotionQuoteI is_promoted <> sumParens (pprWithBars (ppr_ty topPrec) args') -pprTuple :: PprPrec -> TupleSort -> IsPromoted -> IfaceAppArgs -> SDoc -pprTuple ctxt_prec ConstraintTuple IsNotPromoted IA_Nil +pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc +pprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil = maybeParen ctxt_prec appPrec $ text "() :: Constraint" @@ -1375,8 +1384,8 @@ pprPromotionQuote :: IfaceTyCon -> SDoc pprPromotionQuote tc = pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc -pprPromotionQuoteI :: IsPromoted -> SDoc -pprPromotionQuoteI IsNotPromoted = empty +pprPromotionQuoteI :: PromotionFlag -> SDoc +pprPromotionQuoteI NotPromoted = empty pprPromotionQuoteI IsPromoted = char '\'' instance Outputable IfaceCoercion where @@ -1389,17 +1398,6 @@ instance Binary IfaceTyCon where i <- get bh return (IfaceTyCon n i) -instance Binary IsPromoted where - put_ bh IsNotPromoted = putByte bh 0 - put_ bh IsPromoted = putByte bh 1 - - get bh = do - n <- getByte bh - case n of - 0 -> return IsNotPromoted - 1 -> return IsPromoted - _ -> fail "Binary(IsPromoted): fail)" - instance Binary IfaceTyConSort where put_ bh IfaceNormalTyCon = putByte bh 0 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 248f7d3c38..34bcdb7cd5 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -1153,13 +1153,13 @@ tcIfaceType = go go (IfaceCastTy ty co) = CastTy <$> go ty <*> tcIfaceCo co go (IfaceCoercionTy co) = CoercionTy <$> tcIfaceCo co -tcIfaceTupleTy :: TupleSort -> IsPromoted -> IfaceAppArgs -> IfL Type +tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type tcIfaceTupleTy sort is_promoted args = do { args' <- tcIfaceAppArgs args ; let arity = length args' ; base_tc <- tcTupleTyCon True sort arity ; case is_promoted of - IsNotPromoted + NotPromoted -> return (mkTyConApp base_tc args') IsPromoted @@ -1673,7 +1673,7 @@ tcIfaceTyCon :: IfaceTyCon -> IfL TyCon tcIfaceTyCon (IfaceTyCon name info) = do { thing <- tcIfaceGlobal name ; return $ case ifaceTyConIsPromoted info of - IsNotPromoted -> tyThingTyCon thing + NotPromoted -> tyThingTyCon thing IsPromoted -> promoteDataCon $ tyThingDataCon thing } tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched) diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index 653b7407da..a3d11e8891 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -150,7 +150,7 @@ toIfaceTypeX fr (TyConApp tc tys) -- tuples | Just sort <- tyConTuple_maybe tc , n_tys == arity - = IfaceTupleTy sort IsNotPromoted (toIfaceTcArgsX fr tc tys) + = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys) | Just dc <- isPromotedDataCon_maybe tc , isTupleDataCon dc @@ -159,7 +159,7 @@ toIfaceTypeX fr (TyConApp tc tys) | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ] , (k1:k2:_) <- tys - = let info = IfaceTyConInfo IsNotPromoted sort + = let info = IfaceTyConInfo NotPromoted sort sort | k1 `eqType` k2 = IfaceEqualityTyCon | otherwise = IfaceNormalTyCon in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys) @@ -191,7 +191,7 @@ toIfaceTyCon tc tc_name = tyConName tc info = IfaceTyConInfo promoted sort promoted | isPromotedDataCon tc = IsPromoted - | otherwise = IsNotPromoted + | otherwise = NotPromoted tupleSort :: TyCon -> Maybe IfaceTyConSort tupleSort tc' = @@ -217,7 +217,7 @@ toIfaceTyCon tc toIfaceTyCon_name :: Name -> IfaceTyCon toIfaceTyCon_name n = IfaceTyCon n info - where info = IfaceTyConInfo IsNotPromoted IfaceNormalTyCon + where info = IfaceTyConInfo NotPromoted IfaceNormalTyCon -- Used for the "rough-match" tycon stuff, -- where pretty-printing is not an issue diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 8a10516819..f5082174ab 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2030,14 +2030,14 @@ atype :: { LHsType GhcPs } (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1)))) [mj AnnThIdSplice $1] } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5)) [mj AnnSimpleQuote $1,mop $2,mcp $6] } - | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt Promoted $3) + | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt IsPromoted $3) [mj AnnSimpleQuote $1,mos $2,mcs $4] } - | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2) + | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] } -- Two or more [ty, ty, ty] must be a promoted list type, just as diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index a38af74efe..63efd14a5b 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -945,6 +945,17 @@ instance Binary LeftOrRight where 0 -> return CLeft _ -> return CRight } +instance Binary PromotionFlag where + put_ bh NotPromoted = putByte bh 0 + put_ bh IsPromoted = putByte bh 1 + + get bh = do + n <- getByte bh + case n of + 0 -> return NotPromoted + 1 -> return IsPromoted + _ -> fail "Binary(IsPromoted): fail)" + instance Binary Fingerprint where put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2 get h = do w1 <- get h; w2 <- get h; return (Fingerprint w1 w2) diff --git a/testsuite/tests/dependent/should_fail/PromotedClass.stderr b/testsuite/tests/dependent/should_fail/PromotedClass.stderr index 4da1a32fca..9f8d84a410 100644 --- a/testsuite/tests/dependent/should_fail/PromotedClass.stderr +++ b/testsuite/tests/dependent/should_fail/PromotedClass.stderr @@ -2,5 +2,5 @@ PromotedClass.hs:10:15: error: • Data constructor ‘MkX’ cannot be used here (it has an unpromotable context ‘Show a’) - • In the first argument of ‘Proxy’, namely ‘( 'MkX 'True)’ - In the type signature: foo :: Proxy ( 'MkX 'True) + • In the first argument of ‘Proxy’, namely ‘('MkX 'True)’ + In the type signature: foo :: Proxy ('MkX 'True) diff --git a/testsuite/tests/dependent/should_fail/T15245.stderr b/testsuite/tests/dependent/should_fail/T15245.stderr index b41076636f..859fafda8b 100644 --- a/testsuite/tests/dependent/should_fail/T15245.stderr +++ b/testsuite/tests/dependent/should_fail/T15245.stderr @@ -2,6 +2,6 @@ T15245.hs:10:24: error: • Data constructor ‘MkK’ cannot be used here (it comes from a data family instance) - • In the type ‘ 'MkK’ - In the first argument of ‘print’, namely ‘(typeRep @ 'MkK)’ - In the expression: print (typeRep @ 'MkK) + • In the type ‘'MkK’ + In the first argument of ‘print’, namely ‘(typeRep @'MkK)’ + In the expression: print (typeRep @'MkK) diff --git a/testsuite/tests/ghci/scripts/T15898.script b/testsuite/tests/ghci/scripts/T15898.script new file mode 100644 index 0000000000..930b319124 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15898.script @@ -0,0 +1,6 @@ +:set -XDataKinds +import Data.Proxy +undefined :: '() +undefined :: Proxy '() Int +undefined :: [(), ()] +undefined :: '( '[], '[] ) diff --git a/testsuite/tests/ghci/scripts/T15898.stdout b/testsuite/tests/ghci/scripts/T15898.stdout new file mode 100644 index 0000000000..0519ecba6e --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15898.stdout @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 97ae8bb26f..493daa4412 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -288,3 +288,4 @@ test('T15568', normal, ghci_script, ['T15568.script']) test('T15325', normal, ghci_script, ['T15325.script']) test('T15591', normal, ghci_script, ['T15591.script']) test('T15743b', normal, ghci_script, ['T15743b.script']) +test('T15898', normal, ghci_script, ['T15898.script']) diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 4648baa1f1..408f28b4f7 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -145,7 +145,7 @@ [({ DumpParsedAst.hs:9:10-12 } (HsExplicitListTy (NoExt) - (Promoted) + (IsPromoted) []))] (Prefix) ({ DumpParsedAst.hs:9:21-24 } diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index 5c1a03e091..5a35b0037c 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -191,7 +191,7 @@ [({ DumpRenamedAst.hs:12:10-12 } (HsExplicitListTy (NoExt) - (Promoted) + (IsPromoted) []))] (Prefix) ({ DumpRenamedAst.hs:12:21-24 } diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index 71a54b085a..ebbec08ad5 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -377,7 +377,7 @@ ({ KindSigs.hs:26:13-29 } (HsExplicitListTy (NoExt) - (Promoted) + (IsPromoted) [({ KindSigs.hs:26:16-27 } (HsKindSig (NoExt) diff --git a/testsuite/tests/polykinds/PolyKinds07.stderr b/testsuite/tests/polykinds/PolyKinds07.stderr index ce70e7d07a..596cae306e 100644 --- a/testsuite/tests/polykinds/PolyKinds07.stderr +++ b/testsuite/tests/polykinds/PolyKinds07.stderr @@ -1,7 +1,7 @@ -PolyKinds07.hs:10:11: - Data constructor ‘A1’ cannot be used here - (it is defined and used in the same recursive group) - In the first argument of ‘B’, namely ‘ 'A1’ - In the type ‘B 'A1’ - In the definition of data constructor ‘B1’ +PolyKinds07.hs:10:11: error: + • Data constructor ‘A1’ cannot be used here + (it is defined and used in the same recursive group) + • In the first argument of ‘B’, namely ‘'A1’ + In the type ‘B 'A1’ + In the definition of data constructor ‘B1’ diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr index 2309cdaaae..9fb87e9be7 100644 --- a/testsuite/tests/polykinds/T10503.stderr +++ b/testsuite/tests/polykinds/T10503.stderr @@ -13,5 +13,5 @@ T10503.hs:8:6: error: 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/T15116a.stderr b/testsuite/tests/polykinds/T15116a.stderr index 7e4788f5b8..148432f5ca 100644 --- a/testsuite/tests/polykinds/T15116a.stderr +++ b/testsuite/tests/polykinds/T15116a.stderr @@ -2,6 +2,6 @@ T15116a.hs:6:21: error: • Data constructor ‘MkB’ cannot be used here (it is defined and used in the same recursive group) - • In the first argument of ‘Proxy’, namely ‘ 'MkB’ - In the type ‘(Proxy 'MkB)’ + • In the first argument of ‘Proxy’, namely ‘'MkB’ + In the type ‘(Proxy 'MkB)’ In the definition of data constructor ‘MkB’ diff --git a/testsuite/tests/polykinds/T7433.stderr b/testsuite/tests/polykinds/T7433.stderr index 4dce12a653..317a9a4595 100644 --- a/testsuite/tests/polykinds/T7433.stderr +++ b/testsuite/tests/polykinds/T7433.stderr @@ -2,5 +2,5 @@ T7433.hs:2:10: error: • Data constructor ‘Z’ cannot be used here (perhaps you intended to use DataKinds) - • In the type ‘ 'Z’ + • In the type ‘'Z’ In the type declaration for ‘T’ diff --git a/testsuite/tests/printer/T14343.stderr b/testsuite/tests/printer/T14343.stderr index 1bceb67403..5865669302 100644 --- a/testsuite/tests/printer/T14343.stderr +++ b/testsuite/tests/printer/T14343.stderr @@ -13,8 +13,8 @@ T14343.hs:10:9: error: T14343.hs:11:9: error: • Found hole: _ :: Proxy '[ '[1]] - • In the expression: _ :: Proxy '['[1]] - In an equation for ‘test2’: test2 = _ :: Proxy '['[1]] + • In the expression: _ :: Proxy '[ '[1]] + In an equation for ‘test2’: test2 = _ :: Proxy '[ '[1]] • Relevant bindings include test2 :: Proxy '[ '[1]] (bound at T14343.hs:11:1) Valid hole fits include @@ -25,8 +25,8 @@ T14343.hs:11:9: error: T14343.hs:12:9: error: • Found hole: _ :: Proxy '[ '("Symbol", 1)] - • In the expression: _ :: Proxy '['("Symbol", 1)] - In an equation for ‘test3’: test3 = _ :: Proxy '['("Symbol", 1)] + • In the expression: _ :: Proxy '[ '("Symbol", 1)] + In an equation for ‘test3’: test3 = _ :: Proxy '[ '("Symbol", 1)] • Relevant bindings include test3 :: Proxy '[ '("Symbol", 1)] (bound at T14343.hs:12:1) Valid hole fits include diff --git a/testsuite/tests/printer/T14343b.stderr b/testsuite/tests/printer/T14343b.stderr index 1954f9465a..7573169414 100644 --- a/testsuite/tests/printer/T14343b.stderr +++ b/testsuite/tests/printer/T14343b.stderr @@ -1,8 +1,8 @@ T14343b.hs:10:9: error: • Found hole: _ :: Proxy '( 'True, 'False) - • In the expression: _ :: Proxy '( 'True, 'False) - In an equation for ‘test1’: test1 = _ :: Proxy '( 'True, 'False) + • In the expression: _ :: Proxy '( 'True, 'False) + In an equation for ‘test1’: test1 = _ :: Proxy '( 'True, 'False) • Relevant bindings include test1 :: Proxy '( 'True, 'False) (bound at T14343b.hs:10:1) Valid hole fits include @@ -13,9 +13,9 @@ T14343b.hs:10:9: error: T14343b.hs:11:9: error: • Found hole: _ :: Proxy '( '( 'True, 'False), 'False) - • In the expression: _ :: Proxy '('( 'True, 'False), 'False) + • In the expression: _ :: Proxy '( '( 'True, 'False), 'False) In an equation for ‘test2’: - test2 = _ :: Proxy '('( 'True, 'False), 'False) + test2 = _ :: Proxy '( '( 'True, 'False), 'False) • Relevant bindings include test2 :: Proxy '( '( 'True, 'False), 'False) (bound at T14343b.hs:11:1) @@ -28,8 +28,8 @@ T14343b.hs:11:9: error: T14343b.hs:12:9: error: • Found hole: _ :: Proxy '( '[1], 'False) - • In the expression: _ :: Proxy '('[1], 'False) - In an equation for ‘test3’: test3 = _ :: Proxy '('[1], 'False) + • In the expression: _ :: Proxy '( '[1], 'False) + In an equation for ‘test3’: test3 = _ :: Proxy '( '[1], 'False) • Relevant bindings include test3 :: Proxy '( '[1], 'False) (bound at T14343b.hs:12:1) Valid hole fits include diff --git a/testsuite/tests/typecheck/should_fail/T14607.stderr b/testsuite/tests/typecheck/should_fail/T14607.stderr index 740f89a0d4..5e0b66a340 100644 --- a/testsuite/tests/typecheck/should_fail/T14607.stderr +++ b/testsuite/tests/typecheck/should_fail/T14607.stderr @@ -1,14 +1,14 @@ T14607.hs:22:9: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Expecting one more argument to ‘LamCons a '()’ - Expected a type, but ‘LamCons a '()’ has kind ‘() -> *’ - • In the type signature: mk :: LamCons a '() + • Expecting one more argument to ‘LamCons a '()’ + Expected a type, but ‘LamCons a '()’ has kind ‘() -> *’ + • In the type signature: mk :: LamCons a '() In the instance declaration for ‘Mk a’ T14607.hs:22:19: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Expected a type, but ‘ '()’ has kind ‘()’ - • In the second argument of ‘LamCons’, namely ‘ '()’ - In the type signature: mk :: LamCons a '() + • Expected a type, but ‘'()’ has kind ‘()’ + • In the second argument of ‘LamCons’, namely ‘'()’ + In the type signature: mk :: LamCons a '() In the instance declaration for ‘Mk a’ T14607.hs:23:8: warning: [-Wdeferred-type-errors (in -Wdefault)] -- cgit v1.2.1