[project @ 1999-07-27 11:12:05 by simonmar]

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

diff --git a/ghc/lib/exts/IOExts.lhs b/ghc/lib/exts/IOExts.lhs
index 5bbd8f0..b973fa6 100644 (file)
--- a/ghc/lib/exts/IOExts.lhs
+++ b/ghc/lib/exts/IOExts.lhs
@@ -23,6 +23,8 @@ module IOExts
         , readIORef
         , writeIORef
 
+       , mkWeakIORef
+
        , IOArray       -- instance of: Eq
        , newIOArray
        , boundsIOArray
@@ -30,6 +32,10 @@ module IOExts
        , writeIOArray
        , freezeIOArray
        , thawIOArray
+#ifndef __HUGS__
+       , unsafeFreezeIOArray
+       , unsafeThawIOArray
+#endif
        
 #ifdef __HUGS__
 #else
@@ -48,8 +54,8 @@ module IOExts
 #endif
        
        , unsafePtrEq
-       , unsafeIOToST
-       , stToIO
+       
+       , freeHaskellFunctionPtr
 
         ) where
 
@@ -67,10 +73,12 @@ import PrelHandle ( openFileEx, IOModeEx(..),
                  )
 import PrelST
 import PrelArr
+import PrelWeak
 import PrelGHC
 import PrelHandle
 import PrelErr
 import IO      ( hPutStr, hPutChar )
+import PrelAddr ( Addr )
 #endif
 import Ix
 
@@ -104,6 +112,10 @@ newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
 readIORef  (IORef var) = stToIO (readVar var)
 writeIORef (IORef var) v = stToIO (writeVar var v)
 #endif
+
+mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
+mkWeakIORef r@(IORef (MutableVar r#)) f = IO $ \s ->
+  case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
 \end{code}
 
 \begin{code}
@@ -113,6 +125,10 @@ 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)
+#ifndef __HUGS__
+unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
+unsafeThawIOArray   :: Ix ix => Array ix elt -> IO (IOArray ix elt)
+#endif
 
 #ifdef __HUGS__
 type IOArray ix elt = STArray RealWorld ix elt
@@ -141,6 +157,11 @@ freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
 thawIOArray arr = do 
        marr <- stToIO (thawArray arr)
        return (IOArray marr)
+
+unsafeFreezeIOArray (IOArray arr) = stToIO (unsafeFreezeArray arr)
+unsafeThawIOArray   arr = do
+        marr <- stToIO (unsafeThawArray arr)
+       return (IOArray marr)
 #endif
 \end{code}
 
@@ -161,18 +182,6 @@ trace string expr = unsafePerformIO $ do
 #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
-      (#  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
 in the cases where you do want to flush stuff out of
 the heap or make sure you've got room enough
@@ -185,3 +194,18 @@ performGC = _ccall_GC_ performGC
 #endif
 \end{code}
 
+When using 'foreign export dynamic' to dress up a Haskell
+IO action to look like a C function pointer, a little bit
+of memory is allocated (along with a stable pointer to
+the Haskell IO action). When done with the C function
+pointer, you'll need to call @freeHaskellFunctionPtr()@ to
+let go of these resources - here's the Haskell wrapper for
+that RTS entry point, should you want to free it from
+within Haskell.
+
+\begin{code}
+foreign import ccall "freeHaskellFunctionPtr" 
+  freeHaskellFunctionPtr :: Addr -> IO ()
+
+\end{code}
+