[commit: ghc] master: Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings (b501709)
git at git.haskell.org
git at git.haskell.org
Sat Oct 15 15:12:57 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b501709ed79ba03e72518ef9dd101ce2d03db2de/ghc
>---------------------------------------------------------------
commit b501709ed79ba03e72518ef9dd101ce2d03db2de
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Sat Oct 15 11:11:20 2016 -0400
Fix Show derivation in the presence of RebindableSyntax/OverloadedStrings
Summary:
To fix this issue, we simply disable `RebindableSyntax` whenever we rename
the code generated from a deriving clause.
Fixes #12688.
Test Plan: make test TEST=T12688
Reviewers: simonpj, austin, bgamari
Reviewed By: simonpj, bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2591
GHC Trac Issues: #12688
>---------------------------------------------------------------
b501709ed79ba03e72518ef9dd101ce2d03db2de
compiler/typecheck/TcDeriv.hs | 41 ++++++++++++++++++++---
compiler/typecheck/TcRnMonad.hs | 6 +++-
docs/users_guide/8.0.2-notes.rst | 4 +++
docs/users_guide/glasgow_exts.rst | 27 +++++++++++++++
testsuite/tests/deriving/should_compile/T12688.hs | 15 +++++++++
testsuite/tests/deriving/should_compile/all.T | 1 +
6 files changed, 88 insertions(+), 6 deletions(-)
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 524273c..af5e730 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -288,11 +288,17 @@ renameDeriv is_boot inst_infos bagBinds
, emptyValBindsOut, usesOnly (plusFVs fvs)) }
| otherwise
- = discardWarnings $ -- Discard warnings about unused bindings etc
- setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have
- -- case x of {}
- setXOptM LangExt.ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can
- setXOptM LangExt.KindSignatures $ -- used ScopedTypeVariables & KindSignatures
+ = discardWarnings $
+ -- Discard warnings about unused bindings etc
+ setXOptM LangExt.EmptyCase $
+ -- Derived decls (for empty types) can have
+ -- case x of {}
+ setXOptM LangExt.ScopedTypeVariables $
+ setXOptM LangExt.KindSignatures $
+ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
+ -- KindSignatures
+ unsetXOptM LangExt.RebindableSyntax $
+ -- See Note [Avoid RebindableSyntax when deriving]
do {
-- Bring the extra deriving stuff into scope
-- before renaming the instances themselves
@@ -362,6 +368,31 @@ dropped patterns have.
Also, this technique carries over the kind substitution from deriveTyData
nicely.
+Note [Avoid RebindableSyntax when deriving]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The RebindableSyntax extension interacts awkwardly with the derivation of
+any stock class whose methods require the use of string literals. The Show
+class is a simple example (see Trac #12688):
+
+ {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
+ newtype Text = Text String
+ fromString :: String -> Text
+ fromString = Text
+
+ data Foo = Foo deriving Show
+
+This will generate code to the effect of:
+
+ instance Show Foo where
+ showsPrec _ Foo = showString "Foo"
+
+But because RebindableSyntax and OverloadedStrings are enabled, the "Foo"
+string literal is now of type Text, not String, which showString doesn't
+accept! This causes the generated Show instance to fail to typecheck.
+
+To avoid this kind of scenario, we simply turn off RebindableSyntax entirely
+in derived code.
+
************************************************************************
* *
From HsSyn to DerivSpec
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 5f4f979..563e5aa 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -18,7 +18,7 @@ module TcRnMonad(
setGblEnv, getLclEnv, updLclEnv, setLclEnv,
getEnvs, setEnvs,
xoptM, doptM, goptM, woptM,
- setXOptM, unsetGOptM, unsetWOptM,
+ setXOptM, unsetXOptM, unsetGOptM, unsetWOptM,
whenDOptM, whenGOptM, whenWOptM, whenXOptM,
getGhcMode,
withDoDynamicToo,
@@ -460,6 +460,10 @@ setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setXOptM flag =
updTopEnv (\top -> top { hsc_dflags = xopt_set (hsc_dflags top) flag})
+unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+unsetXOptM flag =
+ updTopEnv (\top -> top { hsc_dflags = xopt_unset (hsc_dflags top) flag})
+
unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetGOptM flag =
updTopEnv (\top -> top { hsc_dflags = gopt_unset (hsc_dflags top) flag})
diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst
index 82c214e..c8e76ed 100644
--- a/docs/users_guide/8.0.2-notes.rst
+++ b/docs/users_guide/8.0.2-notes.rst
@@ -25,6 +25,10 @@ Language
- A bug has been fixed that caused standalone derived ``Ix`` instances to fail
for GADTs with exactly one constructor (:ghc-ticket:`12583`).
+- A bug has been fixed that caused derived ``Show`` instances to fail in the
+ presence of :ghc-flag:`-XRebindableSyntax` and
+ :ghc-flag:`-XOverloadedStrings` (:ghc-ticket:`12688`).
+
Compiler
~~~~~~~~
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index e76465a..9f0a755 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -1460,6 +1460,33 @@ Be warned: this is an experimental facility, with fewer checks than
usual. Use ``-dcore-lint`` to typecheck the desugared program. If Core
Lint is happy you should be all right.
+Things unaffected by :ghc-flag:`-XRebindableSyntax`
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+:ghc-flag:`-XRebindableSyntax` does not apply to any code generated from a
+``deriving`` clause or declaration. To see why, consider the following code: ::
+
+ {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
+ newtype Text = Text String
+
+ fromString :: String -> Text
+ fromString = Text
+
+ data Foo = Foo deriving Show
+
+This will generate code to the effect of: ::
+
+ instance Show Foo where
+ showsPrec _ Foo = showString "Foo"
+
+But because :ghc-flag:`-XRebindableSyntax` and :ghc-flag:`-XOverloadedStrings`
+are enabled, the ``"Foo"`` string literal would now be of type ``Text``, not
+``String``, which ``showString`` doesn't accept! This causes the generated
+``Show`` instance to fail to typecheck. It's hard to imagine any scenario where
+it would be desirable have :ghc-flag:`-XRebindableSyntax` behavior within
+derived code, so GHC simply ignores :ghc-flag:`-XRebindableSyntax` entirely
+when checking derived code.
+
.. _postfix-operators:
Postfix operators
diff --git a/testsuite/tests/deriving/should_compile/T12688.hs b/testsuite/tests/deriving/should_compile/T12688.hs
new file mode 100644
index 0000000..0735a81
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T12688.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
+module T12688 where
+
+import Prelude (String,Show(..))
+
+newtype Text = Text String
+
+fromString :: String -> Text
+fromString = Text
+
+x :: Text
+x = "x"
+
+newtype Foo = Foo ()
+ deriving (Show)
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 26312df..bd1f07a 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -76,3 +76,4 @@ test('T12245', normal, compile, [''])
test('T12399', normal, compile, [''])
test('T12583', normal, compile, [''])
test('T12616', normal, compile, [''])
+test('T12688', normal, compile, [''])
More information about the ghc-commits
mailing list