[project @ 1999-11-17 16:58:43 by andy]

[ghc-hetmet.git] / ghc / lib / hugs / Prelude.hs

diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs
index 8696608..91dc813 100644 (file)
--- a/ghc/lib/hugs/Prelude.hs
+++ b/ghc/lib/hugs/Prelude.hs
@@ -94,7 +94,7 @@ module Prelude (
               isInfinite, isDenormalized, isIEEE, isNegativeZero),
     Monad((>>=), (>>), return, fail),
     Functor(fmap),
-    mapM, mapM_, accumulate, sequence, (=<<),
+    mapM, mapM_, sequence, sequence_, (=<<),
     maybe, either,
     (&&), (||), not, otherwise,
     subtract, even, odd, gcd, lcm, (^), (^^), 
@@ -103,6 +103,8 @@ module Prelude (
     asTypeOf, error, undefined,
     seq, ($!)
 
+    , MVar, newMVar, putMVar, takeMVar
+
     ,trace
     -- Arrrggghhh!!! Help! Help! Help!
     -- What?!  Prelude.hs doesn't even _define_ most of these things!
@@ -110,8 +112,23 @@ module Prelude (
     ,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
     ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
     ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
-    ,unsafeInterleaveIO,nh_write,primCharToInt
+    ,unsafeInterleaveIO,nh_write,primCharToInt,
+    nullAddr, incAddr, isNullAddr,
+
+    Word,
+    primGtWord, primGeWord, primEqWord, primNeWord,
+    primLtWord, primLeWord, primMinWord, primMaxWord,
+    primPlusWord, primMinusWord, primTimesWord, primQuotWord,
+    primRemWord, primQuotRemWord, primNegateWord, primAndWord,
+    primOrWord, primXorWord, primNotWord, primShiftLWord,
+    primShiftRAWord, primShiftRLWord, primIntToWord, primWordToInt,
+
+    primAndInt, primOrInt, primXorInt, primNotInt,
+    primShiftLInt, primShiftRAInt,  primShiftRLInt,
+
+    primAddrToInt, primIntToAddr,
 
+    primDoubleToFloat, primFloatToDouble,
     -- debugging hacks
     --,ST(..)
     --,primIntToAddr
@@ -402,20 +419,20 @@ class Monad m where
     p >> q  = p >>= \ _ -> q
     fail s  = error s
 
-accumulate       :: Monad m => [m a] -> m [a]
-accumulate []     = return []
-accumulate (c:cs) = do x  <- c
-                      xs <- accumulate cs
-                      return (x:xs)
+sequence       :: Monad m => [m a] -> m [a]
+sequence []     = return []
+sequence (c:cs) = do x  <- c
+                    xs <- sequence cs
+                    return (x:xs)
 
-sequence         :: Monad m => [m a] -> m ()
-sequence          = foldr (>>) (return ())
+sequence_        :: Monad m => [m a] -> m () 
+sequence_        =  foldr (>>) (return ())
 
 mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
-mapM f            = accumulate . map f
+mapM f            = sequence . map f
 
 mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
-mapM_ f           = sequence . map f
+mapM_ f           = sequence_ . map f
 
 (=<<)            :: Monad m => (a -> m b) -> m a -> m b
 f =<< x           = x >>= f
@@ -633,14 +650,6 @@ instance Show a => Show [a]  where
 -- data (a,b) = (a,b) deriving (Eq, Ord, Ix, Read, Show)
 -- etc..
 
--- Functions ----------------------------------------------------------------
-
-instance Show (a -> b) where
-    showsPrec p f = showString "<<function>>"
-
-instance Functor ((->) a) where
-    fmap = (.)
-
 -- Standard Integral types --------------------------------------------------
 
 data Int      -- builtin datatype of fixed size integers
@@ -1541,8 +1550,8 @@ primPmInt n x     = fromInt n == x
 primPmInteger    :: Num a => Integer -> a -> Bool
 primPmInteger n x = fromInteger n == x
 
-primPmFlt        :: Fractional a => Double -> a -> Bool
-primPmFlt n x     = fromDouble n == x
+primPmDouble     :: Fractional a => Double -> a -> Bool
+primPmDouble n x  = fromDouble n == x
 
 -- ToDo: make the message more informative.
 primPmFail       :: a
@@ -1759,7 +1768,7 @@ writetohandle fname h (c:cs)
 primGetRawArgs :: IO [String]
 primGetRawArgs
    = primGetArgc >>= \argc ->
-     accumulate (map get_one_arg [0 .. argc-1])
+     sequence (map get_one_arg [0 .. argc-1])
      where
         get_one_arg :: Int -> IO String
         get_one_arg argno
@@ -1782,6 +1791,9 @@ primGetEnv v
 -- ST, IO --------------------------------------------------------------------
 ------------------------------------------------------------------------------
 
+-- Do not change this newtype to a data, or MVars will stop
+-- working.  In general the MVar stuff is pretty fragile: do
+-- not mess with it.
 newtype ST s a = ST (s -> (a,s))
 
 data RealWorld
@@ -1828,7 +1840,7 @@ unsafeInterleaveIO = unsafeInterleaveST
 
 
 ------------------------------------------------------------------------------
--- Word, Addr, StablePtr, Prim*Array -----------------------------------------
+-- Word, Addr, StablePtr, Prim*Array, ThreadId, MVar -------------------------
 ------------------------------------------------------------------------------
 
 data Addr
@@ -1847,7 +1859,6 @@ instance Ord Addr where
   (>=)            = primGeAddr
   (>)             = primGtAddr
 
-
 data Word
 
 instance Eq Word where 
@@ -1860,7 +1871,6 @@ instance Ord Word where
   (>=)            = primGeWord
   (>)             = primGtWord
 
-
 data StablePtr a
 
 makeStablePtr   :: a -> IO (StablePtr a)
@@ -1878,6 +1888,41 @@ data Ref                  s a -- mutable variables
 data PrimMutableArray     s a -- mutable arrays with Int indices
 data PrimMutableByteArray s
 
+data ThreadId
+
+data MVar a
+
+
+newMVar :: IO (MVar a)
+newMVar = primNewMVar
+
+putMVar :: MVar a -> a -> IO ()
+putMVar = primPutMVar
+
+takeMVar :: MVar a -> IO a
+takeMVar m
+   = ST (\world -> primTakeMVar m cont world)
+     where
+        -- cont :: a -> RealWorld -> (a,RealWorld)
+        -- where 'a' is as in the top-level signature
+        cont x world = (x,world)
+
+        -- the type of the handwritten BCO (threesome) primTakeMVar is
+        -- primTakeMVar :: MVar a 
+        --                 -> (a -> RealWorld -> (a,RealWorld)) 
+        --                 -> RealWorld 
+        --                 -> (a,RealWorld)
+        --
+        -- primTakeMVar behaves like this:
+        --
+        -- primTakeMVar (MVar# m#) cont world
+        --    = primTakeMVar_wrk m# cont world
+        --
+        -- primTakeMVar_wrk m# cont world
+        --    = cont (takeMVar# m#) world
+        --
+        -- primTakeMVar_wrk has the special property that it is
+        -- restartable by the scheduler, should the MVar be empty.
 
 
 -- showFloat ------------------------------------------------------------------