summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs')
-rw-r--r--third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs155
1 files changed, 0 insertions, 155 deletions
diff --git a/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs b/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs
deleted file mode 100644
index 3c7bfd1fa0..0000000000
--- a/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MVar.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-
--- |
--- Module      : Data.Primitive.MVar
--- License     : BSD2
--- Portability : non-portable
---
--- Primitive operations on @MVar@. This module provides a similar interface
--- to "Control.Concurrent.MVar". However, the functions are generalized to
--- work in any 'PrimMonad' instead of only working in 'IO'. Note that all
--- of the functions here are completely deterministic. Users of 'MVar' are
--- responsible for designing abstractions that guarantee determinism in
--- the presence of multi-threading.
---
--- @since 0.6.4.0
-module Data.Primitive.MVar
-  ( MVar(..)
-  , newMVar
-  , isEmptyMVar
-  , newEmptyMVar
-  , putMVar
-  , readMVar
-  , takeMVar
-  , tryPutMVar
-  , tryReadMVar
-  , tryTakeMVar
-  ) where
-
-import Control.Monad.Primitive
-import Data.Primitive.Internal.Compat (isTrue#)
-import GHC.Exts (MVar#,newMVar#,takeMVar#,sameMVar#,putMVar#,tryTakeMVar#,
-  isEmptyMVar#,tryPutMVar#,(/=#))
-
-#if __GLASGOW_HASKELL__ >= 708
-import GHC.Exts (readMVar#,tryReadMVar#)
-#endif
-
-data MVar s a = MVar (MVar# s a)
-
-instance Eq (MVar s a) where
-  MVar mvar1# == MVar mvar2# = isTrue# (sameMVar# mvar1# mvar2#)
-
--- | Create a new 'MVar' that is initially empty.
-newEmptyMVar :: PrimMonad m => m (MVar (PrimState m) a)
-newEmptyMVar = primitive $ \ s# ->
-  case newMVar# s# of
-    (# s2#, svar# #) -> (# s2#, MVar svar# #)
-
-
--- | Create a new 'MVar' that holds the supplied argument.
-newMVar :: PrimMonad m => a -> m (MVar (PrimState m) a)
-newMVar value =
-  newEmptyMVar >>= \ mvar ->
-  putMVar mvar value >>
-  return mvar
-
--- | Return the contents of the 'MVar'.  If the 'MVar' is currently
--- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',
--- the 'MVar' is left empty.
-takeMVar :: PrimMonad m => MVar (PrimState m) a -> m a
-takeMVar (MVar mvar#) = primitive $ \ s# -> takeMVar# mvar# s#
-
--- | Atomically read the contents of an 'MVar'.  If the 'MVar' is
--- currently empty, 'readMVar' will wait until it is full.
--- 'readMVar' is guaranteed to receive the next 'putMVar'.
---
--- /Multiple Wakeup:/ 'readMVar' is multiple-wakeup, so when multiple readers
--- are blocked on an 'MVar', all of them are woken up at the same time.
---
--- /Compatibility note:/ On GHCs prior to 7.8, 'readMVar' is a combination
--- of 'takeMVar' and 'putMVar'. Consequently, its behavior differs in the
--- following ways:
---
--- * It is single-wakeup instead of multiple-wakeup.
--- * It might not receive the value from the next call to 'putMVar' if
---   there is already a pending thread blocked on 'takeMVar'.
--- * If another thread puts a value in the 'MVar' in between the
---   calls to 'takeMVar' and 'putMVar', that value may be overridden.
-readMVar :: PrimMonad m => MVar (PrimState m) a -> m a
-#if __GLASGOW_HASKELL__ >= 708
-readMVar (MVar mvar#) = primitive $ \ s# -> readMVar# mvar# s#
-#else
-readMVar mv = do
-  a <- takeMVar mv
-  putMVar mv a
-  return a
-#endif
-
--- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
--- 'putMVar' will wait until it becomes empty.
-putMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m ()
-putMVar (MVar mvar#) x = primitive_ (putMVar# mvar# x)
-
--- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function
--- returns immediately, with 'Nothing' if the 'MVar' was empty, or
--- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',
--- the 'MVar' is left empty.
-tryTakeMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
-tryTakeMVar (MVar m) = primitive $ \ s ->
-  case tryTakeMVar# m s of
-    (# s', 0#, _ #) -> (# s', Nothing #) -- MVar is empty
-    (# s', _,  a #) -> (# s', Just a  #) -- MVar is full
-
-
--- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
--- attempts to put the value @a@ into the 'MVar', returning 'True' if
--- it was successful, or 'False' otherwise.
-tryPutMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m Bool
-tryPutMVar (MVar mvar#) x = primitive $ \ s# ->
-    case tryPutMVar# mvar# x s# of
-        (# s, 0# #) -> (# s, False #)
-        (# s, _  #) -> (# s, True #)
-
--- | A non-blocking version of 'readMVar'.  The 'tryReadMVar' function
--- returns immediately, with 'Nothing' if the 'MVar' was empty, or
--- @'Just' a@ if the 'MVar' was full with contents @a@.
---
--- /Compatibility note:/ On GHCs prior to 7.8, 'tryReadMVar' is a combination
--- of 'tryTakeMVar' and 'putMVar'. Consequently, its behavior differs in the
--- following ways:
---
--- * It is single-wakeup instead of multiple-wakeup.
--- * In the presence of other threads calling 'putMVar', 'tryReadMVar'
---   may block.
--- * If another thread puts a value in the 'MVar' in between the
---   calls to 'tryTakeMVar' and 'putMVar', that value may be overridden.
-tryReadMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
-#if __GLASGOW_HASKELL__ >= 708
-tryReadMVar (MVar m) = primitive $ \ s ->
-    case tryReadMVar# m s of
-        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
-        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
-#else
-tryReadMVar mv = do
-  ma <- tryTakeMVar mv
-  case ma of
-    Just a -> do
-      putMVar mv a
-      return (Just a)
-    Nothing -> return Nothing
-#endif
-
--- | Check whether a given 'MVar' is empty.
---
--- Notice that the boolean value returned  is just a snapshot of
--- the state of the MVar. By the time you get to react on its result,
--- the MVar may have been filled (or emptied) - so be extremely
--- careful when using this operation.   Use 'tryTakeMVar' instead if possible.
-isEmptyMVar :: PrimMonad m => MVar (PrimState m) a -> m Bool
-isEmptyMVar (MVar mv#) = primitive $ \ s# ->
-  case isEmptyMVar# mv# s# of
-    (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)