X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrimOp.lhs;h=4a6e215de98b0efd70426070ba7a15e4ca27ac8d;hb=3160f854580e6d8df412c8cd34d93bae27175d67;hp=3570e60c09efe0049ddffb9f237c182c01990195;hpb=8295d9ca0f3e72e545b35c43a4a2e1e4ec582fb6;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 3570e60..4a6e215 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -161,6 +161,7 @@ data PrimOp
     | TakeMVarOp 
     | PutMVarOp
     | SameMVarOp
+    | IsEmptyMVarOp
 
     -- exceptions
     | CatchOp
@@ -490,36 +491,37 @@ tagOf_PrimOp NewMVarOp			      = ILIT(196)
 tagOf_PrimOp TakeMVarOp		    	      = ILIT(197)
 tagOf_PrimOp PutMVarOp		    	      = ILIT(198)
 tagOf_PrimOp SameMVarOp		    	      = ILIT(199)
-tagOf_PrimOp MakeForeignObjOp		      = ILIT(200)
-tagOf_PrimOp WriteForeignObjOp		      = ILIT(201)
-tagOf_PrimOp MkWeakOp			      = ILIT(202)
-tagOf_PrimOp DeRefWeakOp		      = ILIT(203)
-tagOf_PrimOp MakeStablePtrOp		      = ILIT(204)
-tagOf_PrimOp DeRefStablePtrOp		      = ILIT(205)
-tagOf_PrimOp EqStablePtrOp		      = ILIT(206)
-tagOf_PrimOp (CCallOp _ _ _ _)		      = ILIT(207)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp	      = ILIT(208)
-tagOf_PrimOp SeqOp			      = ILIT(209)
-tagOf_PrimOp ParOp			      = ILIT(210)
-tagOf_PrimOp ForkOp			      = ILIT(211)
-tagOf_PrimOp KillThreadOp		      = ILIT(212)
-tagOf_PrimOp DelayOp			      = ILIT(213)
-tagOf_PrimOp WaitReadOp			      = ILIT(214)
-tagOf_PrimOp WaitWriteOp		      = ILIT(215)
-tagOf_PrimOp ParGlobalOp		      = ILIT(216)
-tagOf_PrimOp ParLocalOp			      = ILIT(217)
-tagOf_PrimOp ParAtOp			      = ILIT(218)
-tagOf_PrimOp ParAtAbsOp			      = ILIT(219)
-tagOf_PrimOp ParAtRelOp			      = ILIT(220)
-tagOf_PrimOp ParAtForNowOp		      = ILIT(221)
-tagOf_PrimOp CopyableOp			      = ILIT(222)
-tagOf_PrimOp NoFollowOp			      = ILIT(223)
-tagOf_PrimOp NewMutVarOp		      = ILIT(224)
-tagOf_PrimOp ReadMutVarOp		      = ILIT(225)
-tagOf_PrimOp WriteMutVarOp		      = ILIT(226)
-tagOf_PrimOp SameMutVarOp		      = ILIT(227)
-tagOf_PrimOp CatchOp			      = ILIT(228)
-tagOf_PrimOp RaiseOp			      = ILIT(229)
+tagOf_PrimOp IsEmptyMVarOp	    	      = ILIT(200)
+tagOf_PrimOp MakeForeignObjOp		      = ILIT(201)
+tagOf_PrimOp WriteForeignObjOp		      = ILIT(202)
+tagOf_PrimOp MkWeakOp			      = ILIT(203)
+tagOf_PrimOp DeRefWeakOp		      = ILIT(204)
+tagOf_PrimOp MakeStablePtrOp		      = ILIT(205)
+tagOf_PrimOp DeRefStablePtrOp		      = ILIT(206)
+tagOf_PrimOp EqStablePtrOp		      = ILIT(207)
+tagOf_PrimOp (CCallOp _ _ _ _)		      = ILIT(208)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp	      = ILIT(209)
+tagOf_PrimOp SeqOp			      = ILIT(210)
+tagOf_PrimOp ParOp			      = ILIT(211)
+tagOf_PrimOp ForkOp			      = ILIT(212)
+tagOf_PrimOp KillThreadOp		      = ILIT(213)
+tagOf_PrimOp DelayOp			      = ILIT(214)
+tagOf_PrimOp WaitReadOp			      = ILIT(215)
+tagOf_PrimOp WaitWriteOp		      = ILIT(216)
+tagOf_PrimOp ParGlobalOp		      = ILIT(217)
+tagOf_PrimOp ParLocalOp			      = ILIT(218)
+tagOf_PrimOp ParAtOp			      = ILIT(219)
+tagOf_PrimOp ParAtAbsOp			      = ILIT(220)
+tagOf_PrimOp ParAtRelOp			      = ILIT(221)
+tagOf_PrimOp ParAtForNowOp		      = ILIT(222)
+tagOf_PrimOp CopyableOp			      = ILIT(223)
+tagOf_PrimOp NoFollowOp			      = ILIT(224)
+tagOf_PrimOp NewMutVarOp		      = ILIT(225)
+tagOf_PrimOp ReadMutVarOp		      = ILIT(226)
+tagOf_PrimOp WriteMutVarOp		      = ILIT(227)
+tagOf_PrimOp SameMutVarOp		      = ILIT(228)
+tagOf_PrimOp CatchOp			      = ILIT(229)
+tagOf_PrimOp RaiseOp			      = ILIT(230)
 
 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
 --panic# "tagOf_PrimOp: pattern-match"
@@ -751,6 +753,7 @@ allThePrimOps
 	TakeMVarOp,
 	PutMVarOp,
 	SameMVarOp,
+	IsEmptyMVarOp,
 	MakeForeignObjOp,
 	WriteForeignObjOp,
 	MkWeakOp,
@@ -856,13 +859,24 @@ primOpStrictness :: PrimOp -> ([Demand], Bool)
 	-- Use only the ones you ned.
 
 primOpStrictness SeqOp            = ([wwLazy], False)
+primOpStrictness ParOp            = ([wwLazy], False)
+primOpStrictness ForkOp		  = ([wwLazy, wwPrim], False)
+
+primOpStrictness NewArrayOp       = ([wwPrim, wwLazy, wwPrim], False)
 primOpStrictness WriteArrayOp     = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
+
+primOpStrictness NewMutVarOp	  = ([wwLazy, wwPrim], False)
 primOpStrictness WriteMutVarOp	  = ([wwPrim, wwLazy, wwPrim], False)
+
 primOpStrictness PutMVarOp	  = ([wwPrim, wwLazy, wwPrim], False)
+
 primOpStrictness CatchOp	  = ([wwLazy, wwLazy], False)
 primOpStrictness RaiseOp	  = ([wwLazy], True)	-- NB: True => result is bottom
+
 primOpStrictness MkWeakOp	  = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
 primOpStrictness MakeStablePtrOp  = ([wwLazy, wwPrim], False)
+
+	-- The rest all have primitive-typed arguments
 primOpStrictness other		  = (repeat wwPrim, False)
 \end{code}
 
@@ -1439,6 +1453,16 @@ primOpInfo SameMVarOp
 	mvar_ty = mkMVarPrimTy s elt
     in
     mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
+
+primOpInfo IsEmptyMVarOp
+  = let
+	elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+	state = mkStatePrimTy s
+    in
+    mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
+	[mkMVarPrimTy s elt, mkStatePrimTy s]
+	(unboxedPair [state, intPrimTy])
+
 \end{code}
 
 %************************************************************************