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 #else /* ! __GLASGOW_HASKELL__ */
37 newFastMutInt :: IO FastMutInt
38 readFastMutInt :: FastMutInt -> IO Int
39 writeFastMutInt :: FastMutInt -> Int -> IO ()
41 newFastMutPtr :: IO FastMutPtr
42 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
43 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
47 #ifdef __GLASGOW_HASKELL__
48 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
50 newFastMutInt = IO $ \s ->
51 case newByteArray# size s of { (# s, arr #) ->
52 (# s, FastMutInt arr #) }
53 where !(I# size) = SIZEOF_HSINT
55 readFastMutInt (FastMutInt arr) = IO $ \s ->
56 case readIntArray# arr 0# s of { (# s, i #) ->
59 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
60 case writeIntArray# arr 0# i s of { s ->
63 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
65 newFastMutPtr = IO $ \s ->
66 case newByteArray# size s of { (# s, arr #) ->
67 (# s, FastMutPtr arr #) }
68 where !(I# size) = SIZEOF_VOID_P
70 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
71 case readAddrArray# arr 0# s of { (# s, i #) ->
74 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
75 case writeAddrArray# arr 0# i s of { s ->
77 #else /* ! __GLASGOW_HASKELL__ */
78 --maybe someday we could use
79 --http://haskell.org/haskellwiki/Library/ArrayRef
80 --which has an implementation of IOURefs
81 --that is unboxed in GHC and just strict in all other compilers...
82 newtype FastMutInt = FastMutInt (IORef Int)
84 -- If any default value was chosen, it surely would be 0,
85 -- so we will use that since IORef requires a default value.
86 -- Or maybe it would be more interesting to package an error,
87 -- assuming nothing relies on being able to read a bogus Int?
88 -- That could interfere with its strictness for smart optimizers
89 -- (are they allowed to optimize a 'newtype' that way?) ...
90 -- Well, maybe that can be added (in DEBUG?) later.
91 newFastMutInt = fmap FastMutInt (newIORef 0)
93 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
95 -- FastMutInt is strict in the value it contains.
96 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
99 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
101 -- If any default value was chosen, it surely would be 0,
102 -- so we will use that since IORef requires a default value.
103 -- Or maybe it would be more interesting to package an error,
104 -- assuming nothing relies on being able to read a bogus Ptr?
105 -- That could interfere with its strictness for smart optimizers
106 -- (are they allowed to optimize a 'newtype' that way?) ...
107 -- Well, maybe that can be added (in DEBUG?) later.
108 newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
110 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
112 -- FastMutPtr is strict in the value it contains.
113 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i