[Git][ghc/ghc][master] Make renamer to be more flexible with parens in the LHS of the rules
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri May 10 05:49:03 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4d3acbcf by Zejun Wu at 2024-05-10T01:48:28-04:00
Make renamer to be more flexible with parens in the LHS of the rules
We used to reject LHS like `(f a) b` in RULES and requires it to be written as
`f a b`. It will be handy to allow both as the expression may be more
readable with extra parens in some cases when infix operator is involved.
Espceially when TemplateHaskell is used, extra parens may be added out of
user's control and result in "valid" rules being rejected and there
are not always ways to workaround it.
Fixes #24621
- - - - -
4 changed files:
- compiler/GHC/Rename/Module.hs
- + testsuite/tests/rename/should_compile/T24621_normal.hs
- + testsuite/tests/rename/should_compile/T24621_th.hs
- testsuite/tests/rename/should_compile/all.T
Changes:
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1226,6 +1226,15 @@ with LHSs with a complicated desugaring (and hence unlikely to match);
But there are legitimate non-trivial args ei, like sections and
lambdas. So it seems simpler not to check at all, and that is why
check_e is commented out.
+
+Note [Parens on the LHS of a RULE]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+You may think that no one would write
+
+ {-# RULES "foo" (f True) = blah #-}
+
+with the LHS wrapped in parens. But Template Haskell does (#24621)!
+So we should accommodate them.
-}
checkValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM ()
@@ -1253,6 +1262,8 @@ validRuleLhs foralls lhs
check (HsAppType _ e _) = checkl e
check (HsVar _ lv)
| (unLoc lv) `notElem` foralls = Nothing
+ -- See Note [Parens on the LHS of a RULE]
+ check (HsPar _ e) = checkl e
check other = Just other -- Failure
-- Check an argument
=====================================
testsuite/tests/rename/should_compile/T24621_normal.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_normal where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+{-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-}
+{-# RULES "." forall f g. (f . g) foo = f (g foo) #-}
+{-# RULES "foo" forall a b. (foo a) b = a b #-}
+{-# RULES "on" forall a b. (flip compare `on` foo) a b = compare b a #-}
=====================================
testsuite/tests/rename/should_compile/T24621_th.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_th where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+$( [d| {-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-} |] )
+$( [d| {-# RULES "." forall a b. (.) a b foo = a (b foo) #-} |] )
+$( [d| {-# RULES "foo" forall a b. foo a b = a b #-} |] )
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -223,4 +223,6 @@ test('T22478a', req_th, compile, [''])
test('RecordWildCardDeprecation', normal, multimod_compile, ['RecordWildCardDeprecation', '-Wno-duplicate-exports'])
test('T14032b', normal, compile_and_run, [''])
test('T14032d', normal, compile, [''])
+test('T24621_normal', normal, compile, [''])
+test('T24621_th', req_th, compile, [''])
test('T24732', normal, compile_and_run, ['-package "base(Prelude, Text.Printf as P\')"'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d3acbcf4c78636afd79883ad021ed6f7ea92a75
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d3acbcf4c78636afd79883ad021ed6f7ea92a75
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/20240510/be41e5bf/attachment-0001.html>
More information about the ghc-commits
mailing list