Vladislav Zavialov pushed to branch wip/int-index/rta-patsyn at Glasgow Haskell Compiler / GHC

Commits:

22 changed files:

Changes:

  • changelog.d/T27440
    1 
    +section: compiler
    2 
    +issues: #27440
    3 
    +mrs: !16434
    4 
    +synopsis:
    5 
    +  Fix a panic on ``@ty`` in a pattern synonym RHS
    6 
    +description:
    7 
    +  An invisible type argument (``@ty``) in the right-hand side of an implicitly
    8 
    +  bidirectional pattern synonym no longer causes a panic. The type is ignored
    9 
    +  when the right-hand side is converted to an expression, just as a pattern
    10 
    +  signature has long been (#9867).

  • changelog.d/T27583
    1 
    +section: compiler
    2 
    +issues: #27583
    3 
    +mrs: !16434
    4 
    +synopsis:
    5 
    +  Fix spurious out-of-scope errors from ``type ty`` in a pattern synonym RHS
    6 
    +description:
    7 
    +  A required type argument (``type ty``) in the right-hand side of an implicitly
    8 
    +  bidirectional pattern synonym no longer reports variables bound by the pattern
    9 
    +  as out of scope. The type is ignored when the right-hand side is converted to
    10 
    +  an expression, and GHC infers it from the context instead.

  • compiler/GHC/Tc/Gen/Pat.hs
    ... ... @@ -16,6 +16,7 @@ module GHC.Tc.Gen.Pat
    16 16 
        , tcCheckPat, tcCheckPat_O, tcInferPat
    17 17 
        , tcMatchPats
    18 18 
        , addDataConStupidTheta
    19 
    +   , zipPatsBndrs
    19 20 
        )
    20 21 
     where
    21 22
    ... ... @@ -1727,7 +1728,7 @@ split_con_ty_args :: LexicalFixity -- How to wrap value arguments
    1727 1728 
                              , [(HsTyPat GhcRn, TyVar)]   -- Existentials
    1728 1729 
                              , HsConPatDetails GhcRn )    -- Value arguments
    1729 1730 
     split_con_ty_args fixity con_like arg_pats = do
    1730 
    -  (bndr_ty_arg_prs, value_args) <- zip_pats_bndrs arg_pats (conLikeUserTyVarBinders con_like)
    1731 
    +  (bndr_ty_arg_prs, value_args) <- zipPatsBndrs arg_pats (conLikeUserTyVarBinders con_like)
    1731 1732 
       return $ if null ex_tvs  -- Short cut common case
    1732 1733 
                then (bndr_ty_arg_prs, [], mk_details fixity value_args)
    1733 1734 
                else let (ex_prs, univ_prs) = partition is_existential bndr_ty_arg_prs
    ... ... @@ -1743,24 +1744,30 @@ split_con_ty_args fixity con_like arg_pats = do
    1743 1744 
           -- InfixCon becomes PrefixCon if there are fewer than 2 value arguments.
    1744 1745 
           -- Test case: T25127_infix
    1745 1746
    1746 
    -zip_pats_bndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn])
    1747 
    -zip_pats_bndrs (L loc pat : pats) (Bndr tv vis : tvbs)
    1747 
    +-- | Line the arguments of a 'ConPat' up against the 'TyVarBinder's of its
    1748 
    +-- 'ConLike', returning the type arguments with the binders they instantiate,
    1749 
    +-- and the remaining value arguments.
    1750 
    +--
    1751 
    +-- Precondition: 'check_con_pat_arity' has passed for these arguments, so that
    1752 
    +-- we never run out of patterns while a required binder remains.
    1753 
    +zipPatsBndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn])
    1754 
    +zipPatsBndrs (L loc pat : pats) (Bndr tv vis : tvbs)
    1748 1755 
       | isVisibleForAllTyFlag vis
    1749 1756 
       = do { tp <- setSrcSpanA loc $ pat_to_type_pat pat
    1750 
    -       ; (prs, pats') <- zip_pats_bndrs pats tvbs
    1757 
    +       ; (prs, pats') <- zipPatsBndrs pats tvbs
    1751 1758 
            ; return ((tp, tv) : prs, pats') }
    1752 1759 
       | InvisPat pat_spec tp <- pat
    1753 1760 
       , Invisible spec <- vis
    1754 1761 
       , pat_spec == spec
    1755 
    -  = do { (prs, pats') <- zip_pats_bndrs pats tvbs
    1762 
    +  = do { (prs, pats') <- zipPatsBndrs pats tvbs
    1756 1763 
            ; return ((tp, tv):prs, pats') }
    1757 
    -zip_pats_bndrs pats (Bndr _ vis : tvbs)
    1758 
    -  -- zip_pats_bndrs [] (Bndr _ Required : tvbs)
    1764 
    +zipPatsBndrs pats (Bndr _ vis : tvbs)
    1765 
    +  -- zipPatsBndrs [] (Bndr _ Required : tvbs)
    1759 1766 
       --   is ruled out by the arity check in splitConTyArgs,
    1760 1767 
       --   so we can assume (isInvisibleForAllTyFlag vis)
    1761 1768 
       = do { massert (isInvisibleForAllTyFlag vis)
    1762 
    -       ; zip_pats_bndrs pats tvbs }
    1763 
    -zip_pats_bndrs pats [] = return ([], pats)
    1769 
    +       ; zipPatsBndrs pats tvbs }
    1770 
    +zipPatsBndrs pats [] = return ([], pats)
    1764 1771
    1765 1772 
     tcConTyArgs :: Subst -> PatEnv -> [(HsTyPat GhcRn, TyVar)]
    1766 1773 
                 -> TcM a -> TcM a

  • compiler/GHC/Tc/TyCl/PatSyn.hs
    ... ... @@ -940,11 +940,9 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name)
    940 940 
       | isUnidirectional dir
    941 941 
       = return []
    942 942
    943 
    -  | Left why <- mb_match_group       -- Can't invert the pattern
    944 
    -  = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why
    945 
    -
    946 
    -  | Right match_group <- mb_match_group  -- Bidirectional
    947 
    -  = do { patsyn <- tcLookupPatSyn ps_name
    943 
    +  | otherwise                        -- Bidirectional
    944 
    +  = do { match_group <- get_match_group
    945 
    +       ; patsyn <- tcLookupPatSyn ps_name
    948 946 
            ; case patSynBuilder patsyn of {
    949 947 
                Nothing -> return [] ;
    950 948 
                  -- This case happens if we found a type error in the
    ... ... @@ -985,10 +983,10 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name)
    985 983 
            ; return builder_binds } } }
    986 984
    987 985 
       where
    988 
    -    mb_match_group
    986 
    +    get_match_group
    989 987 
            = case dir of
    990 
    -           ExplicitBidirectional explicit_mg -> Right explicit_mg
    991 
    -           ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat)
    988 
    +           ExplicitBidirectional explicit_mg -> return explicit_mg
    989 
    +           ImplicitBidirectional -> mk_mg <$> tcPatToExpr ps_name args lpat
    992 990 
                Unidirectional -> panic "tcPatSynBuilderBind"
    993 991
    994 992 
         mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
    ... ... @@ -1032,44 +1030,53 @@ add_void need_dummy_arg ty
    1032 1030 
       | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty
    1033 1031 
       | otherwise      = ty
    1034 1032
    1035 
    -tcPatToExpr :: [LocatedN Name] -> LPat GhcRn
    1036 
    -            -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    1033 
    +tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -> TcM (LHsExpr GhcRn)
    1037 1034 
     -- Given a /pattern/, return an /expression/ that builds a value
    1038 1035 
     -- that matches the pattern.  E.g. if the pattern is (Just [x]),
    1039 1036 
     -- the expression is (Just [x]).  They look the same, but the
    1040 1037 
     -- input uses constructors from HsPat and the output uses constructors
    1041 1038 
     -- from HsExpr.
    1042 1039 
     --
    1043 
    --- Returns (Left r) if the pattern is not invertible, for reason r.
    1040 
    +-- Fails with TcRnPatSynInvalidRhs if the pattern is not invertible.
    1044 1041 
     -- See Note [Builder for a bidirectional pattern synonym]
    1045 
    -tcPatToExpr args pat = go pat
    1042 
    +tcPatToExpr ps_name args pat = go pat
    1046 1043 
       where
    1047 1044 
         lhsVars = mkNameSet (map unLoc args)
    1048 1045
    1046 
    +    invalidRhs :: PatSynInvalidRhsReason -> TcM a
    1047 
    +    invalidRhs why = setSrcSpan (getLocA pat) $
    1048 
    +                     failWithTc $ TcRnPatSynInvalidRhs ps_name pat args why
    1049 
    +
    1049 1050 
         -- Make a prefix con for prefix and infix patterns for simplicity
    1050 1051 
         mkPrefixConExpr :: LocatedN (WithUserRdr Name)
    1051 1052 
                         -> [LPat GhcRn]
    1052 
    -                    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    1053 
    -    mkPrefixConExpr lcon@(L loc _) pats
    1054 
    -      = do { exprs <- mapM go pats
    1053 
    +                    -> TcM (HsExpr GhcRn)
    1054 
    +    mkPrefixConExpr lcon@(L loc con_name) pats
    1055 
    +      = do { con_like <- tcLookupConLike con_name
    1056 
    +           ; let tvbs = conLikeUserTyVarBinders con_like
    1057 
    +           ; (_ty_pats, val_pats) <- zipPatsBndrs pats tvbs
    1058 
    +                -- Type arguments _ty_pats are discarded, just like the SigPat's type.
    1059 
    +                -- See Note [Discarding types in the builder expression]
    1060 
    +           ; let ty_exprs = [wildCardTyArg | tvb <- tvbs, isVisibleForAllTyBinder tvb]
    1061 
    +                -- Placeholders (type _) for the discarded required type arguments.
    1062 
    +           ; val_exprs <- mapM go val_pats
    1055 1063 
                ; let con = L (l2l loc) (HsVar noExtField lcon)
    1056 
    -           ; return (unLoc $ mkHsApps con exprs)
    1057 
    -           }
    1064 
    +           ; return (unLoc $ mkHsApps con (ty_exprs ++ val_exprs)) }
    1058 1065
    1059 1066 
         mkRecordConExpr :: LocatedN (WithUserRdr Name)
    1060 1067 
                         -> HsRecFields GhcRn (LPat GhcRn)
    1061 
    -                    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    1068 
    +                    -> TcM (HsExpr GhcRn)
    1062 1069 
         mkRecordConExpr con (HsRecFields x fields dd)
    1063 1070 
           = do { exprFields <- mapM go' fields
    1064 1071 
                ; return (RecordCon noExtField con (HsRecFields x exprFields dd)) }
    1065 1072
    1066 
    -    go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn))
    1073 
    +    go' :: LHsRecField GhcRn (LPat GhcRn) -> TcM (LHsRecField GhcRn (LHsExpr GhcRn))
    1067 1074 
         go' (L l rf) = L l <$> traverse go rf
    1068 1075
    1069 
    -    go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    1076 
    +    go :: LPat GhcRn -> TcM (LHsExpr GhcRn)
    1070 1077 
         go (L loc p) = L loc <$> go1 p
    1071 1078
    1072 
    -    go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    1079 
    +    go1 :: Pat GhcRn -> TcM (HsExpr GhcRn)
    1073 1080 
         go1 (ConPat NoExtField con info)
    1074 1081 
           = case info of
    1075 1082 
               PrefixCon _ ps   -> mkPrefixConExpr con ps
    ... ... @@ -1077,13 +1084,13 @@ tcPatToExpr args pat = go pat
    1077 1084 
               RecCon _ fields  -> mkRecordConExpr con fields
    1078 1085
    1079 1086 
         go1 (SigPat _ pat _) = go1 (unLoc pat)
    1080 
    -        -- See Note [Type signatures and the builder expression]
    1087 
    +        -- See Note [Discarding types in the builder expression]
    1081 1088
    1082 1089 
         go1 (VarPat _ (L l var))
    1083 1090 
             | var `elemNameSet` lhsVars
    1084 1091 
             = return $ mkHsVar (L l var)
    1085 1092 
             | otherwise
    1086 
    -        = Left (PatSynUnboundVar var)
    1093 
    +        = invalidRhs (PatSynUnboundVar var)
    1087 1094 
         go1 (ParPat _ pat) = fmap (HsPar noExtField) (go pat)
    1088 1095 
         go1 (ListPat _ pats)
    1089 1096 
           = do { exprs <- mapM go pats
    ... ... @@ -1104,10 +1111,7 @@ tcPatToExpr args pat = go pat
    1104 1111 
             | otherwise                 = return $ HsOverLit noExtField n
    1105 1112 
         go1 (SplicePat (HsUntypedSpliceTop _ pat) _) = go1 pat
    1106 1113 
         go1 (SplicePat (HsUntypedSpliceNested _) _)  = panic "tcPatToExpr: invalid nested splice"
    1107 
    -    go1 (EmbTyPat _ tp) = return $ HsEmbTy noExtField (hstp_to_hswc tp)
    1108 
    -      where hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn
    1109 
    -            hstp_to_hswc (HsTP { hstp_ext = HsTPRn { hstp_nwcs = wcs }, hstp_body = hs_ty })
    1110 
    -                        = HsWC { hswc_ext = wcs, hswc_body = hs_ty }
    1114 
    +    go1 (EmbTyPat _ _tp) = panic "tcPatToExpr: invalid type pattern"
    1111 1115 
         go1 (InvisPat _ _tp) = panic "tcPatToExpr: invalid invisible pattern"
    1112 1116 
         go1 (XPat (HsPatExpanded _ pat))= go1 pat
    1113 1117
    ... ... @@ -1131,7 +1135,13 @@ tcPatToExpr args pat = go pat
    1131 1135 
         go1 p@(NPlusKPat {})                     = notInvertible p
    1132 1136 
         go1 p@(OrPat {})                         = notInvertible p
    1133 1137
    1134 
    -    notInvertible p = Left (PatSynNotInvertible p)
    1138 
    +    notInvertible p = invalidRhs (PatSynNotInvertible p)
    1139 
    +
    1140 
    +-- See Note [Discarding types in the builder expression]
    1141 
    +wildCardTyArg :: LHsExpr GhcRn
    1142 
    +wildCardTyArg = wrapGenSpan e
    1143 
    +  where e = HsEmbTy noExtField (mkEmptyWildCardBndrs (noLocA t))
    1144 
    +        t = HsWildCardTy (HoleVar (noLocA unnamedHoleRdrName))
    1135 1145
    1136 1146 
     {- Note [Builder for a bidirectional pattern synonym]
    1137 1147 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -1203,9 +1213,17 @@ one could write a nonsensical function like
    1203 1213 
     or
    1204 1214 
             g (K (Just True) False) = ...
    1205 1215
    1206 
    -Note [Type signatures and the builder expression]
    1216 
    +Note [Discarding types in the builder expression]
    1207 1217 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1218 
    +The RHS of an implicitly bidirectional pattern synonym may mention types in
    1219 
    +three ways: a pattern signature (p :: ty), an invisible type argument (@ty),
    1220 
    +and a required type argument (type ty).  Required type arguments may be obscured
    1221 
    +by the omission of the `type` keyword.
    1222 
    +
    1223 
    +A type may /bind/ variables when it occurs in a pattern, and those binders have
    1224 
    +no counterpart in the builder's scope, so tcPatToExpr must not carry them over.
    1208 1225 
     Consider
    1226 
    +
    1209 1227 
        pattern L x = Left x :: Either [a] [b]
    1210 1228
    1211 1229 
     In tc{Infer/Check}PatSynDecl we will check that the pattern has the
    ... ... @@ -1223,6 +1241,43 @@ latter; #9867.) No, the job of the signature is done, so when
    1223 1241 
     converting the pattern to an expression (for the builder RHS) we
    1224 1242 
     simply discard the signature.
    1225 1243
    1244 
    +The same reasoning applies to the other two forms, but the way we discard
    1245 
    +them differs.  Which form an argument takes is not apparent from the pattern
    1246 
    +alone: in
    1247 
    +
    1248 
    +     pattern P x = MkT a x
    1249 
    +
    1250 
    +'a' looks like an ordinary variable pattern, and only the TyVarBinders in
    1251 
    +MkT's type say that it stands in a required type argument position.  We get
    1252 
    +those binders from the typechecked ConLike, via conLikeUserTyVarBinders, so
    1253 
    +mkPrefixConExpr must look the constructor up before it can walk the arguments.
    1254 
    +It then lines them up against the binders with zipPatsBndrs, exactly as
    1255 
    +tcConPat does for the pattern itself, and treats them accordingly:
    1256 
    +
    1257 
    +* Invisible type arguments (@ty) are dropped from the argument list
    1258 
    +  altogether.  Given
    1259 
    +
    1260 
    +     pattern Q x = MkT @a x
    1261 
    +
    1262 
    +  the builder is $bQ x = MkT x.  Dropping is safe because the argument
    1263 
    +  instantiates either a universal, which the expected type of the builder
    1264 
    +  already pins down, or an existential, which cannot take a concrete type
    1265 
    +  in a pattern anyway. Improper handling of type arguments led to #27440.
    1266 
    +
    1267 
    +* Required type arguments cannot be dropped, as that would change the syntactic
    1268 
    +  arity of the application. Instead, we replace them with placeholders (type _),
    1269 
    +  the equivalent of @_ for invisible type arguments.  Given
    1270 
    +
    1271 
    +     pattern R x = MkT (type a) x
    1272 
    +     pattern P x = MkT a x
    1273 
    +
    1274 
    +  the builders are $bR x = MkT (type _) x and $bP x = MkT (type _) x, and the
    1275 
    +  wildcard is solved from the expected type.  Retaining the type would mention a
    1276 
    +  binder that is not in scope in the builder (#27583).
    1277 
    +
    1278 
    +In all three cases the pattern has already been checked by the time the
    1279 
    +builder is built, so no information is lost by forgetting these types.
    1280 
    +
    1226 1281 
     Note [Record PatSyn Desugaring]
    1227 1282 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1228 1283 
     It is important that prov_theta comes before req_theta as this ordering is used

  • testsuite/tests/patsyn/should_compile/T27440a.hs
    1 
    +{-# LANGUAGE DataKinds, PatternSynonyms, TypeAbstractions #-}
    2 
    +module T27440a where
    3 
    +
    4 
    +import Data.Kind (Type)
    5 
    +
    6 
    +newtype Lit = Lit { litName :: String }
    7 
    +
    8 
    +type LitOfValue :: Bool -> Type
    9 
    +newtype LitOfValue v = LitOfValue { underlyingLit :: Lit }
    10 
    +
    11 
    +pattern FalseLit :: Lit -> LitOfValue False
    12 
    +pattern FalseLit a = LitOfValue @False a

  • testsuite/tests/patsyn/should_compile/T27440b.hs
    1 
    +{-# LANGUAGE PatternSynonyms, TypeAbstractions #-}
    2 
    +module T27440b where
    3 
    +
    4 
    +data T a = MkT a
    5 
    +
    6 
    +pattern P :: a -> T a
    7 
    +pattern P x = MkT @a x

  • testsuite/tests/patsyn/should_compile/T27440c.hs
    1 
    +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-}
    2 
    +module T27440c where
    3 
    +
    4 
    +data S = forall a. Show a => MkS a
    5 
    +
    6 
    +pattern P :: () => Show a => a -> S
    7 
    +pattern P x = MkS @a x

  • testsuite/tests/patsyn/should_compile/all.T
    ... ... @@ -90,3 +90,7 @@ test('T23038', normal, compile_fail, [''])
    90 90 
     test('T22328', normal, compile, [''])
    91 91 
     test('T26331', normal, compile, [''])
    92 92 
     test('T26331a', normal, compile, [''])
    93 
    +
    94 
    +test('T27440a', normal, compile, [''])
    95 
    +test('T27440b', normal, compile, [''])
    96 
    +test('T27440c', normal, compile, [''])

  • testsuite/tests/patsyn/should_fail/T27440d.hs
    1 
    +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, TypeAbstractions #-}
    2 
    +module T27440d where
    3 
    +
    4 
    +data S = forall a. Show a => MkS a
    5 
    +
    6 
    +pattern P :: Show a => a -> S
    7 
    +pattern P x = MkS @a x

  • testsuite/tests/patsyn/should_fail/T27440d.stderr
    1 
    +T27440d.hs:7:22: error: [GHC-25897]
    2 
    +    • Couldn't match expected type ‘a’ with actual type ‘a1’
    3 
    +      ‘a1’ is a rigid type variable bound by
    4 
    +        a pattern with constructor: MkS :: forall a. Show a => a -> S,
    5 
    +        in a pattern synonym declaration
    6 
    +        at T27440d.hs:7:15-22
    7 
    +      ‘a’ is a rigid type variable bound by
    8 
    +        the signature for pattern synonym ‘P’
    9 
    +        at T27440d.hs:6:14-29
    10 
    +    • In the declaration for pattern synonym ‘P’
    11 
    +    • Relevant bindings include x :: a1 (bound at T27440d.hs:7:22)
    12 
    +

  • testsuite/tests/patsyn/should_fail/all.T
    ... ... @@ -55,3 +55,5 @@ test('patsyn_where_fail1', normal, compile_fail, [''])
    55 55 
     test('patsyn_where_fail2', normal, compile_fail, [''])
    56 56 
     test('patsyn_where_fail3', normal, compile_fail, [''])
    57 57 
     test('patsyn_where_fail4', normal, compile_fail, [''])
    58 
    +
    59 
    +test('T27440d', normal, compile_fail, [''])

  • testsuite/tests/vdq-rta/should_compile/T27583a.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583a where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> T a
    6 
    +
    7 
    +pattern P :: T a
    8 
    +pattern P = MkT (type a)

  • testsuite/tests/vdq-rta/should_compile/T27583b.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583b where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> T a
    6 
    +
    7 
    +pattern P :: T a
    8 
    +pattern P = MkT a

  • testsuite/tests/vdq-rta/should_compile/T27583c.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583c where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> T a
    6 
    +
    7 
    +pattern P :: T Int
    8 
    +pattern P = MkT (type Int)

  • testsuite/tests/vdq-rta/should_compile/T27583d.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583d where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> a -> T a
    6 
    +
    7 
    +-- A required type argument is checked against the signature, with or without
    8 
    +-- the 'type' herald. The variable/wildcard patterns x, _, (type x), (type _)
    9 
    +-- can't mismatch the signature. Concrete types are in T27583e and T27583f.
    10 
    +
    11 
    +pattern P1 :: Int -> T Int
    12 
    +pattern P1 n = MkT x n
    13 
    +
    14 
    +pattern P2 :: Int -> T Int
    15 
    +pattern P2 n = MkT (type x) n
    16 
    +
    17 
    +pattern P3 :: Int -> T Int
    18 
    +pattern P3 n = MkT _ n
    19 
    +
    20 
    +pattern P4 :: Int -> T Int
    21 
    +pattern P4 n = MkT (type _) n

  • testsuite/tests/vdq-rta/should_compile/T27583e.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583e where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> a -> T a
    6 
    +
    7 
    +-- A required type argument is checked against the signature, with or without
    8 
    +-- the 'type' herald. Here the type written in that position agrees with the
    9 
    +-- signature. T27583f is the same four patterns with a type that does not.
    10 
    +
    11 
    +pattern P1 :: Int -> T Int
    12 
    +pattern P1 n = MkT Int n
    13 
    +
    14 
    +pattern P2 :: Int -> T Int
    15 
    +pattern P2 n = MkT (type Int) n
    16 
    +
    17 
    +pattern P3 :: Maybe Int -> T (Maybe Int)
    18 
    +pattern P3 n = MkT (Maybe Int) n
    19 
    +
    20 
    +pattern P4 :: Maybe Int -> T (Maybe Int)
    21 
    +pattern P4 n = MkT (type (Maybe Int)) n

  • testsuite/tests/vdq-rta/should_compile/all.T
    ... ... @@ -39,3 +39,9 @@ test('T23738_th', req_th, compile, [''])
    39 39 
     test('T24159_viewpat', normal, compile, [''])
    40 40 
     test('T24159_type_syntax', normal, compile, [''])
    41 41 
     test('T24159_th_type_syntax', req_th, compile, [''])
    42 
    +
    43 
    +test('T27583a', normal, compile, [''])
    44 
    +test('T27583b', normal, compile, [''])
    45 
    +test('T27583c', normal, compile, [''])
    46 
    +test('T27583d', normal, compile, [''])
    47 
    +test('T27583e', normal, compile, [''])

  • testsuite/tests/vdq-rta/should_fail/T27440e.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms, TypeAbstractions #-}
    2 
    +module T27440e where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> T a
    6 
    +
    7 
    +pattern P :: a -> T a
    8 
    +pattern P x = MkT @a x

  • testsuite/tests/vdq-rta/should_fail/T27440e.stderr
    1 
    +T27440e.hs:8:19: error: [GHC-88754]
    2 
    +    • Ill-formed type pattern: @a
    3 
    +    • In the pattern: MkT @a x
    4 
    +      In the declaration for pattern synonym ‘P’
    5 
    +

  • testsuite/tests/vdq-rta/should_fail/T27583f.hs
    1 
    +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
    2 
    +module T27583f where
    3 
    +
    4 
    +data T a where
    5 
    +  MkT :: forall a -> a -> T a
    6 
    +
    7 
    +-- A required type argument is checked against the signature, with or without
    8 
    +-- the 'type' herald. Here the type written in that position does not agree
    9 
    +-- with the signature. T27583e is the same four patterns with a type that does.
    10 
    +
    11 
    +pattern P1 :: Int -> T Int
    12 
    +pattern P1 n = MkT Bool n
    13 
    +
    14 
    +pattern P2 :: Int -> T Int
    15 
    +pattern P2 n = MkT (type Bool) n
    16 
    +
    17 
    +pattern P3 :: Maybe Int -> T (Maybe Int)
    18 
    +pattern P3 n = MkT (Maybe Bool) n
    19 
    +
    20 
    +pattern P4 :: Maybe Int -> T (Maybe Int)
    21 
    +pattern P4 n = MkT (type (Maybe Bool)) n

  • testsuite/tests/vdq-rta/should_fail/T27583f.stderr
    1 
    +T27583f.hs:12:16: error: [GHC-83865]
    2 
    +    • Couldn't match expected type ‘Int’ with actual type ‘Bool’
    3 
    +    • In the pattern: MkT Bool n
    4 
    +      In the declaration for pattern synonym ‘P1’
    5 
    +
    6 
    +T27583f.hs:15:16: error: [GHC-83865]
    7 
    +    • Couldn't match expected type ‘Int’ with actual type ‘Bool’
    8 
    +    • In the pattern: MkT (type Bool) n
    9 
    +      In the declaration for pattern synonym ‘P2’
    10 
    +
    11 
    +T27583f.hs:18:16: error: [GHC-83865]
    12 
    +    • Couldn't match type ‘Bool’ with ‘Int’
    13 
    +      Expected: Maybe Int
    14 
    +        Actual: Maybe Bool
    15 
    +    • In the pattern: MkT (Maybe Bool) n
    16 
    +      In the declaration for pattern synonym ‘P3’
    17 
    +
    18 
    +T27583f.hs:21:16: error: [GHC-83865]
    19 
    +    • Couldn't match type ‘Bool’ with ‘Int’
    20 
    +      Expected: Maybe Int
    21 
    +        Actual: Maybe Bool
    22 
    +    • In the pattern: MkT (type (Maybe Bool)) n
    23 
    +      In the declaration for pattern synonym ‘P4’
    24 
    +

  • testsuite/tests/vdq-rta/should_fail/all.T
    ... ... @@ -32,3 +32,6 @@ test('T24159_type_syntax_tc_fail', normal, compile_fail, [''])
    32 32 
     test('T24159_type_syntax_th_fail', normal, ghci_script, ['T24159_type_syntax_th_fail.script'])
    33 33 
     test('T25127_fail_th_quote', normal, compile_fail, [''])
    34 34 
     test('T25127_fail_arity', normal, compile_fail, [''])
    35 
    +
    36 
    +test('T27440e', normal, compile_fail, [''])
    37 
    +test('T27583f', normal, compile_fail, [''])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/ef274046512d2d2635f9c11a6957f60961b21cd4 at 1785557624