GitLab

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

Commits:

bc17078d

by Vladislav Zavialov at 2026-08-13T18:09:10+03:00

Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)

The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:

    data T a where
      MkT :: forall a -> T a

    pattern P :: Int -> T Int
    pattern P x = MkT x

On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.

Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.

Test cases: T27586a T27586b T27586c

Assisted-by: Claude Opus 5

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:

changelog.d/T27586

 +section: compiler
 +issues: #27586
 +mrs: !16440
 +synopsis:
 +  Fix a panic on a required type argument in a pattern synonym RHS
 +description:
 +  An argument of a pattern synonym that is matched against a required type
 +  argument in the right-hand side no longer causes a panic; it is reported as
 +  an illegal term-level use of a type variable.

compiler/GHC/Tc/TyCl/PatSyn.hs

@@ -137,7 +137,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
         ; (tclvl, wanted, ((lpat', args), pat_ty))
              <- pushLevelAndCaptureConstraints      $
                 tcInferPat FRRPatSynArg PatSynCtx lpat $
 -               mapM tcLookupId arg_names
 +               mapM tcLookupPatSynArg arg_names
         ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
@@ -472,7 +472,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
             -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
             -- Else the error message location is wherever tcCheckPat finished,
             -- namely the right-hand corner of the pattern
 -        do { arg_id <- tcLookupId arg_name
 +        do { arg_id <- tcLookupPatSynArg arg_name
             ; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
                                      GenSigCtxt
                                      (idType arg_id)
@@ -645,6 +645,19 @@ collectPatSynArgInfo details =
      InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
      RecCon _ names         -> (map (unLoc . recordPatSynPatVar) names, False)
 +-- | Look up the 'Id' bound by the pattern for a declared argument of a pattern
 +-- synonym. With @RequiredTypeArguments@ the argument may turn out to be a type
 +-- variable, e.g. @pattern P x = MkT x@ where the argument of @MkT@ is a required
 +-- type argument; then we report an illegal term-level use of @x@ (#27586).
 +tcLookupPatSynArg :: Name -> TcM Id
 +tcLookupPatSynArg arg_name
 +  = do { thing <- tcLookup arg_name
 +       ; case thing of
 +           ATcId { tct_id = id } -> return id
 +           AGlobal (AnId id)     -> return id
 +           ATyVar {}             -> failIllegalTyVar (noUserRdr arg_name)
 +           _                     -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
++
  wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
  wrongNumberOfParmsErr name decl_arity missing
    = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing

testsuite/tests/vdq-rta/should_fail/T27586a.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586a where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P :: Int -> T Int
 +pattern P x = MkT x

testsuite/tests/vdq-rta/should_fail/T27586a.stderr

 +T27586a.hs:9:19: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586a.hs:9:19
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/T27586b.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586b where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P x = MkT x

testsuite/tests/vdq-rta/should_fail/T27586b.stderr

 +T27586b.hs:8:15: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586b.hs:8:19
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/T27586c.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586c where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P :: Int -> T Int
 +pattern P x <- MkT x

testsuite/tests/vdq-rta/should_fail/T27586c.stderr

 +T27586c.hs:9:20: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586c.hs:9:20
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/all.T

@@ -32,3 +32,6 @@ test('T24159_type_syntax_tc_fail', normal, compile_fail, [''])
  test('T24159_type_syntax_th_fail', normal, ghci_script, ['T24159_type_syntax_th_fail.script'])
  test('T25127_fail_th_quote', normal, compile_fail, [''])
  test('T25127_fail_arity', normal, compile_fail, [''])
 +test('T27586a', normal, compile_fail, [''])
 +test('T27586b', normal, compile_fail, [''])
 +test('T27586c', normal, compile_fail, [''])