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

Commits:

9 changed files:

Changes:

  • changelog.d/T27586
    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.

  • compiler/GHC/Tc/TyCl/PatSyn.hs
    ... ... @@ -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
    

  • testsuite/tests/vdq-rta/should_fail/T27586a.hs
    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

  • testsuite/tests/vdq-rta/should_fail/T27586a.stderr
    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
    +

  • testsuite/tests/vdq-rta/should_fail/T27586b.hs
    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

  • testsuite/tests/vdq-rta/should_fail/T27586b.stderr
    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
    +

  • testsuite/tests/vdq-rta/should_fail/T27586c.hs
    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

  • testsuite/tests/vdq-rta/should_fail/T27586c.stderr
    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
    +

  • 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
    +test('T27586a', normal, compile_fail, [''])
    
    36
    +test('T27586b', normal, compile_fail, [''])
    
    37
    +test('T27586c', normal, compile_fail, [''])