From: simonm <unknown>
Date: Fri, 17 Jul 1998 11:59:45 +0000 (+0000)
Subject: [project @ 1998-07-17 11:59:36 by simonm]
X-Git-Tag: Approx_2487_patches~517
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=03a16bc43d75aa9bd98255acfa2ea6eec77db6de;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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# ->