[commit: ghc] master: Make Control.Exception.throw levity polymorphic. (8ae7c1b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8ae7c1b5033beba576a2d9ffeb9f148bff220482/ghc

>---------------------------------------------------------------

commit 8ae7c1b5033beba576a2d9ffeb9f148bff220482
Author: Félix Baylac-Jacqué <felix at alternativebit.fr>
Date:   Thu Jun 14 09:15:26 2018 -0400

    Make Control.Exception.throw levity polymorphic.
    
    Test Plan: Validate.
    
    Reviewers: hvr, bgamari, sighingnow
    
    Reviewed By: sighingnow
    
    Subscribers: tdammers, sighingnow, rwbarton, thomie, carter
    
    GHC Trac Issues: #15180
    
    Differential Revision: https://phabricator.haskell.org/D4827


>---------------------------------------------------------------

8ae7c1b5033beba576a2d9ffeb9f148bff220482
 libraries/base/GHC/Exception.hs                    |  5 ++++-
 libraries/base/changelog.md                        |  2 ++
 testsuite/tests/typecheck/should_compile/T15180.hs | 11 +++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 4 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index df90cb2..f966b3f 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -5,6 +5,7 @@
            , RecordWildCards
            , PatternSynonyms
   #-}
+{-# LANGUAGE TypeInType #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -41,6 +42,7 @@ import GHC.Base
 import GHC.Show
 import GHC.Stack.Types
 import GHC.OldList
+import GHC.Prim
 import GHC.IO.Unsafe
 import {-# SOURCE #-} GHC.Stack.CCS
 
@@ -164,7 +166,8 @@ instance Exception SomeException where
 
 -- | Throw an exception.  Exceptions may be thrown from purely
 -- functional code, but may only be caught within the 'IO' monad.
-throw :: Exception e => e -> a
+throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
+         Exception e => e -> a
 throw e = raise# (toException e)
 
 -- | This is thrown when the user calls 'error'. The first @String@ is the
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index c588b21..5188fa9 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -35,6 +35,8 @@
 
   * `Data.Monoid.Ap` has been introduced
 
+  * `Control.Exception.throw` is now levity polymorphic. (#15180)
+
 ## 4.11.1.0 *TBA*
   * Bundled with GHC 8.4.2
 
diff --git a/testsuite/tests/typecheck/should_compile/T15180.hs b/testsuite/tests/typecheck/should_compile/T15180.hs
new file mode 100644
index 0000000..a81f130
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T15180.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash #-}
+module Main where
+
+import Control.Exception
+import System.Exit
+import GHC.Exts
+
+main :: IO ()
+main = do
+  let a = throw $ toException ExitSuccess :: Int#
+  return ()
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 0d2b089..f566182 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -621,4 +621,5 @@ test('SplitWD', normal, compile, [''])
 test('T14441', omit_ways(['profasm']), compile, [''])
 test('T15050', [expect_broken(15050)], compile, [''])
 test('T14735', normal, compile, [''])
+test('T15180', normal, compile, [''])
 test('T15232', normal, compile, [''])