Vladislav Zavialov pushed to branch wip/int-index/rta-patsyn-lookup at Glasgow Haskell Compiler / GHC
Commits:
-
e05bd580
by Vladislav Zavialov at 2026-08-01T21:05:04+03:00
9 changed files:
- + changelog.d/T27586
- compiler/GHC/Tc/TyCl/PatSyn.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586b.hs
- + testsuite/tests/vdq-rta/should_fail/T27586b.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586c.hs
- + testsuite/tests/vdq-rta/should_fail/T27586c.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
Changes:
| 1 | +section: compiler
|
|
| 2 | +issues: #27586
|
|
| 3 | +mrs: !16440
|
|
| 4 | +synopsis:
|
|
| 5 | + Fix a panic on a required type argument in a pattern synonym RHS
|
|
| 6 | +description:
|
|
| 7 | + An argument of a pattern synonym that is matched against a required type
|
|
| 8 | + argument in the right-hand side no longer causes a panic; it is reported as
|
|
| 9 | + an illegal term-level use of a type variable. |
| ... | ... | @@ -33,6 +33,7 @@ import GHC.Tc.Utils.TcType |
| 33 | 33 | import GHC.Tc.Types.Evidence
|
| 34 | 34 | import GHC.Tc.Types.Origin
|
| 35 | 35 | import GHC.Tc.Types.ErrCtxt( UserTypeCtxt(..) )
|
| 36 | +import GHC.Tc.Types.BasicTypes( TcTyThing(..) )
|
|
| 36 | 37 | import GHC.Tc.TyCl.Build
|
| 37 | 38 | |
| 38 | 39 | import GHC.Core.Multiplicity
|
| ... | ... | @@ -137,7 +138,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details |
| 137 | 138 | ; (tclvl, wanted, ((lpat', args), pat_ty))
|
| 138 | 139 | <- pushLevelAndCaptureConstraints $
|
| 139 | 140 | tcInferPat FRRPatSynArg PatSynCtx lpat $
|
| 140 | - mapM tcLookupId arg_names
|
|
| 141 | + mapM tcLookupPatSynArg arg_names
|
|
| 141 | 142 | |
| 142 | 143 | ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
|
| 143 | 144 | |
| ... | ... | @@ -472,7 +473,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details |
| 472 | 473 | -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
|
| 473 | 474 | -- Else the error message location is wherever tcCheckPat finished,
|
| 474 | 475 | -- namely the right-hand corner of the pattern
|
| 475 | - do { arg_id <- tcLookupId arg_name
|
|
| 476 | + do { arg_id <- tcLookupPatSynArg arg_name
|
|
| 476 | 477 | ; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
|
| 477 | 478 | GenSigCtxt
|
| 478 | 479 | (idType arg_id)
|
| ... | ... | @@ -645,6 +646,19 @@ collectPatSynArgInfo details = |
| 645 | 646 | InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
|
| 646 | 647 | RecCon _ names -> (map (unLoc . recordPatSynPatVar) names, False)
|
| 647 | 648 | |
| 649 | +tcLookupPatSynArg :: Name -> TcM Id
|
|
| 650 | +-- Look up the Id bound by the pattern for a declared argument of a pattern
|
|
| 651 | +-- synonym. With RequiredTypeArguments the argument may turn out to be a type
|
|
| 652 | +-- variable, e.g. `pattern P x = MkT x` where the argument of MkT is required;
|
|
| 653 | +-- then we report an illegal term-level use of `x` (#27586).
|
|
| 654 | +tcLookupPatSynArg arg_name
|
|
| 655 | + = do { thing <- tcLookup arg_name
|
|
| 656 | + ; case thing of
|
|
| 657 | + ATcId { tct_id = id } -> return id
|
|
| 658 | + AGlobal (AnId id) -> return id
|
|
| 659 | + ATyVar {} -> failIllegalTyVar (noUserRdr arg_name)
|
|
| 660 | + _ -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
|
|
| 661 | + |
|
| 648 | 662 | wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
|
| 649 | 663 | wrongNumberOfParmsErr name decl_arity missing
|
| 650 | 664 | = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing
|
| 1 | +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
|
|
| 2 | + |
|
| 3 | +module T27586a where
|
|
| 4 | + |
|
| 5 | +data T a where
|
|
| 6 | + MkT :: forall a -> T a
|
|
| 7 | + |
|
| 8 | +pattern P :: Int -> T Int
|
|
| 9 | +pattern P x = MkT x |
| 1 | +T27586a.hs:9:19: error: [GHC-01928]
|
|
| 2 | + • Illegal term-level use of the type variable ‘x’
|
|
| 3 | + • bound at T27586a.hs:9:19
|
|
| 4 | + • In the declaration for pattern synonym ‘P’
|
|
| 5 | + |
| 1 | +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
|
|
| 2 | + |
|
| 3 | +module T27586b where
|
|
| 4 | + |
|
| 5 | +data T a where
|
|
| 6 | + MkT :: forall a -> T a
|
|
| 7 | + |
|
| 8 | +pattern P x = MkT x |
| 1 | +T27586b.hs:8:15: error: [GHC-01928]
|
|
| 2 | + • Illegal term-level use of the type variable ‘x’
|
|
| 3 | + • bound at T27586b.hs:8:19
|
|
| 4 | + • In the declaration for pattern synonym ‘P’
|
|
| 5 | + |
| 1 | +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
|
|
| 2 | + |
|
| 3 | +module T27586c where
|
|
| 4 | + |
|
| 5 | +data T a where
|
|
| 6 | + MkT :: forall a -> T a
|
|
| 7 | + |
|
| 8 | +pattern P :: Int -> T Int
|
|
| 9 | +pattern P x <- MkT x |
| 1 | +T27586c.hs:9:20: error: [GHC-01928]
|
|
| 2 | + • Illegal term-level use of the type variable ‘x’
|
|
| 3 | + • bound at T27586c.hs:9:20
|
|
| 4 | + • In the declaration for pattern synonym ‘P’
|
|
| 5 | + |
| ... | ... | @@ -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 | +test('T27586a', normal, compile_fail, [''])
|
|
| 36 | +test('T27586b', normal, compile_fail, [''])
|
|
| 37 | +test('T27586c', normal, compile_fail, ['']) |