2 {-# LANGUAGE BangPatterns #-}
5 -- We always optimise this, otherwise performance of a non-optimised
6 -- compiler is severely affected
9 -- (c) The University of Glasgow 2002-2006
11 -- Unboxed mutable Ints
14 FastMutInt, newFastMutInt,
15 readFastMutInt, writeFastMutInt,
17 FastMutPtr, newFastMutPtr,
18 readFastMutPtr, writeFastMutPtr
21 #ifdef __GLASGOW_HASKELL__
23 #include "../includes/MachDeps.h"
25 #define SIZEOF_HSINT INT_SIZE_IN_BYTES
31 #if __GLASGOW_HASKELL__ >= 611
32 -- import GHC.IO ( IO(..) )
34 import GHC.IOBase ( IO(..) )
37 #else /* ! __GLASGOW_HASKELL__ */
43 newFastMutInt :: IO FastMutInt
44 readFastMutInt :: FastMutInt -> IO Int
45 writeFastMutInt :: FastMutInt -> Int -> IO ()
47 newFastMutPtr :: IO FastMutPtr
48 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
49 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
53 #ifdef __GLASGOW_HASKELL__
54 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
56 newFastMutInt = IO $ \s ->
57 case newByteArray# size s of { (# s, arr #) ->
58 (# s, FastMutInt arr #) }
59 where !(I# size) = SIZEOF_HSINT
61 readFastMutInt (FastMutInt arr) = IO $ \s ->
62 case readIntArray# arr 0# s of { (# s, i #) ->
65 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
66 case writeIntArray# arr 0# i s of { s ->
69 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
71 newFastMutPtr = IO $ \s ->
72 case newByteArray# size s of { (# s, arr #) ->
73 (# s, FastMutPtr arr #) }
74 where !(I# size) = SIZEOF_VOID_P
76 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
77 case readAddrArray# arr 0# s of { (# s, i #) ->
80 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
81 case writeAddrArray# arr 0# i s of { s ->
83 #else /* ! __GLASGOW_HASKELL__ */
84 --maybe someday we could use
85 --http://haskell.org/haskellwiki/Library/ArrayRef
86 --which has an implementation of IOURefs
87 --that is unboxed in GHC and just strict in all other compilers...
88 newtype FastMutInt = FastMutInt (IORef Int)
90 -- If any default value was chosen, it surely would be 0,
91 -- so we will use that since IORef requires a default value.
92 -- Or maybe it would be more interesting to package an error,
93 -- assuming nothing relies on being able to read a bogus Int?
94 -- That could interfere with its strictness for smart optimizers
95 -- (are they allowed to optimize a 'newtype' that way?) ...
96 -- Well, maybe that can be added (in DEBUG?) later.
97 newFastMutInt = fmap FastMutInt (newIORef 0)
99 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
101 -- FastMutInt is strict in the value it contains.
102 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
105 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
107 -- If any default value was chosen, it surely would be 0,
108 -- so we will use that since IORef requires a default value.
109 -- Or maybe it would be more interesting to package an error,
110 -- assuming nothing relies on being able to read a bogus Ptr?
111 -- That could interfere with its strictness for smart optimizers
112 -- (are they allowed to optimize a 'newtype' that way?) ...
113 -- Well, maybe that can be added (in DEBUG?) later.
114 newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
116 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
118 -- FastMutPtr is strict in the value it contains.
119 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i