Fix typo
[ghc-hetmet.git] / ghc / compiler / prelude / primops.txt.pp
index 4d7d4d9..ecde882 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.30 2003/10/01 10:57:39 wolfgang Exp $
+-- $Id: primops.txt.pp,v 1.37 2005/11/25 09:46:19 simonmar Exp $
 --
 -- Primitive Operations
 --
@@ -24,8 +24,8 @@
 --               abstract C operations.
 --             
 --     - or, for an out-of-line primop:
---             ghc/includes/PrimOps.h (just add the declaration)
---             ghc/rts/PrimOps.hc     (define it here)
+--             ghc/includes/StgMiscClosures.h (just add the declaration)
+--             ghc/rts/PrimOps.cmm     (define it here)
 --             ghc/rts/Linker.c       (declare the symbol for GHCi)
 --
 --     - the User's Guide 
@@ -65,6 +65,11 @@ defaults
 
 #include "MachDeps.h"
 
+-- We need platform defines (tests for mingw32 below).  However, we only
+-- test the TARGET platform, which doesn't vary between stages, so the
+-- stage1 platform defines are fine:
+#include "../stage1/ghc_boot_platform.h"
+
 section "The word size story."
        {Haskell98 specifies that signed integers (type {\tt Int})
         must contain at least 30 bits. GHC always implements {\tt
@@ -113,11 +118,7 @@ section "The word size story."
         -> Int\#}; otherwise it has type {\tt ByteArr\# -> Int\# ->
         Int32\#}.  This approach confines the necessary {\tt
         \#if}-defs to this file; no conditional compilation is needed
-        in the files that expose these primops, namely
-        \texttt{lib/std/PrelStorable.lhs},
-        \texttt{hslibs/lang/ArrayBase.hs}, and (in deprecated
-        fashion) in \texttt{hslibs/lang/ForeignObj.lhs} and
-        \texttt{hslibs/lang/Addr.lhs}.
+        in the files that expose these primops.
 
         Finally, there are strongly deprecated primops for coercing
          between {\tt Addr\#}, the primitive type of machine
@@ -1115,10 +1116,6 @@ primop  WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
    Addr# -> Int# -> Addr# -> State# s -> State# s
    with has_side_effects = True
 
-primop  WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp
-   Addr# -> Int# -> ForeignObj# -> State# s -> State# s
-   with has_side_effects = True
-
 primop  WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
    Addr# -> Int# -> Float# -> State# s -> State# s
    with has_side_effects = True
@@ -1164,87 +1161,6 @@ primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
    with has_side_effects = True
 
 ------------------------------------------------------------------------
-section "ForeignObj#"
-       {Operations on ForeignObj\#.  The indexing operations are
-       all deprecated.}
-------------------------------------------------------------------------
-
-primop  MkForeignObjOp "mkForeignObj#" GenPrimOp
-   Addr# -> State# RealWorld -> (# State# RealWorld, ForeignObj# #)
-   with
-   has_side_effects = True
-   out_of_line      = True
-
-primop  WriteForeignObjOp "writeForeignObj#" GenPrimOp
-   ForeignObj# -> Addr# -> State# s -> State# s
-   with
-   has_side_effects = True
-
-primop ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp
-   ForeignObj# -> Addr#
-
-primop TouchOp "touch#" GenPrimOp
-   o -> State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-
-primop EqForeignObj "eqForeignObj#" GenPrimOp
-   ForeignObj# -> ForeignObj# -> Bool
-   with commutable = True
-
-primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Char#
-   {Read 8-bit character; offset in bytes.}
-
-primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Char#
-   {Read 31-bit character; offset in 4-byte words.}
-
-primop IndexOffForeignObjOp_Int "indexIntOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Int#
-
-primop IndexOffForeignObjOp_Word "indexWordOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Word#
-
-primop IndexOffForeignObjOp_Addr "indexAddrOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Addr#
-
-primop IndexOffForeignObjOp_Float "indexFloatOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Float#
-
-primop IndexOffForeignObjOp_Double "indexDoubleOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Double#
-
-primop IndexOffForeignObjOp_StablePtr "indexStablePtrOffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> StablePtr# a
-
-primop IndexOffForeignObjOp_Int8 "indexInt8OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Int#
-
-primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Int#
-
-primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> INT32
-
-primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> INT64
-
-primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Word#
-
-primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> Word#
-
-primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> WORD32
-
-primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
-   ForeignObj# -> Int# -> WORD64
-
-
-
-------------------------------------------------------------------------
 section "Mutable variables"
        {Operations on MutVar\#s, which behave like single-element mutable arrays.}
 ------------------------------------------------------------------------
@@ -1334,6 +1250,66 @@ primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
    out_of_line = True
 
 ------------------------------------------------------------------------
+section "STM-accessible Mutable Variables"
+------------------------------------------------------------------------
+
+primop AtomicallyOp "atomically#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> State# RealWorld -> (# State# RealWorld, a #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  RetryOp "retry#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, a #)
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchRetryOp "catchRetry#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchSTMOp "catchSTM#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop NewTVarOp "newTVar#" GenPrimOp
+       a
+    -> State# s -> (# State# s, TVar# s a #)
+   {Create a new Tar\# holding a specified initial value.}
+   with
+   out_of_line  = True
+
+primop ReadTVarOp "readTVar#" GenPrimOp
+       TVar# s a
+    -> State# s -> (# State# s, a #)
+   {Read contents of TVar\#.  Result is not yet evaluated.}
+   with
+   out_of_line = True
+
+primop WriteTVarOp "writeTVar#" GenPrimOp
+       TVar# s a
+    -> a
+    -> State# s -> State# s
+   {Write contents of TVar\#.}
+   with
+   out_of_line     = True
+   has_side_effects = True
+
+primop  SameTVarOp "sameTVar#" GenPrimOp
+   TVar# s a -> TVar# s a -> Bool
+
+
+------------------------------------------------------------------------
 section "Synchronized Mutable Variables"
        {Operations on MVar\#s, which are shared mutable variables
        ({\it not} the same as MutVar\#s!). (Note: in a non-concurrent implementation,
@@ -1524,6 +1500,11 @@ primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
    has_side_effects = True
    out_of_line      = True
 
+primop TouchOp "touch#" GenPrimOp
+   o -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+
 ------------------------------------------------------------------------
 section "Stable pointers and names"
 ------------------------------------------------------------------------
@@ -1654,6 +1635,9 @@ section "Tag to enum stuff"
 
 primop  DataToTagOp "dataToTag#" GenPrimOp
    a -> Int#
+   with
+   strictness  = { \ arity -> mkStrictSig (mkTopDmdType [seqDmd] TopRes) }
+       -- dataToTag# must have an evaluated argument
 
 primop  TagToEnumOp "tagToEnum#" GenPrimOp     
    Int# -> a