[project @ 2002-01-29 17:12:53 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelConc.lhs

diff --git a/ghc/lib/std/PrelConc.lhs b/ghc/lib/std/PrelConc.lhs
index 0122dd8..e011060 100644 (file)
--- a/ghc/lib/std/PrelConc.lhs
+++ b/ghc/lib/std/PrelConc.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelConc.lhs,v 1.22 2001/02/13 15:23:33 rrt Exp $
+% $Id: PrelConc.lhs,v 1.25 2001/09/14 15:49:56 simonpj Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -19,7 +19,7 @@ module PrelConc
        , killThread    -- :: ThreadId -> IO ()
        , throwTo       -- :: ThreadId -> Exception -> IO ()
        , par           -- :: a -> b -> b
-       , seq           -- :: a -> b -> b
+       , pseq          -- :: a -> b -> b
        , yield         -- :: IO ()
 
        -- Waiting
@@ -34,18 +34,20 @@ module PrelConc
        , takeMVar      -- :: MVar a -> IO a
        , putMVar       -- :: MVar a -> a -> IO ()
        , tryTakeMVar   -- :: MVar a -> IO (Maybe a)
+       , tryPutMVar    -- :: MVar a -> a -> IO Bool
        , isEmptyMVar   -- :: MVar a -> IO Bool
+       , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
 
     ) where
 
 import PrelBase
 import PrelMaybe
-import PrelErr ( parError, seqError )
+import PrelErr         ( parError, seqError )
 import PrelIOBase      ( IO(..), MVar(..) )
 import PrelBase                ( Int(..) )
 import PrelException    ( Exception(..), AsyncException(..) )
 
-infixr 0 `par`, `seq`
+infixr 0 `par`, `pseq`
 \end{code}
 
 %************************************************************************
@@ -78,7 +80,10 @@ yield :: IO ()
 yield = IO $ \s -> 
    case (yield# s) of s1 -> (# s1, () #)
 
--- "seq" is defined a bit weirdly (see below)
+--     Nota Bene: 'pseq' used to be 'seq'
+--                but 'seq' is now defined in PrelGHC
+--
+-- "pseq" is defined a bit weirdly (see below)
 --
 -- The reason for the strange "0# -> parError" case is that
 -- it fools the compiler into thinking that seq is non-strict in
@@ -89,9 +94,9 @@ yield = IO $ \s ->
 -- Just before converting from Core to STG there's a bit of magic
 -- that recognises the seq# and eliminates the duff case.
 
-{-# INLINE seq  #-}
-seq :: a -> b -> b
-seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
+{-# INLINE pseq  #-}
+pseq :: a -> b -> b
+pseq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
 
 {-# INLINE par  #-}
 par :: a -> b -> b
@@ -128,6 +133,12 @@ putMVar (MVar mvar#) x = IO $ \ s# ->
     case putMVar# mvar# x s# of
         s2# -> (# s2#, () #)
 
+tryPutMVar  :: MVar a -> a -> IO Bool
+tryPutMVar (MVar mvar#) x = IO $ \ s# ->
+    case tryPutMVar# mvar# x s# of
+        (# s, 0# #) -> (# s, False #)
+        (# s, _  #) -> (# s, True #)
+
 newMVar :: a -> IO (MVar a)
 newMVar value =
     newEmptyMVar       >>= \ mvar ->
@@ -159,6 +170,11 @@ isEmptyMVar :: MVar a -> IO Bool
 isEmptyMVar (MVar mv#) = IO $ \ s# -> 
     case isEmptyMVar# mv# s# of
         (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
+
+-- Like addForeignPtrFinalizer, but for MVars
+addMVarFinalizer :: MVar a -> IO () -> IO ()
+addMVarFinalizer (MVar m) finalizer = 
+  IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
 \end{code}