diff options
| author | Zubin Duggal <zubin.duggal@gmail.com> | 2022-01-17 15:43:11 +0530 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-03-16 02:28:24 -0400 |
| commit | a33d10452c261ab39ce8c0954bac9053c212a6cc (patch) | |
| tree | 9844ab433b4400a1466c5e8edd5a929e0a70203f /compiler/GHC/HsToCore/Quote.hs | |
| parent | c1fed9da095303591c37c53bad5f5559381048d7 (diff) | |
| download | haskell-a33d10452c261ab39ce8c0954bac9053c212a6cc.tar.gz | |
TH: allow negative patterns in quotes (#20711)
We still don't allow negative overloaded patterns. Earler all negative patterns
were treated as negative overloaded patterns. Now, we expliclty check the
extension field to see if the pattern is actually a negative overloaded pattern
Diffstat (limited to 'compiler/GHC/HsToCore/Quote.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 9 |
1 files changed, 8 insertions, 1 deletions
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 34282ec363..215b8f4da8 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -2077,7 +2077,14 @@ repP (ConPat NoExtField dc details) repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l ; repPlit a } repP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' } -repP p@(NPat _ _ (Just _) _) = notHandled (ThNegativeOverloadedPatterns p) +repP p@(NPat _ (L _ l) (Just _) _) + | OverLitRn rebindable _ <- ol_ext l + , rebindable = notHandled (ThNegativeOverloadedPatterns p) + | HsIntegral i <- ol_val l = do { a <- repOverloadedLiteral l{ol_val = HsIntegral (negateIntegralLit i)} + ; repPlit a } + | HsFractional i <- ol_val l = do { a <- repOverloadedLiteral l{ol_val = HsFractional (negateFractionalLit i)} + ; repPlit a } + | otherwise = notHandled (ThExoticPattern p) repP (SigPat _ p t) = do { p' <- repLP p ; t' <- repLTy (hsPatSigType t) ; repPsig p' t' } |