[commit: ghc] master: Prohibit RULES changing constructors (bc332b3)
git at git.haskell.org
git at git.haskell.org
Thu Mar 2 20:02:25 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/bc332b3159613190a4dc33a067c1ab31039a8434/ghc
>---------------------------------------------------------------
commit bc332b3159613190a4dc33a067c1ab31039a8434
Author: David Feuer <david.feuer at gmail.com>
Date: Thu Mar 2 15:01:26 2017 -0500
Prohibit RULES changing constructors
Previously, `RULES` like
```
{-# RULES
"JustNothing" forall x . Just x = Nothing
#-}
```
were allowed. Simon Peyton Jones say this seems to have been a
mistake, that such rules have never been supported intentionally,
and that he doesn't know if they can break in horrible ways.
Furthermore, Ben Gamari and Reid Barton are considering trying to
detect the presence of "static data" that the simplifier doesn't
need to traverse at all. Such rules do not play well with that.
So for now, we ban them altogether. In most cases, it's possible
to work around the ban using hand-written wrapper functions.
Reviewers: austin, simonpj, bgamari
Reviewed By: simonpj, bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3169
>---------------------------------------------------------------
bc332b3159613190a4dc33a067c1ab31039a8434
compiler/deSugar/DsBinds.hs | 27 ++++++++++++++++++++--
docs/users_guide/8.2.1-notes.rst | 10 ++++++++
docs/users_guide/glasgow_exts.rst | 4 +++-
testsuite/tests/deSugar/should_compile/T13290.hs | 7 ++++++
.../tests/deSugar/should_compile/T13290.stderr | 4 ++++
testsuite/tests/deSugar/should_compile/all.T | 1 +
testsuite/tests/simplCore/should_run/T12689.hs | 26 ---------------------
testsuite/tests/simplCore/should_run/T12689.stdout | 7 ------
testsuite/tests/simplCore/should_run/all.T | 1 -
9 files changed, 50 insertions(+), 37 deletions(-)
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 0b115cb..0d96692 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -837,13 +837,15 @@ decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr])
-- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs
-- may add some extra dictionary binders (see Note [Free dictionaries])
--
--- Returns Nothing if the LHS isn't of the expected shape
+-- Returns an error message if the LHS isn't of the expected shape
-- Note [Decomposing the left-hand side of a RULE]
decomposeRuleLhs orig_bndrs orig_lhs
| not (null unbound) -- Check for things unbound on LHS
-- See Note [Unused spec binders]
= Left (vcat (map dead_msg unbound))
-
+ | Var funId <- fun2
+ , Just con <- isDataConId_maybe funId
+ = Left (constructor_msg con) -- See Note [No RULES on datacons]
| Just (fn_id, args) <- decompose fun2 args2
, let extra_bndrs = mk_extra_bndrs fn_id args
= -- pprTrace "decmposeRuleLhs" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
@@ -899,6 +901,11 @@ decomposeRuleLhs orig_bndrs orig_lhs
| Just pred <- evVarPred_maybe bndr = text "constraint" <+> quotes (ppr pred)
| otherwise = text "variable" <+> quotes (ppr bndr)
+ constructor_msg con = vcat
+ [ text "A constructor," <+> ppr con <>
+ text ", appears as outermost match in RULE lhs."
+ , text "This rule will be ignored." ]
+
drop_dicts :: CoreExpr -> CoreExpr
drop_dicts e
= wrap_lets needed bnds body
@@ -1087,6 +1094,22 @@ the constraint is unused. We could bind 'd' to (error "unused")
but it seems better to reject the program because it's almost certainly
a mistake. That's what the isDeadBinder call detects.
+Note [No RULES on datacons]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Previously, `RULES` like
+
+ "JustNothing" forall x . Just x = Nothing
+
+were allowed. Simon Peyton Jones says this seems to have been a
+mistake, that such rules have never been supported intentionally,
+and that he doesn't know if they can break in horrible ways.
+Furthermore, Ben Gamari and Reid Barton are considering trying to
+detect the presence of "static data" that the simplifier doesn't
+need to traverse at all. Such rules do not play well with that.
+So for now, we ban them altogether as requested by #13290. See also #7398.
+
+
************************************************************************
* *
Desugaring evidence
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index 9a222e6..b3dd2de 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -157,6 +157,16 @@ Compiler
- The :ghc-flag:`-XExtendedDefaultRules` extension now defaults multi-parameter
typeclasses. See :ghc-ticket:`12923`.
+- GHC now ignores ``RULES`` for data constructors (:ghc-ticket:`13290`).
+ Previously, it accepted::
+
+ "NotAllowed" forall x. Just x = e
+
+ That rule will no longer take effect, and a warning will be issued. ``RULES``
+ may still mention data constructors, but not in the outermost position::
+
+ "StillWorks" forall x. f (Just x) = e
+
GHCi
~~~~
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 6ba6935..205e12a 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -13268,9 +13268,11 @@ From a syntactic point of view:
"wrong1" forall e1 e2. case True of { True -> e1; False -> e2 } = e1
"wrong2" forall f. f True = True
+ "wrong3" forall x. Just x = Nothing
In ``"wrong1"``, the LHS is not an application; in ``"wrong2"``, the
- LHS has a pattern variable in the head.
+ LHS has a pattern variable in the head. In ``"wrong3"``, the LHS consists
+ of a *constructor*, rather than a *variable*, applied to an argument.
- A rule does not need to be in the same module as (any of) the
variables it mentions, though of course they need to be in scope.
diff --git a/testsuite/tests/deSugar/should_compile/T13290.hs b/testsuite/tests/deSugar/should_compile/T13290.hs
new file mode 100644
index 0000000..9c72225
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13290.hs
@@ -0,0 +1,7 @@
+module T13290 where
+
+data Foo = Bar Int Char | Baz Char
+
+{-# RULES
+"BarBaz" Bar 0 'a' = Baz 'b'
+ #-}
diff --git a/testsuite/tests/deSugar/should_compile/T13290.stderr b/testsuite/tests/deSugar/should_compile/T13290.stderr
new file mode 100644
index 0000000..dd5bcee
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T13290.stderr
@@ -0,0 +1,4 @@
+
+T13290.hs:6:1: warning:
+ A constructor, Bar, appears as outermost match in RULE lhs.
+ This rule will be ignored.
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 24b95a0..7694fb9 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -96,3 +96,4 @@ test('T12944', normal, compile, [''])
test('T12950', normal, compile, [''])
test('T13043', normal, compile, [''])
test('T13215', normal, compile, [''])
+test('T13290', normal, compile, [''])
diff --git a/testsuite/tests/simplCore/should_run/T12689.hs b/testsuite/tests/simplCore/should_run/T12689.hs
deleted file mode 100644
index 84a5419..0000000
--- a/testsuite/tests/simplCore/should_run/T12689.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-data T1 = MkT1Bad | MkT1Good deriving Show
-data T2 = MkT2Bad Int | MkT2Good Int deriving Show
-data T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show
-data T4 = MkT4Bad Int | MkT4Good Int deriving Show
-data T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show
-
-{-# RULES
-
-"T1" MkT1Bad = MkT1Good
-"T2" forall x. MkT2Bad x = MkT2Good x
-"T3" forall x. MkT3Bad x = MkT3Good x
-"T4" MkT4Bad = MkT4Good
-"T5" MkT5Bad = MkT5Good
- #-}
-
-app = id
-{-# NOINLINE app #-}
-
-main = do
- print MkT1Bad
- print (MkT2Bad 42)
- print (MkT3Bad 42)
- print (MkT4Bad 42)
- print (app MkT4Bad 42)
- print (MkT5Bad 42)
- print (app MkT5Bad 42)
diff --git a/testsuite/tests/simplCore/should_run/T12689.stdout b/testsuite/tests/simplCore/should_run/T12689.stdout
deleted file mode 100644
index 7e9baf3..0000000
--- a/testsuite/tests/simplCore/should_run/T12689.stdout
+++ /dev/null
@@ -1,7 +0,0 @@
-MkT1Good
-MkT2Good 42
-MkT3Good 42
-MkT4Good 42
-MkT4Good 42
-MkT5Good 42
-MkT5Good 42
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 702d83c..9317b8b 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -68,7 +68,6 @@ test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, [''])
test('T11172', normal, compile_and_run, [''])
test('T11731', normal, compile_and_run, ['-fspec-constr'])
test('T7611', normal, compile_and_run, [''])
-test('T12689', normal, compile_and_run, [''])
test('T12689broken', expect_broken(12689), compile_and_run, [''])
test('T12689a', normal, compile_and_run, [''])
More information about the ghc-commits
mailing list