3 -- (c) The University of Glasgow 2002-2006
5 -- Unboxed mutable Ints
9 FastMutInt, newFastMutInt,
10 readFastMutInt, writeFastMutInt,
12 FastMutPtr, newFastMutPtr,
13 readFastMutPtr, writeFastMutPtr
16 #ifdef __GLASGOW_HASKELL__
20 #define SIZEOF_HSINT INT_SIZE_IN_BYTES
27 #else /* ! __GLASGOW_HASKELL__ */
33 newFastMutInt :: IO FastMutInt
34 readFastMutInt :: FastMutInt -> IO Int
35 writeFastMutInt :: FastMutInt -> Int -> IO ()
37 newFastMutPtr :: IO FastMutPtr
38 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
39 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
43 #ifdef __GLASGOW_HASKELL__
44 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
46 newFastMutInt = IO $ \s ->
47 case newByteArray# size s of { (# s, arr #) ->
48 (# s, FastMutInt arr #) }
49 where I# size = SIZEOF_HSINT
51 readFastMutInt (FastMutInt arr) = IO $ \s ->
52 case readIntArray# arr 0# s of { (# s, i #) ->
55 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
56 case writeIntArray# arr 0# i s of { s ->
59 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
61 newFastMutPtr = IO $ \s ->
62 case newByteArray# size s of { (# s, arr #) ->
63 (# s, FastMutPtr arr #) }
64 where I# size = SIZEOF_VOID_P
66 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
67 case readAddrArray# arr 0# s of { (# s, i #) ->
70 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
71 case writeAddrArray# arr 0# i s of { s ->
73 #else /* ! __GLASGOW_HASKELL__ */
74 --maybe someday we could use
75 --http://haskell.org/haskellwiki/Library/ArrayRef
76 --which has an implementation of IOURefs
77 --that is unboxed in GHC and just strict in all other compilers...
78 newtype FastMutInt = FastMutInt (IORef Int)
80 -- If any default value was chosen, it surely would be 0,
81 -- so we will use that since IORef requires a default value.
82 -- Or maybe it would be more interesting to package an error,
83 -- assuming nothing relies on being able to read a bogus Int?
84 -- That could interfere with its strictness for smart optimizers
85 -- (are they allowed to optimize a 'newtype' that way?) ...
86 -- Well, maybe that can be added (in DEBUG?) later.
87 newFastMutInt = fmap FastMutInt (newIORef 0)
89 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
91 -- FastMutInt is strict in the value it contains.
92 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
95 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
97 -- If any default value was chosen, it surely would be 0,
98 -- so we will use that since IORef requires a default value.
99 -- Or maybe it would be more interesting to package an error,
100 -- assuming nothing relies on being able to read a bogus Ptr?
101 -- That could interfere with its strictness for smart optimizers
102 -- (are they allowed to optimize a 'newtype' that way?) ...
103 -- Well, maybe that can be added (in DEBUG?) later.
104 newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
106 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
108 -- FastMutPtr is strict in the value it contains.
109 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i