[project @ 1998-12-02 13:17:09 by simonm]

[ghc-hetmet.git] / ghc / lib / exts / IOExts.lhs

diff --git a/ghc/lib/exts/IOExts.lhs b/ghc/lib/exts/IOExts.lhs
index 8b09456..5046356 100644 (file)
--- a/ghc/lib/exts/IOExts.lhs
+++ b/ghc/lib/exts/IOExts.lhs
@@ -29,7 +29,10 @@ module IOExts
        , readIOArray
        , writeIOArray
        , freezeIOArray
+       , thawIOArray
        
+#ifdef __HUGS__
+#else
        , openFileEx
        , IOModeEx(..)
 
@@ -37,11 +40,14 @@ module IOExts
        , hGetEcho
        , hIsTerminalDevice
        , hConnectTo
-
+#endif
         , trace
+#ifdef __HUGS__
+#else
         , performGC
+#endif
        
-       , reallyUnsafePtrEq
+       , unsafePtrEq
        , unsafeIOToST
 
         ) where
@@ -49,6 +55,10 @@ module IOExts
 \end{code}
 
 \begin{code}
+#ifdef __HUGS__
+import PreludeBuiltin
+import ST
+#else
 import PrelBase
 import PrelIOBase
 import PrelHandle ( openFileEx, IOModeEx(..),
@@ -57,41 +67,63 @@ import PrelHandle ( openFileEx, IOModeEx(..),
 import PrelST
 import PrelArr
 import PrelGHC
-import Ix
-import IO
 import PrelHandle
 import PrelErr
+import IO      ( hPutStr, hPutChar )
+#endif
+import Ix
 
-reallyUnsafePtrEq :: a -> a -> Bool
-reallyUnsafePtrEq a b =
+unsafePtrEq :: a -> a -> Bool
+
+#ifdef __HUGS__
+unsafePtrEq = primReallyUnsafePtrEquality
+#else
+unsafePtrEq a b =
     case reallyUnsafePtrEquality# a b of
         0# -> False
         _  -> True
+#endif
 \end{code}
 
 \begin{code}
+newIORef   :: a -> IO (IORef a)
+readIORef  :: IORef a -> IO a
+writeIORef :: IORef a -> a -> IO ()
+
+#ifdef __HUGS__
+type IORef a = STRef RealWorld a
+newIORef   = newSTRef
+readIORef  = readSTRef
+writeIORef = writeSTRef
+#else
 newtype IORef a = IORef (MutableVar RealWorld a) 
     deriving Eq
 
-newIORef :: a -> IO (IORef a)
 newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
-
-readIORef :: IORef a -> IO a
-readIORef (IORef var) = stToIO (readVar var)
-
-writeIORef :: IORef a -> a -> IO ()
+readIORef  (IORef var) = stToIO (readVar var)
 writeIORef (IORef var) v = stToIO (writeVar var v)
+#endif
 \end{code}
 
 \begin{code}
-newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
-    deriving Eq
-
 newIOArray          :: Ix ix => (ix,ix) -> elt -> IO (IOArray ix elt)
 boundsIOArray       :: Ix ix => IOArray ix elt -> (ix, ix)
 readIOArray         :: Ix ix => IOArray ix elt -> ix -> IO elt
 writeIOArray        :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
 freezeIOArray       :: Ix ix => IOArray ix elt -> IO (Array ix elt)
+thawIOArray        :: Ix ix => Array ix elt -> IO (IOArray ix elt)
+
+#ifdef __HUGS__
+type IOArray ix elt = STArray RealWorld ix elt
+newIOArray    = newSTArray
+boundsIOArray = boundsSTArray
+readIOArray   = readSTArray
+writeIOArray  = writeSTArray
+freezeIOArray = freezeSTArray
+thawIOArray   = thawSTArray
+#else
+newtype IOArray ix elt = IOArray (MutableArray RealWorld ix elt)
+    deriving Eq
 
 newIOArray ixs elt = 
     stToIO (newArray ixs elt) >>= \arr -> 
@@ -104,25 +136,40 @@ readIOArray (IOArray arr) ix = stToIO (readArray arr ix)
 writeIOArray (IOArray arr) ix elt = stToIO (writeArray arr ix elt)
 
 freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
+
+thawIOArray arr = do 
+       marr <- stToIO (thawArray arr)
+       return (IOArray marr)
+#endif
 \end{code}
 
 \begin{code}
 {-# NOINLINE trace #-}
 trace :: String -> a -> a
+#ifdef __HUGS__
+trace string expr = unsafePerformIO $ do
+    putStrLn string
+    return expr
+#else
 trace string expr = unsafePerformIO $ do
     fd <- getHandleFd stderr
-    hPutStrLn stderr string
+    hPutStr stderr string
+    hPutChar stderr '\n'
     _ccall_ PostTraceHook fd
     return expr
-
+#endif
 \end{code}
 
 \begin{code}
 unsafeIOToST      :: IO a -> ST s a
+#ifdef __HUGS__
+unsafeIOToST = primUnsafeCoerce
+#else
 unsafeIOToST (IO io) = ST $ \ s ->
     case ((unsafeCoerce# io) s) of
-      IOok   new_s a -> unsafeCoerce# (STret new_s a)
-      IOfail new_s e -> error ("I/O Error (unsafeIOToST): " ++ showsPrec 0 e "\n")
+      (#  new_s, a #) -> unsafeCoerce# (STret new_s a)
+--      IOfail new_s e -> error ("I/O Error (unsafeIOToST): " ++ showsPrec 0 e "\n")
+#endif
 \end{code}
 
 Not something you want to call normally, but useful
@@ -130,6 +177,10 @@ in the cases where you do want to flush stuff out of
 the heap or make sure you've got room enough
 
 \begin{code}
+#ifdef __HUGS__
+#else
 performGC :: IO ()
-performGC = _ccall_GC_ StgPerformGarbageCollection
+performGC = _ccall_GC_ performGC
+#endif
 \end{code}
+