Smarter HsType pretty-print for promoted datacons
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 15 Nov 2018 09:02:11 +0000 (09:02 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 15 Nov 2018 11:50:52 +0000 (11:50 +0000)
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.

23 files changed:
compiler/basicTypes/BasicTypes.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsTypes.hs
compiler/iface/IfaceType.hs
compiler/iface/TcIface.hs
compiler/iface/ToIface.hs
compiler/parser/Parser.y
compiler/utils/Binary.hs
testsuite/tests/dependent/should_fail/PromotedClass.stderr
testsuite/tests/dependent/should_fail/T15245.stderr
testsuite/tests/ghci/scripts/T15898.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T15898.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
testsuite/tests/parser/should_compile/KindSigs.stderr
testsuite/tests/polykinds/PolyKinds07.stderr
testsuite/tests/polykinds/T10503.stderr
testsuite/tests/polykinds/T15116a.stderr
testsuite/tests/polykinds/T7433.stderr
testsuite/tests/printer/T14343.stderr
testsuite/tests/printer/T14343b.stderr
testsuite/tests/typecheck/should_fail/T14607.stderr

index cf56957..200e5c9 100644 (file)
@@ -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
+
+
 {-
 ************************************************************************
 *                                                                      *
index 06d5d6c..8bd33d6 100644 (file)
@@ -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'
 
index 8200707..f0f71be 100644 (file)
@@ -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@.
index 264dfa0..4d6a3b3 100644 (file)
@@ -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
index 248f7d3..34bcdb7 100644 (file)
@@ -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)
index 653b740..a3d11e8 100644 (file)
@@ -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
 
index 8a10516..f508217 100644 (file)
@@ -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
index a38af74..63efd14 100644 (file)
@@ -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)
index 4da1a32..9f8d84a 100644 (file)
@@ -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)
index b410766..859fafd 100644 (file)
@@ -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 (file)
index 0000000..930b319
--- /dev/null
@@ -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 (file)
index 0000000..0519ecb
--- /dev/null
@@ -0,0 +1 @@
\ No newline at end of file
index 97ae8bb..493daa4 100755 (executable)
@@ -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'])
index 4648baa..408f28b 100644 (file)
              [({ DumpParsedAst.hs:9:10-12 }
                (HsExplicitListTy
                 (NoExt)
-                (Promoted)
+                (IsPromoted)
                 []))]
              (Prefix)
              ({ DumpParsedAst.hs:9:21-24 }
index 5c1a03e..5a35b00 100644 (file)
                [({ DumpRenamedAst.hs:12:10-12 }
                  (HsExplicitListTy
                   (NoExt)
-                  (Promoted)
+                  (IsPromoted)
                   []))]
                (Prefix)
                ({ DumpRenamedAst.hs:12:21-24 }
index 71a54b0..ebbec08 100644 (file)
       ({ KindSigs.hs:26:13-29 }
        (HsExplicitListTy
         (NoExt)
-        (Promoted)
+        (IsPromoted)
         [({ KindSigs.hs:26:16-27 }
           (HsKindSig
            (NoExt)
index ce70e7d..596cae3 100644 (file)
@@ -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’
index 2309cda..9fb87e9 100644 (file)
@@ -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
index 7e4788f..148432f 100644 (file)
@@ -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’
index 4dce12a..317a9a4 100644 (file)
@@ -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’
index 1bceb67..5865669 100644 (file)
@@ -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
index 1954f94..7573169 100644 (file)
@@ -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
index 740f89a..5e0b66a 100644 (file)
@@ -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)]