diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index b55cef4e51627793fd0f290901779595cc89bfd6..d83e03e89a6002ec4509599913246d50a6667013 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/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 diff --git a/testsuite/tests/rename/should_compile/T24621_normal.hs b/testsuite/tests/rename/should_compile/T24621_normal.hs new file mode 100644 index 0000000000000000000000000000000000000000..bc96c8ccf1839cfa431222b82577d7ec57d83f0c --- /dev/null +++ b/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 #-} diff --git a/testsuite/tests/rename/should_compile/T24621_th.hs b/testsuite/tests/rename/should_compile/T24621_th.hs new file mode 100644 index 0000000000000000000000000000000000000000..80d2127541145c7afbdce9e4d27920cebe159d19 --- /dev/null +++ b/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 #-} |] ) diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 745335949bb21d19950fbfe844a9b40b68af1eb7..86fedd8aedf4803d1e65ed1985f1159de5e266d8 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ 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\')"'])