summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2022-04-08 13:16:42 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-04-09 13:04:50 -0400
commit20eca489df8c3dae80a584dede8fea40728bde3b (patch)
tree80f3d786b40ea06fe058ae3420a821b8f06dcb05
parent5f8d6e65f3d8268c70d6a8434ba9df03087a22eb (diff)
downloadhaskell-20eca489df8c3dae80a584dede8fea40728bde3b.tar.gz
Refactor: simplify lexing of the dot
Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps.
-rw-r--r--compiler/GHC/Parser/Lexer.x12
-rw-r--r--testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr14
2 files changed, 9 insertions, 17 deletions
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 82a5b9bb38..cb8a1023a3 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -1057,9 +1057,6 @@ reservedSymsFM = listToUFM $
,("*", ITstar NormalSyntax, NormalSyntax, xbit StarIsTypeBit)
- -- For 'forall a . t'
- ,(".", ITdot, NormalSyntax, 0 )
-
,("-<", ITlarrowtail NormalSyntax, NormalSyntax, xbit ArrowsBit)
,(">-", ITrarrowtail NormalSyntax, NormalSyntax, xbit ArrowsBit)
,("-<<", ITLarrowtail NormalSyntax, NormalSyntax, xbit ArrowsBit)
@@ -1726,13 +1723,8 @@ consym = sym (\_span _exts s -> return $ ITconsym s)
sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action
sym con span buf len =
case lookupUFM reservedSymsFM fs of
- Just (keyword, NormalSyntax, 0) -> do
- exts <- getExts
- if fs == fsLit "." &&
- exts .&. (xbit OverloadedRecordDotBit) /= 0 &&
- xtest OverloadedRecordDotBit exts
- then L span <$!> con span exts fs -- Process by varsym_*.
- else return $ L span keyword
+ Just (keyword, NormalSyntax, 0) ->
+ return $ L span keyword
Just (keyword, NormalSyntax, i) -> do
exts <- getExts
if exts .&. i /= 0
diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
index 62886f3bf7..c5030e1fba 100644
--- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
@@ -35,7 +35,7 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
- (.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1)
+ (.) (_ :: b3 -> Integer) (_ :: [Integer] -> b3)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
@@ -89,7 +89,7 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a
last (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0)
where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a
- fst (_ :: (t0 -> [Integer] -> Integer, b2)) (_ :: t0)
+ fst (_ :: (t0 -> [Integer] -> Integer, b1)) (_ :: t0)
where fst :: forall a b. (a, b) -> a
snd (_ :: (a2, t0 -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
@@ -111,7 +111,7 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where snd :: forall a b. (a, b) -> b
const (_ :: [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
- uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3))
+ uncurry (_ :: a3 -> b2 -> [Integer] -> Integer) (_ :: (a3, b2))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
@@ -152,7 +152,7 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
- (.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1)
+ (.) (_ :: b3 -> [Integer] -> Integer) (_ :: Integer -> b3)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
@@ -209,7 +209,7 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a
last (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0)
where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a
- fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b2)) (_ :: t0)
+ fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b1)) (_ :: t0)
where fst :: forall a b. (a, b) -> a
snd (_ :: (a2, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
@@ -232,8 +232,8 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where snd :: forall a b. (a, b) -> b
const (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
- uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer)
- (_ :: (a3, b3))
+ uncurry (_ :: a3 -> b2 -> Integer -> [Integer] -> Integer)
+ (_ :: (a3, b2))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
where seq :: forall a b. a -> b -> b