Commit b938576d authored by David Feuer's avatar David Feuer Committed by Ben Gamari
Browse files

Add custom exception for fixIO

Traditionally, `fixIO f` throws `BlockedIndefinitelyOnMVar` if
`f` is strict. This is not particularly friendly, since the
`MVar` in question is just part of the way `fixIO` happens to be
implemented. Instead, throw a new `FixIOException` with a better
explanation of the problem.

Reviewers: austin, hvr, bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #14356

Differential Revision: https://phabricator.haskell.org/D4113
parent e0df569f
...@@ -30,6 +30,7 @@ module Control.Exception.Base ( ...@@ -30,6 +30,7 @@ module Control.Exception.Base (
NonTermination(..), NonTermination(..),
NestedAtomically(..), NestedAtomically(..),
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
FixIOException (..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
AllocationLimitExceeded(..), AllocationLimitExceeded(..),
CompactionFailed(..), CompactionFailed(..),
......
...@@ -33,6 +33,7 @@ module GHC.IO.Exception ( ...@@ -33,6 +33,7 @@ module GHC.IO.Exception (
ArrayException(..), ArrayException(..),
ExitCode(..), ExitCode(..),
FixIOException (..),
ioException, ioException,
ioError, ioError,
...@@ -268,6 +269,15 @@ instance Show ArrayException where ...@@ -268,6 +269,15 @@ instance Show ArrayException where
. (if not (null s) then showString ": " . showString s . (if not (null s) then showString ": " . showString s
else id) else id)
-- | @since TODO
data FixIOException = FixIOException
-- | @since TODO
instance Exception FixIOException
instance Show FixIOException where
showsPrec _ FixIOException = showString "cyclic evaluation in fixIO"
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The ExitCode type -- The ExitCode type
......
...@@ -400,10 +400,15 @@ withBinaryFile name mode = bracket (openBinaryFile name mode) hClose ...@@ -400,10 +400,15 @@ withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- fixIO -- fixIO
-- | The implementation of 'mfix' for 'IO'. If the function passed
-- to 'fixIO' inspects its argument, the resulting action will throw
-- 'FixIOException'.
fixIO :: (a -> IO a) -> IO a fixIO :: (a -> IO a) -> IO a
fixIO k = do fixIO k = do
m <- newEmptyMVar m <- newEmptyMVar
ans <- unsafeDupableInterleaveIO (readMVar m) ans <- unsafeDupableInterleaveIO
(readMVar m `catch` \BlockedIndefinitelyOnMVar ->
throwIO FixIOException)
result <- k ans result <- k ans
putMVar m result putMVar m result
return result return result
......
mdofail006: thread blocked indefinitely in an MVar operation mdofail006: cyclic evaluation in fixIO
...@@ -9,7 +9,7 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] ...@@ -9,7 +9,7 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Ordering -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’
...plus 23 others ...plus 23 others
...plus 61 instances involving out-of-scope types ...plus 62 instances involving out-of-scope types
(use -fprint-potential-instances to see them all) (use -fprint-potential-instances to see them all)
• In the expression: show _ • In the expression: show _
In an equation for ‘f’: f = show _ In an equation for ‘f’: f = show _
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment