summaryrefslogtreecommitdiff
path: root/libraries/base/Control/Monad
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/base/Control/Monad')
-rw-r--r--libraries/base/Control/Monad/Fail.hs4
-rw-r--r--libraries/base/Control/Monad/Fix.hs28
-rw-r--r--libraries/base/Control/Monad/ST.hs2
-rw-r--r--libraries/base/Control/Monad/ST/Imp.hs58
-rw-r--r--libraries/base/Control/Monad/ST/Lazy/Imp.hs16
-rw-r--r--libraries/base/Control/Monad/ST/Lazy/Safe.hs2
-rw-r--r--libraries/base/Control/Monad/ST/Lazy/Unsafe.hs2
-rw-r--r--libraries/base/Control/Monad/Zip.hs14
8 files changed, 105 insertions, 21 deletions
diff --git a/libraries/base/Control/Monad/Fail.hs b/libraries/base/Control/Monad/Fail.hs
index 91ef3ed349..ecf974bc79 100644
--- a/libraries/base/Control/Monad/Fail.hs
+++ b/libraries/base/Control/Monad/Fail.hs
@@ -50,13 +50,13 @@ import {-# SOURCE #-} GHC.IO (failIO)
-- only a single data constructor, and irrefutable patterns (@~pat@).
--
-- Instances of 'MonadFail' should satisfy the following law: @fail s@ should
--- be a left zero for '>>=',
+-- be a left zero for 'Control.Monad.>>=',
--
-- @
-- fail s >>= f = fail s
-- @
--
--- If your 'Monad' is also 'MonadPlus', a popular definition is
+-- If your 'Monad' is also 'Control.Monad.MonadPlus', a popular definition is
--
-- @
-- fail _ = mzero
diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs
index c8a9ddab58..f287b06541 100644
--- a/libraries/base/Control/Monad/Fix.hs
+++ b/libraries/base/Control/Monad/Fix.hs
@@ -28,18 +28,19 @@ import Data.Either
import Data.Function ( fix )
import Data.Maybe
import Data.Monoid ( Dual(..), Sum(..), Product(..)
- , First(..), Last(..), Alt(..) )
-import GHC.Base ( Monad, errorWithoutStackTrace, (.) )
+ , First(..), Last(..), Alt(..), Ap(..) )
+import Data.Ord ( Down(..) )
+import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) )
import GHC.Generics
import GHC.List ( head, tail )
-import GHC.ST
+import Control.Monad.ST.Imp
import System.IO
-- | Monads having fixed points with a \'knot-tying\' semantics.
-- Instances of 'MonadFix' should satisfy the following laws:
--
-- [/purity/]
--- @'mfix' ('return' . h) = 'return' ('fix' h)@
+-- @'mfix' ('Control.Monad.return' . h) = 'Control.Monad.return' ('fix' h)@
--
-- [/left shrinking/ (or /tightening/)]
-- @'mfix' (\\x -> a >>= \\y -> f x y) = a >>= \\y -> 'mfix' (\\x -> f x y)@
@@ -74,6 +75,14 @@ instance MonadFix [] where
[] -> []
(x:_) -> x : mfix (tail . f)
+-- | @since 4.9.0.0
+instance MonadFix NonEmpty where
+ mfix f = case fix (f . neHead) of
+ ~(x :| _) -> x :| mfix (neTail . f)
+ where
+ neHead ~(a :| _) = a
+ neTail ~(_ :| as) = as
+
-- | @since 2.01
instance MonadFix IO where
mfix = fixIO
@@ -118,6 +127,10 @@ instance MonadFix Last where
instance MonadFix f => MonadFix (Alt f) where
mfix f = Alt (mfix (getAlt . f))
+-- | @since 4.12.0.0
+instance MonadFix f => MonadFix (Ap f) where
+ mfix f = Ap (mfix (getAp . f))
+
-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance MonadFix Par1 where
@@ -137,3 +150,10 @@ instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where
where
fstP (a :*: _) = a
sndP (_ :*: b) = b
+
+-- Instances for Data.Ord
+
+-- | @since 4.12.0.0
+instance MonadFix Down where
+ mfix f = Down (fix (getDown . f))
+ where getDown (Down x) = x
diff --git a/libraries/base/Control/Monad/ST.hs b/libraries/base/Control/Monad/ST.hs
index 8313c2d3eb..6f1dc31e38 100644
--- a/libraries/base/Control/Monad/ST.hs
+++ b/libraries/base/Control/Monad/ST.hs
@@ -16,7 +16,7 @@
--
-- References (variables) that can be used within the @ST@ monad are
-- provided by "Data.STRef", and arrays are provided by
--- "Data.Array.ST".
+-- [Data.Array.ST](https://hackage.haskell.org/package/array/docs/Data-Array-ST.html).
-----------------------------------------------------------------------------
diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs
index c053dcc64d..55bd780f2c 100644
--- a/libraries/base/Control/Monad/ST/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Imp.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK hide #-}
@@ -23,7 +24,7 @@ module Control.Monad.ST.Imp (
runST,
fixST,
- -- * Converting 'ST' to 'IO'
+ -- * Converting 'ST' to 'Prelude.IO'
RealWorld, -- abstract
stToIO,
@@ -34,7 +35,56 @@ module Control.Monad.ST.Imp (
unsafeSTToIO
) where
-import GHC.ST ( ST, runST, fixST, unsafeInterleaveST
+import GHC.ST ( ST, runST, unsafeInterleaveST
, unsafeDupableInterleaveST )
-import GHC.Base ( RealWorld )
-import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO )
+import GHC.Base ( RealWorld, ($), return )
+import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO
+ , unsafeDupableInterleaveIO )
+import GHC.MVar ( readMVar, putMVar, newEmptyMVar )
+import Control.Exception.Base
+ ( catch, throwIO, NonTermination (..)
+ , BlockedIndefinitelyOnMVar (..) )
+
+-- | Allow the result of an 'ST' computation to be used (lazily)
+-- inside the computation.
+--
+-- Note that if @f@ is strict, @'fixST' f = _|_@.
+fixST :: (a -> ST s a) -> ST s a
+-- See Note [fixST]
+fixST k = unsafeIOToST $ do
+ m <- newEmptyMVar
+ ans <- unsafeDupableInterleaveIO
+ (readMVar m `catch` \BlockedIndefinitelyOnMVar ->
+ throwIO NonTermination)
+ result <- unsafeSTToIO (k ans)
+ putMVar m result
+ return result
+
+{- Note [fixST]
+ ~~~~~~~~~~~~
+
+For many years, we implemented fixST much like a pure fixpoint,
+using liftST:
+
+ fixST :: (a -> ST s a) -> ST s a
+ fixST k = ST $ \ s ->
+ let ans = liftST (k r) s
+ STret _ r = ans
+ in
+ case ans of STret s' x -> (# s', x #)
+
+We knew that lazy blackholing could cause the computation to be re-run if the
+result was demanded strictly, but we thought that would be okay in the case of
+ST. However, that is not the case (see Trac #15349). Notably, the first time
+the computation is executed, it may mutate variables that cause it to behave
+*differently* the second time it's run. That may allow it to terminate when it
+should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived
+example ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html )
+demonstrating that it can break reasonable assumptions in "trustworthy" code,
+causing a memory safety violation. So now we implement fixST much like we do
+fixIO. See also the implementation notes for fixIO. Simon Marlow wondered
+whether we could get away with an IORef instead of an MVar. I believe we
+cannot. The function passed to fixST may spark a parallel computation that
+demands the final result. Such a computation should block until the final
+result is available.
+-}
diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
index 4f1204b89f..699c81e258 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
@@ -14,7 +14,7 @@
-- Portability : non-portable (requires universal quantification for runST)
--
-- This module presents an identical interface to "Control.Monad.ST",
--- except that the monad delays evaluation of state operations until
+-- except that the monad delays evaluation of 'ST' operations until
-- a value depending on them is required.
--
-----------------------------------------------------------------------------
@@ -46,10 +46,10 @@ import qualified GHC.ST as GHC.ST
import GHC.Base
import qualified Control.Monad.Fail as Fail
--- | The lazy state-transformer monad.
--- A computation of type @'ST' s a@ transforms an internal state indexed
--- by @s@, and returns a value of type @a@.
--- The @s@ parameter is either
+-- | The lazy @'ST' monad.
+-- The ST monad allows for destructive updates, but is escapable (unlike IO).
+-- A computation of type @'ST' s a@ returns a value of type @a@, and
+-- execute in "thread" @s@. The @s@ parameter is either
--
-- * an uninstantiated type variable (inside invocations of 'runST'), or
--
@@ -198,13 +198,13 @@ instance Monad (ST s) where
instance Fail.MonadFail (ST s) where
fail s = errorWithoutStackTrace s
--- | Return the value computed by a state transformer computation.
+-- | Return the value computed by an 'ST' computation.
-- The @forall@ ensures that the internal state used by the 'ST'
-- computation is inaccessible to the rest of the program.
runST :: (forall s. ST s a) -> a
runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r)
--- | Allow the result of a state transformer computation to be used (lazily)
+-- | Allow the result of an 'ST' computation to be used (lazily)
-- inside the computation.
-- Note that if @f@ is strict, @'fixST' f = _|_@.
fixST :: (a -> ST s a) -> ST s a
@@ -243,7 +243,7 @@ lazyToStrictST :: ST s a -> ST.ST s a
lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
case (m (S# s)) of (a, S# s') -> (# s', a #)
--- | A monad transformer embedding lazy state transformers in the 'IO'
+-- | A monad transformer embedding lazy 'ST' in the 'IO'
-- monad. The 'RealWorld' parameter indicates that the internal state
-- used by the 'ST' computation is a special one supplied by the 'IO'
-- monad, and thus distinct from those used by invocations of 'runST'.
diff --git a/libraries/base/Control/Monad/ST/Lazy/Safe.hs b/libraries/base/Control/Monad/ST/Lazy/Safe.hs
index 9f8e60686f..05aaae7523 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Safe.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Safe.hs
@@ -11,7 +11,7 @@
-- Portability : non-portable (requires universal quantification for runST)
--
-- This module presents an identical interface to "Control.Monad.ST",
--- except that the monad delays evaluation of state operations until
+-- except that the monad delays evaluation of 'ST' operations until
-- a value depending on them is required.
--
-- Safe API only.
diff --git a/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs b/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs
index 4a1b8c79a6..be31c93c24 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs
@@ -11,7 +11,7 @@
-- Portability : non-portable (requires universal quantification for runST)
--
-- This module presents an identical interface to "Control.Monad.ST",
--- except that the monad delays evaluation of state operations until
+-- except that the monad delays evaluation of 'ST' operations until
-- a value depending on them is required.
--
-- Unsafe API.
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
index 5b670085d4..beef913119 100644
--- a/libraries/base/Control/Monad/Zip.hs
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -21,7 +21,9 @@ module Control.Monad.Zip where
import Control.Monad (liftM, liftM2)
import Data.Functor.Identity
import Data.Monoid
+import Data.Ord ( Down(..) )
import Data.Proxy
+import qualified Data.List.NonEmpty as NE
import GHC.Generics
-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
@@ -59,6 +61,12 @@ instance MonadZip [] where
mzipWith = zipWith
munzip = unzip
+-- | @since 4.9.0.0
+instance MonadZip NE.NonEmpty where
+ mzip = NE.zip
+ mzipWith = NE.zipWith
+ munzip = NE.unzip
+
-- | @since 4.8.0.0
instance MonadZip Identity where
mzipWith = liftM2
@@ -117,3 +125,9 @@ instance MonadZip f => MonadZip (M1 i c f) where
-- | @since 4.9.0.0
instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where
mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2
+
+-- instances for Data.Ord
+
+-- | @since 4.12.0.0
+instance MonadZip Down where
+ mzipWith = liftM2
View Lorry Controller Status