[project @ 1998-07-17 11:59:36 by simonm]

Add sameMVar# primop, and use it to define an instance for Eq (MVar a).

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index d083b88..420e172 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -153,6 +153,7 @@ data PrimOp
     | SizeofByteArrayOp   | SizeofMutableByteArrayOp
 
     | NewSynchVarOp -- for MVars and IVars
+    | SameMVarOp
     | TakeMVarOp | PutMVarOp
     | ReadIVarOp | WriteIVarOp
 
@@ -453,6 +454,7 @@ tagOf_PrimOp ParAtRelOp                           = ILIT(190)
 tagOf_PrimOp ParAtForNowOp                   = ILIT(191)
 tagOf_PrimOp CopyableOp                              = ILIT(192)
 tagOf_PrimOp NoFollowOp                              = ILIT(193)
+tagOf_PrimOp SameMVarOp                              = ILIT(194)
 
 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
 
@@ -628,6 +630,7 @@ allThePrimOps
        SizeofByteArrayOp,
        SizeofMutableByteArrayOp,
        NewSynchVarOp,
+        SameMVarOp,
        ReadArrayOp,
        TakeMVarOp,
        PutMVarOp,
@@ -1146,6 +1149,14 @@ primOpInfo NewSynchVarOp
     AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
                                stateAndSynchVarPrimTyCon [s, elt]
 
+primOpInfo SameMVarOp
+  = let {
+       elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+       mvar_ty = mkSynchVarPrimTy s elt
+    } in
+    AlgResult SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty]
+       boolTyCon []
+
 primOpInfo TakeMVarOp
   = let {
        elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar

diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh
index d040d69..d3ca835 100644 (file)
--- a/ghc/includes/StgMacros.lh
+++ b/ghc/includes/StgMacros.lh
@@ -1299,6 +1299,8 @@ void newArrZh_init PROTO((P_ result, I_ n, P_ init));
 \begin{code}
 ED_(PrelBase_Z91Z93_closure);
 
+#define sameMVarZh(r,a,b)      r=(I_)((a)==(b))
+
 #define newSynchVarZh(r, hp)                           \
 {                                                      \
   ALLOC_PRIM(MUTUPLE_HS,3,0,MUTUPLE_HS+3) /* ticky ticky */; \

diff --git a/ghc/lib/std/PrelConc.lhs b/ghc/lib/std/PrelConc.lhs
index 04d6d60..e2da14b 100644 (file)
--- a/ghc/lib/std/PrelConc.lhs
+++ b/ghc/lib/std/PrelConc.lhs
@@ -88,6 +88,9 @@ writes.
 \begin{code}
 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 
+instance Eq (MVar a) where
+       (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+
 newEmptyMVar  :: IO (MVar a)
 
 newEmptyMVar = IO $ \ s# ->