[Git][ghc/ghc][wip/or-pats] ppr&tests
David (@knothed)
gitlab at gitlab.haskell.org
Thu Sep 7 14:57:17 UTC 2023
David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC
Commits:
e5ea14ed by David Knothe at 2023-09-07T16:57:04+02:00
ppr&tests
- - - - -
11 changed files:
- compiler/GHC/Parser.y
- testsuite/tests/deSugar/should_run/Or5.hs
- testsuite/tests/parser/should_fail/Or1.stderr
- − testsuite/tests/parser/should_fail/Or2.hs
- − testsuite/tests/parser/should_fail/Or2.stderr
- testsuite/tests/parser/should_fail/all.T
- testsuite/tests/pmcheck/should_compile/pmcOrPats.hs
- testsuite/tests/pmcheck/should_compile/pmcOrPats.stderr
- testsuite/tests/printer/PprOrPat.hs
- testsuite/tests/rename/should_fail/Or3.stderr
- testsuite/tests/typecheck/should_fail/Or4.stderr
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3123,7 +3123,7 @@ orpats :: { [LPat GhcPs] }
-- | texp '|' orpats {% do
| exp ';' orpats {% do
{ pat1 <- (checkPattern <=< runPV) (unECP $1)
- ; pat2 <- addTrailingVbarA pat1 (getLoc $2)
+ ; pat2 <- addTrailingSemiA pat1 (getLoc $2)
; return (pat2:$3) }}
-- Always at least one comma or bar.
@@ -3391,7 +3391,8 @@ pat : exp {% (checkPattern <=< runPV) (unECP $1) }
| pat ';' orpats {%
do { let srcSpan = comb2 (getLocA $1) (getLocA $ last $3)
; cs <- getCommentsFor srcSpan
- ; let orpat = sL (noAnnSrcSpan srcSpan) $ OrPat (EpAnn (spanAsAnchor srcSpan) [] cs) ($1:$3)
+ ; pat1 <- addTrailingSemiA $1 (getLoc $2)
+ ; let orpat = sL (noAnnSrcSpan srcSpan) $ OrPat (EpAnn (spanAsAnchor srcSpan) [] cs) (pat1:$3)
; _ <- hintOrPats orpat
; return $ orpat }}
=====================================
testsuite/tests/deSugar/should_run/Or5.hs
=====================================
@@ -19,24 +19,24 @@ main = do
f1 x = case x of
3 -> 1
4 -> 2
- (3|4|5) -> 3
+ 3;4;5 -> 3
f2 y = case y of
- (_:2:_ | 1:_) | length y /= 2 -> 1
- ([1,2] | 1:3:_)-> 2
- (_ | _) -> 3
+ (_:2:_ ; 1:_) | length y /= 2 -> 1
+ ([1,2] ; 1:3:_)-> 2
+ _ ; _ -> 3
f3 :: (Eq a, Show a) => a -> a -> Bool
-f3 a ((== a) -> True | show -> "8") = True
+f3 a (((== a) -> True) ; (show -> "8")) = True
f3 _ _ = False
-a3 = (\(1 | 2) -> 3) 1
-a4 = (\(Left 0 | Right 1) -> True) (Right 1)
-a5 = (\(([1] | [2, _]) | ([3, _, _] | [4, _, _, _])) -> True) [4, undefined, undefined, undefined]
-a6 = (\(1 | 2 | 3) -> False) 3
+a3 = (\(1 ; 2) -> 3) 1
+a4 = (\(Left 0 ; Right 1) -> True) (Right 1)
+a5 = (\(([1] ; [2, _]) ; ([3, _, _] ; [4, _, _, _])) -> True) [4, undefined, undefined, undefined]
+a6 = (\(1 ; 2 ; 3) -> False) 3
backtrack :: String
backtrack = case (True, error "backtracking") of
- ((True, _) | (_, True))
+ ((True, _) ; (_, True))
| False -> error "inaccessible"
_ -> error "no backtracking"
\ No newline at end of file
=====================================
testsuite/tests/parser/should_fail/Or1.stderr
=====================================
@@ -1,4 +1,4 @@
Or1.hs:4:3: error: [GHC-29847]
- Illegal or-pattern: (2 | 3)
+ Illegal or-pattern: (2; 3)
Suggested fix: Perhaps you intended to use OrPatterns
=====================================
testsuite/tests/parser/should_fail/Or2.hs deleted
=====================================
@@ -1,6 +0,0 @@
-{-# LANGUAGE OrPatterns #-}
-
-module Main where
-
-main = print $ case 3 of
- 4 ; 5 -> False
\ No newline at end of file
=====================================
testsuite/tests/parser/should_fail/Or2.stderr deleted
=====================================
@@ -1,8 +0,0 @@
-
-Or2.hs:6:7: error: [GHC-39999]
- • No instance for ‘Num Bool’ arising from the literal ‘5’
- • In the expression: 5
- In a stmt of a pattern guard for
- a case alternative:
- 5
- In a case alternative: 4 | 5 -> False
=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -217,4 +217,3 @@ test('T21843e', normal, compile_fail, [''])
test('T21843f', normal, compile_fail, [''])
test('Or1', normal, compile_fail, [''])
-test('Or2', normal, compile_fail, [''])
=====================================
testsuite/tests/pmcheck/should_compile/pmcOrPats.hs
=====================================
@@ -5,15 +5,15 @@ data T = A | B
data U = V | W
g :: T -> U -> Int
-g (A|B) V = 0
-g B (V|W) = 1
+g (A;B) V = 0
+g B (V;W) = 1
-h A (_|W) B = 0
-h B (V|_) B = 1
-h (A|B) _ B = 2
+h A (_;W) B = 0
+h B (V;_) B = 1
+h (A;B) _ B = 2
-z (1|2|1) = 0
-z (3|2) = 1
+z (1;2;1) = 0
+z (3;2) = 1
z 1 = 2
main = print 2
\ No newline at end of file
=====================================
testsuite/tests/pmcheck/should_compile/pmcOrPats.stderr
=====================================
@@ -13,7 +13,7 @@ pmcOrPats.hs:11:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
pmcOrPats.hs:13:1: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)]
Pattern match is redundant
- In an equation for ‘h’: h (A | B) _ B = ...
+ In an equation for ‘h’: h (A; B) _ B = ...
pmcOrPats.hs:15:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
=====================================
testsuite/tests/printer/PprOrPat.hs
=====================================
@@ -6,10 +6,11 @@ module Main where
a = case [1] of
[1,2,3] -> True
+ 4 ; 5
( {- 01-}
- {- 12 -} [4, 5] | [6,7] {-test-} | [_,2]
+ {- 12 -} [4, 5] ; [6,7] {-test-} ; [_,2]
) -> False
-pattern A <- (({-test-} reverse -> {-e-}( [2,1] | {-1-} 0:_ )), id -> [])
+pattern A <- (({-test-} reverse -> {-e-}( [2,1] ; {-1-} 0:_ )), id -> [])
b = case [1,2] of A -> True
=====================================
testsuite/tests/rename/should_fail/Or3.stderr
=====================================
@@ -1,13 +1,13 @@
Or3.hs:6:3: error: [GHC-81303]
- An or-pattern may not bind (type) variables nor type class or equality constraints: (Left a
- | Right a)
+ An or-pattern may not bind (type) variables nor type class or equality constraints: (Left a;
+ Right a)
-Or3.hs:9:8: error: [GHC-81303]
- An or-pattern may not bind (type) variables nor type class or equality constraints: (x
- | _)
+Or3.hs:9:7: error: [GHC-81303]
+ An or-pattern may not bind (type) variables nor type class or equality constraints: (x;
+ _)
Or3.hs:12:3: error: [GHC-28418]
An or-pattern may not contain visible type applications: (Just @Int
- 3
- | Nothing)
+ 3;
+ Nothing)
=====================================
testsuite/tests/typecheck/should_fail/Or4.stderr
=====================================
@@ -1,18 +1,18 @@
-Or4.hs:11:17: error: [GHC-39999]
+Or4.hs:11:16: error: [GHC-39999]
• No instance for ‘Num a’ arising from the literal ‘3’
Possible fix:
add (Num a) to the context of
the type signature for:
bar :: forall a. G a -> a
• In the expression: 3
- In an equation for ‘bar’: bar (G2 | G1) = 3
+ In an equation for ‘bar’: bar (G2; G1) = 3
-Or4.hs:18:35: error: [GHC-39999]
+Or4.hs:18:34: error: [GHC-39999]
• No instance for ‘Num a’ arising from a use of ‘+’
Possible fix:
add (Num a) to the context of
the type signature for:
foo :: forall a. a -> GADT a -> a
• In the expression: x + 1
- In an equation for ‘foo’: foo x (IsInt1 {} | IsInt2 {}) = x + 1
+ In an equation for ‘foo’: foo x (IsInt1 {}; IsInt2 {}) = x + 1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5ea14ed3f48a69a3f228e3cf7b2ee601fb3a9ce
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5ea14ed3f48a69a3f228e3cf7b2ee601fb3a9ce
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230907/3c574916/attachment-0001.html>
More information about the ghc-commits
mailing list