Marge Bot pushed to branch master 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
    ... ... @@ -137,7 +137,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
    137 137
            ; (tclvl, wanted, ((lpat', args), pat_ty))
    
    138 138
                 <- pushLevelAndCaptureConstraints      $
    
    139 139
                    tcInferPat FRRPatSynArg PatSynCtx lpat $
    
    140
    -               mapM tcLookupId arg_names
    
    140
    +               mapM tcLookupPatSynArg arg_names
    
    141 141
     
    
    142 142
            ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
    
    143 143
     
    
    ... ... @@ -472,7 +472,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
    472 472
                -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
    
    473 473
                -- Else the error message location is wherever tcCheckPat finished,
    
    474 474
                -- namely the right-hand corner of the pattern
    
    475
    -        do { arg_id <- tcLookupId arg_name
    
    475
    +        do { arg_id <- tcLookupPatSynArg arg_name
    
    476 476
                ; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
    
    477 477
                                         GenSigCtxt
    
    478 478
                                         (idType arg_id)
    
    ... ... @@ -645,6 +645,19 @@ collectPatSynArgInfo details =
    645 645
         InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
    
    646 646
         RecCon _ names         -> (map (unLoc . recordPatSynPatVar) names, False)
    
    647 647
     
    
    648
    +-- | Look up the 'Id' bound by the pattern for a declared argument of a pattern
    
    649
    +-- synonym. With @RequiredTypeArguments@ the argument may turn out to be a type
    
    650
    +-- variable, e.g. @pattern P x = MkT x@ where the argument of @MkT@ is a required
    
    651
    +-- type argument; then we report an illegal term-level use of @x@ (#27586).
    
    652
    +tcLookupPatSynArg :: Name -> TcM Id
    
    653
    +tcLookupPatSynArg arg_name
    
    654
    +  = do { thing <- tcLookup arg_name
    
    655
    +       ; case thing of
    
    656
    +           ATcId { tct_id = id } -> return id
    
    657
    +           AGlobal (AnId id)     -> return id
    
    658
    +           ATyVar {}             -> failIllegalTyVar (noUserRdr arg_name)
    
    659
    +           _                     -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
    
    660
    +
    
    648 661
     wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
    
    649 662
     wrongNumberOfParmsErr name decl_arity missing
    
    650 663
       = 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
    ... ... @@ -35,3 +35,6 @@ test('T25127_fail_arity', normal, compile_fail, [''])
    35 35
     
    
    36 36
     test('T27440e', normal, compile_fail, [''])
    
    37 37
     test('T27583f', normal, compile_fail, [''])
    
    38
    +test('T27586a', normal, compile_fail, [''])
    
    39
    +test('T27586b', normal, compile_fail, [''])
    
    40
    +test('T27586c', normal, compile_fail, [''])