[project @ 1999-11-26 16:26:32 by simonmar]

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

diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index caa50db..bf7a64f 100644 (file)
--- 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.15 1999/11/26 16:26: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
@@ -146,6 +146,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 +370,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 +397,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