summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitmodules3
-rw-r--r--ghc.mk1
-rw-r--r--ghc/GHCi/UI/Monad.hs62
-rw-r--r--ghc/ghc-bin.cabal.in3
-rw-r--r--hadrian/src/Packages.hs11
-rw-r--r--hadrian/src/Settings/Default.hs1
m---------libraries/exceptions0
m---------libraries/haskeline0
-rw-r--r--packages1
9 files changed, 61 insertions, 21 deletions
diff --git a/.gitmodules b/.gitmodules
index d6a02eb385..7f151f685c 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -107,3 +107,6 @@
[submodule "gmp-tarballs"]
path = libraries/integer-gmp/gmp/gmp-tarballs
url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
+[submodule "libraries/exceptions"]
+ path = libraries/exceptions
+ url = https://gitlab.haskell.org/ghc/packages/exceptions
diff --git a/ghc.mk b/ghc.mk
index 71fc0b5868..f337333d9a 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -463,6 +463,7 @@ libraries/haskeline_CONFIGURE_OPTS += --flags=-terminfo
endif
PACKAGES_STAGE1 += stm
+PACKAGES_STAGE1 += exceptions
PACKAGES_STAGE1 += haskeline
PACKAGES_STAGE1 += ghci
PACKAGES_STAGE1 += libiserv
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 824a822796..63356d6418 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -54,7 +54,7 @@ import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import GHC.Hs.Utils
import Util
-import Exception
+import Exception hiding (uninterruptibleMask, mask, catch)
import Numeric
import Data.Array
import Data.IORef
@@ -65,7 +65,7 @@ import Control.Monad
import Prelude hiding ((<>))
import System.Console.Haskeline (CompletionFunc, InputT)
-import qualified System.Console.Haskeline as Haskeline
+import Control.Monad.Catch
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
@@ -185,8 +185,8 @@ data CommandResult
-- ^ Unterminated multiline command
deriving Show
-cmdSuccess :: Haskeline.MonadException m => CommandResult -> m (Maybe Bool)
-cmdSuccess CommandComplete{ cmdResult = Left e } = liftIO $ throwIO e
+cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
+cmdSuccess CommandComplete{ cmdResult = Left e } = throwM e
cmdSuccess CommandComplete{ cmdResult = Right r } = return r
cmdSuccess CommandIncomplete = return $ Just True
@@ -320,19 +320,51 @@ instance ExceptionMonad GHCi where
in
unGHCi (f g_restore) s
-instance Haskeline.MonadException Ghc where
- controlIO f = Ghc $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
- run' = Haskeline.RunIO (fmap (Ghc . const) . run . flip unGhc s)
- in fmap (flip unGhc s) $ f run'
-
-instance Haskeline.MonadException GHCi where
- controlIO f = GHCi $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
- run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s)
- in fmap (flip unGHCi s) $ f run'
+instance MonadThrow Ghc where
+ throwM = liftIO . throwM
+
+instance MonadCatch Ghc where
+ catch = gcatch
+
+instance MonadMask Ghc where
+ mask f = Ghc $ \s ->
+ mask $ \io_restore ->
+ let g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
+ in unGhc (f g_restore) s
+ uninterruptibleMask f = Ghc $ \s ->
+ uninterruptibleMask $ \io_restore ->
+ let g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
+ in unGhc (f g_restore) s
+ generalBracket acquire release use = Ghc $ \s ->
+ generalBracket
+ (unGhc acquire s)
+ (\resource exitCase -> unGhc (release resource exitCase) s)
+ (\resource -> unGhc (use resource) s)
+
+instance MonadThrow GHCi where
+ throwM = liftIO . throwM
+
+instance MonadCatch GHCi where
+ catch = gcatch
+
+instance MonadMask GHCi where
+ mask f = GHCi $ \s ->
+ mask $ \io_restore ->
+ let g_restore (GHCi m) = GHCi $ \s -> io_restore (m s)
+ in unGHCi (f g_restore) s
+ uninterruptibleMask f = GHCi $ \s ->
+ uninterruptibleMask $ \io_restore ->
+ let g_restore (GHCi m) = GHCi $ \s -> io_restore (m s)
+ in unGHCi (f g_restore) s
+ generalBracket acquire release use = GHCi $ \s ->
+ generalBracket
+ (unGHCi acquire s)
+ (\resource exitCase -> unGHCi (release resource exitCase) s)
+ (\resource -> unGHCi (use resource) s)
instance ExceptionMonad (InputT GHCi) where
- gcatch = Haskeline.catch
- gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
+ gcatch = catch
+ gmask = mask
isOptionSet :: GhciMonad m => GHCiOption -> m Bool
isOptionSet opt
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 721df4ea62..bc10724677 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -61,7 +61,8 @@ Executable ghc
deepseq == 1.4.*,
ghc-prim >= 0.5.0 && < 0.7,
ghci == @ProjectVersionMunged@,
- haskeline == 0.7.*,
+ haskeline == 0.8.*,
+ exceptions == 0.10.*,
time >= 1.8 && < 1.10
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
GHC-Options: -fno-warn-name-shadowing
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index c4ae780fb3..e65e8c9709 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -3,8 +3,8 @@ module Packages (
-- * GHC packages
array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
- filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact,
- ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline,
+ exceptions, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh,
+ ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
libffi, libiserv, mtl, parsec, pretty, primitive, process, remoteIserv, rts,
runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy,
@@ -33,9 +33,9 @@ ghcPackages :: [Package]
ghcPackages =
[ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations
, compareSizes, compiler, containers, deepseq, deriveConstants, directory
- , filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact
- , ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps
- , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
+ , exceptions, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh
+ , ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
+ , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
, parsec, pretty, process, rts, runGhc, stm, templateHaskell
, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
, timeout ]
@@ -58,6 +58,7 @@ containers = lib "containers" `setPath` "libraries/containers/con
deepseq = lib "deepseq"
deriveConstants = util "deriveConstants"
directory = lib "directory"
+exceptions = lib "exceptions"
filepath = lib "filepath"
genapply = util "genapply"
genprimopcode = util "genprimopcode"
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 05e98555ea..0d60c39533 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -91,6 +91,7 @@ stage1Packages = do
, containers
, deepseq
, directory
+ , exceptions
, filepath
, ghc
, ghcCompact
diff --git a/libraries/exceptions b/libraries/exceptions
new file mode 160000
+Subproject a2efbf722de51abe4ad9b3234cbe6d89a799dcd
diff --git a/libraries/haskeline b/libraries/haskeline
-Subproject fdc6c2cced525b8f8a95f38bfc45d9362785e9a
+Subproject 98d69248d08389f349e12981da43797b8860ae6
diff --git a/packages b/packages
index 34e78c3e35..ad4f529c03 100644
--- a/packages
+++ b/packages
@@ -64,6 +64,7 @@ libraries/transformers - - https:/
libraries/unix - - ssh://git@github.com/haskell/unix.git
libraries/Win32 - - https://github.com/haskell/win32.git
libraries/xhtml - - https://github.com/haskell/xhtml.git
+libraries/exceptions - - https://github.com/ekmett/exceptions.git
nofib nofib - -
libraries/stm - - ssh://git@github.com/haskell/stm.git
. - ghc.git -
View Lorry Controller Status