X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelIOBase.lhs;h=9f8aa77b6983e0f84f35da80d2220831ef49e108;hb=84ccb85d938577d5244e51678e1b459d27781855;hp=caa50db1f8b10beb8b4e56f4ed3a43c4e91b4c7f;hpb=ba98a8762849d4b6cfc1ac31f878ac6c50383907;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index caa50db..9f8aa77 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.13 1999/09/19 19:12:41 sof Exp $
+% $Id: PrelIOBase.lhs,v 1.17 2000/01/30 10:11:32 simonmar Exp $
 % 
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
@@ -11,7 +11,7 @@ concretely; the @IO@ module itself exports abstractly.
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-#include "cbits/error.h"
+#include "cbits/stgerror.h"
 
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelIOBase where
@@ -55,6 +55,23 @@ The IO Monad is just an instance of the ST monad, where the state is
 the real world.  We use the exception mechanism (in PrelException) to
 implement IO exceptions.
 
+NOTE: The IO representation is deeply wired in to various parts of the
+system.  The following list may or may not be exhaustive:
+
+Compiler  - types of various primitives in PrimOp.lhs
+
+RTS 	  - forceIO (StgMiscClosures.hc)
+	  - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast 
+	    (Exceptions.hc)
+	  - raiseAsync (Schedule.c)
+
+Prelude   - PrelIOBase.lhs, and several other places including
+	    PrelException.lhs.
+
+Libraries - parts of hslibs/lang.
+
+--SDM
+
 \begin{code}
 #ifndef __HUGS__
 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
@@ -75,10 +92,6 @@ instance  Monad IO  where
     m >>= k     = bindIO m k
     fail s	= error s -- not ioError?
 
-    -- not required but worth having around
-fixIO 		:: (a -> IO a) -> IO a
-fixIO m         = stToIO (fixST (ioToST . m))
-
 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
 
@@ -146,6 +159,9 @@ data IOError
      String	     -- location
      String          -- error type specific information.
 
+instance Eq IOError where
+  (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) = 
+    e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
 
 data IOErrorType
   = AlreadyExists        | HardwareFault
@@ -367,12 +383,25 @@ a handles reside in @IOHandle@.
 -}
 data MVar a = MVar (MVar# RealWorld a)
 
+-- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
+instance Eq (MVar a) where
+	(MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+
 {-
   Double sigh - ForeignObj is needed here too to break a cycle.
 -}
 data ForeignObj = ForeignObj ForeignObj#   -- another one
 instance CCallable ForeignObj
-instance CCallable ForeignObj#
+
+eqForeignObj :: ForeignObj  -> ForeignObj -> Bool
+eqForeignObj mp1 mp2
+  = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
+
+foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
+
+instance Eq ForeignObj where 
+    p == q = eqForeignObj p q
+    p /= q = not (eqForeignObj p q)
 #endif /* ndef __HUGS__ */
 
 #if defined(__CONCURRENT_HASKELL__)
@@ -381,6 +410,9 @@ newtype Handle = Handle (MVar Handle__)
 newtype Handle = Handle (MutableVar RealWorld Handle__)
 #endif
 
+instance Eq Handle where
+ (Handle h1) == (Handle h2) = h1 == h2
+
 {-
   A Handle is represented by (a reference to) a record 
   containing the state of the I/O port/device. We record