4 -- We always optimise this, otherwise performance of a non-optimised
5 -- compiler is severely affected
8 -- (c) The University of Glasgow 2002-2006
10 -- Unboxed mutable Ints
13 FastMutInt, newFastMutInt,
14 readFastMutInt, writeFastMutInt,
16 FastMutPtr, newFastMutPtr,
17 readFastMutPtr, writeFastMutPtr
20 #ifdef __GLASGOW_HASKELL__
22 #include "../includes/MachDeps.h"
24 #define SIZEOF_HSINT INT_SIZE_IN_BYTES
30 #if __GLASGOW_HASKELL__ >= 611
31 -- import GHC.IO ( IO(..) )
33 import GHC.IOBase ( IO(..) )
36 #else /* ! __GLASGOW_HASKELL__ */
42 newFastMutInt :: IO FastMutInt
43 readFastMutInt :: FastMutInt -> IO Int
44 writeFastMutInt :: FastMutInt -> Int -> IO ()
46 newFastMutPtr :: IO FastMutPtr
47 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
48 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
52 #ifdef __GLASGOW_HASKELL__
53 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
55 newFastMutInt = IO $ \s ->
56 case newByteArray# size s of { (# s, arr #) ->
57 (# s, FastMutInt arr #) }
58 where !(I# size) = SIZEOF_HSINT
60 readFastMutInt (FastMutInt arr) = IO $ \s ->
61 case readIntArray# arr 0# s of { (# s, i #) ->
64 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
65 case writeIntArray# arr 0# i s of { s ->
68 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
70 newFastMutPtr = IO $ \s ->
71 case newByteArray# size s of { (# s, arr #) ->
72 (# s, FastMutPtr arr #) }
73 where !(I# size) = SIZEOF_VOID_P
75 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
76 case readAddrArray# arr 0# s of { (# s, i #) ->
79 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
80 case writeAddrArray# arr 0# i s of { s ->
82 #else /* ! __GLASGOW_HASKELL__ */
83 --maybe someday we could use
84 --http://haskell.org/haskellwiki/Library/ArrayRef
85 --which has an implementation of IOURefs
86 --that is unboxed in GHC and just strict in all other compilers...
87 newtype FastMutInt = FastMutInt (IORef Int)
89 -- If any default value was chosen, it surely would be 0,
90 -- so we will use that since IORef requires a default value.
91 -- Or maybe it would be more interesting to package an error,
92 -- assuming nothing relies on being able to read a bogus Int?
93 -- That could interfere with its strictness for smart optimizers
94 -- (are they allowed to optimize a 'newtype' that way?) ...
95 -- Well, maybe that can be added (in DEBUG?) later.
96 newFastMutInt = fmap FastMutInt (newIORef 0)
98 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
100 -- FastMutInt is strict in the value it contains.
101 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
104 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
106 -- If any default value was chosen, it surely would be 0,
107 -- so we will use that since IORef requires a default value.
108 -- Or maybe it would be more interesting to package an error,
109 -- assuming nothing relies on being able to read a bogus Ptr?
110 -- That could interfere with its strictness for smart optimizers
111 -- (are they allowed to optimize a 'newtype' that way?) ...
112 -- Well, maybe that can be added (in DEBUG?) later.
113 newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
115 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
117 -- FastMutPtr is strict in the value it contains.
118 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i