[project @ 1999-01-14 19:53:57 by sof]

[ghc-hetmet.git] / ghc / compiler / prelude / PrimOp.lhs

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 9d7075a..8dd4415 100644 (file)
--- 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,6 +859,9 @@ 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)
 
@@ -1447,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}
 
 %************************************************************************
@@ -2009,22 +2025,28 @@ pprPrimOp (CCallOp fun is_casm may_gc cconv)
         callconv = text "{-" <> pprCallConv cconv <> text "-}"
 
        before
-         | is_casm && may_gc = "__casm_GC ``"
-         | is_casm           = "__casm ``"
-         | may_gc            = "__ccall_GC "
-         | otherwise         = "__ccall "
+         | is_casm && may_gc = "casm_GC ``"
+         | is_casm           = "casm ``"
+         | may_gc            = "ccall_GC "
+         | otherwise         = "ccall "
 
        after
          | is_casm   = text "''"
          | otherwise = empty
+         
+       ppr_dyn =
+         case fun of
+           Right _ -> text "dyn_"
+           _       -> empty
 
        ppr_fun =
         case fun of
-          Right _ -> ptext SLIT("<dynamic>")
+          Right _ -> text "\"\""
           Left fn -> ptext fn
         
     in
     hcat [ ifPprDebug callconv
+        , text "__", ppr_dyn
          , text before , ppr_fun , after]
 
 pprPrimOp other_op