[project @ 2000-05-25 12:41:14 by simonpj]

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

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 393dc85..a55af16 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -42,9 +42,9 @@ import Type           ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
                           UsageAnn(..), mkUsgTy
                        )
 import Unique          ( Unique, mkPrimOpIdUnique )
-import BasicTypes      ( Arity )
+import BasicTypes      ( Arity, Boxity(..) )
 import CStrings                ( CLabelString, pprCLabelString )
-import PrelMods                ( pREL_GHC, pREL_GHC_Name )
+import PrelNames       ( pREL_GHC, pREL_GHC_Name )
 import Outputable
 import Util            ( assoc, zipWithEqual )
 import GlaExts         ( Int(..), Int#, (==#) )
@@ -176,7 +176,7 @@ data PrimOp
     | TakeMVarOp 
     | PutMVarOp
     | SameMVarOp
-    | TakeMaybeMVarOp 
+    | TryTakeMVarOp 
     | IsEmptyMVarOp
 
     -- exceptions
@@ -460,7 +460,7 @@ tagOf_PrimOp NewMVarOp                            = ILIT(217)
 tagOf_PrimOp TakeMVarOp                              = ILIT(218)
 tagOf_PrimOp PutMVarOp                       = ILIT(219)
 tagOf_PrimOp SameMVarOp                              = ILIT(220)
-tagOf_PrimOp TakeMaybeMVarOp                 = ILIT(221)
+tagOf_PrimOp TryTakeMVarOp                   = ILIT(221)
 tagOf_PrimOp IsEmptyMVarOp                   = ILIT(222)
 tagOf_PrimOp MkForeignObjOp                  = ILIT(223)
 tagOf_PrimOp WriteForeignObjOp               = ILIT(224)
@@ -751,7 +751,7 @@ allThePrimOps               -- Except CCall, which is really a family of primops
        TakeMVarOp,
        PutMVarOp,
        SameMVarOp,
-       TakeMaybeMVarOp,
+       TryTakeMVarOp,
        IsEmptyMVarOp,
        MkForeignObjOp,
        WriteForeignObjOp,
@@ -832,9 +832,10 @@ an_Integer_and_Int_tys
   = [intPrimTy, byteArrayPrimTy, -- Integer
      intPrimTy]
 
-unboxedPair     = mkUnboxedTupleTy 2
-unboxedTriple    = mkUnboxedTupleTy 3
-unboxedQuadruple = mkUnboxedTupleTy 4
+unboxedSingleton = mkTupleTy Unboxed 1
+unboxedPair     = mkTupleTy Unboxed 2
+unboxedTriple    = mkTupleTy Unboxed 3
+unboxedQuadruple = mkTupleTy Unboxed 4
 
 mkIOTy ty = mkFunTy realWorldStatePrimTy 
                    (unboxedPair [realWorldStatePrimTy,ty])
@@ -1270,7 +1271,7 @@ primOpInfo WriteArrayOp
 primOpInfo IndexArrayOp
   = let { elt = alphaTy; elt_tv = alphaTyVar } in
     mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
-       (mkUnboxedTupleTy 1 [elt])
+       (unboxedSingleton [elt])
 
 ---------------------------------------------------------------------------
 -- Primitive arrays full of unboxed bytes:
@@ -1523,12 +1524,12 @@ primOpInfo SameMVarOp
     in
     mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
 
-primOpInfo TakeMaybeMVarOp
+primOpInfo TryTakeMVarOp
   = let
        elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
        state = mkStatePrimTy s
     in
-    mkGenPrimOp SLIT("takeMaybeMVar#") [s_tv, elt_tv]
+    mkGenPrimOp SLIT("tryTakeMVar#") [s_tv, elt_tv]
        [mkMVarPrimTy s elt, state]
        (unboxedTriple [state, intPrimTy, elt])
 
@@ -1914,7 +1915,7 @@ perform a heap check or they block.
 primOpOutOfLine op
   = case op of
        TakeMVarOp                   -> True
-       TakeMaybeMVarOp              -> True
+       TryTakeMVarOp                -> True
        PutMVarOp                    -> True
        DelayOp                      -> True
        WaitReadOp                   -> True
@@ -2079,7 +2080,7 @@ primOpHasSideEffects UnsafeFreezeByteArrayOp      = True
 primOpHasSideEffects UnsafeThawArrayOp         = True
 
 primOpHasSideEffects TakeMVarOp        = True
-primOpHasSideEffects TakeMaybeMVarOp   = True
+primOpHasSideEffects TryTakeMVarOp     = True
 primOpHasSideEffects PutMVarOp         = True
 primOpHasSideEffects DelayOp           = True
 primOpHasSideEffects WaitReadOp        = True
@@ -2244,7 +2245,7 @@ primOpUsg op
       TakeMVarOp           -> mangle [mkM, mkP          ] mkM
       PutMVarOp            -> mangle [mkM, mkM, mkP     ] mkR
       SameMVarOp           -> mangle [mkP, mkP          ] mkM
-      TakeMaybeMVarOp      -> mangle [mkM, mkP          ] mkM
+      TryTakeMVarOp        -> mangle [mkM, mkP          ] mkM
       IsEmptyMVarOp        -> mangle [mkP, mkP          ] mkM
 
       ForkOp               -> mangle [mkO, mkP          ] mkR
@@ -2302,8 +2303,8 @@ primOpUsg op
                          Nothing    -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
 
         inUB fs ty  = case splitTyConApp_maybe ty of
-                        Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
-                                         mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
+                        Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
+                                         mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg"
                                                                          ($) fs tys)
                         Nothing       -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
 \end{code}
@@ -2409,6 +2410,7 @@ data CCall
                Bool            -- True <=> really a "casm"
                Bool            -- True <=> might invoke Haskell GC
                CallConv        -- calling convention to use.
+  deriving( Eq )
 
 data CCallTarget
   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
@@ -2416,6 +2418,7 @@ data CCallTarget
                                --   (unique is used to generate a 'typedef' to cast
                                --    the function pointer if compiling the ccall# down to
                                --    .hc code - can't do this inline for tedious reasons.)
+  deriving( Eq )
 
 ccallMayGC :: CCall -> Bool
 ccallMayGC (CCall _ _ may_gc _) = may_gc