0f0ca78e144ca2f71d4809823cbbd0239b6ef047
[ghc.git] / compiler / utils / FastMutInt.lhs
1 \begin{code}
2 {-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}
3 {-# OPTIONS_GHC -O #-}
4 -- We always optimise this, otherwise performance of a non-optimised
5 -- compiler is severely affected
6 --
7 -- (c) The University of Glasgow 2002-2006
8 --
9 -- Unboxed mutable Ints
10
11 module FastMutInt(
12         FastMutInt, newFastMutInt,
13         readFastMutInt, writeFastMutInt,
14
15         FastMutPtr, newFastMutPtr,
16         readFastMutPtr, writeFastMutPtr
17   ) where
18
19 #ifdef __GLASGOW_HASKELL__
20
21 #include "../includes/MachDeps.h"
22 #ifndef SIZEOF_HSINT
23 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
24 #endif
25
26 import GHC.Base
27 import GHC.Ptr
28
29 #else /* ! __GLASGOW_HASKELL__ */
30
31 import Data.IORef
32
33 #endif
34
35 newFastMutInt :: IO FastMutInt
36 readFastMutInt :: FastMutInt -> IO Int
37 writeFastMutInt :: FastMutInt -> Int -> IO ()
38
39 newFastMutPtr :: IO FastMutPtr
40 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
41 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
42 \end{code}
43
44 \begin{code}
45 #ifdef __GLASGOW_HASKELL__
46 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
47
48 newFastMutInt = IO $ \s ->
49   case newByteArray# size s of { (# s, arr #) ->
50   (# s, FastMutInt arr #) }
51   where !(I# size) = SIZEOF_HSINT
52
53 readFastMutInt (FastMutInt arr) = IO $ \s ->
54   case readIntArray# arr 0# s of { (# s, i #) ->
55   (# s, I# i #) }
56
57 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
58   case writeIntArray# arr 0# i s of { s ->
59   (# s, () #) }
60
61 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
62
63 newFastMutPtr = IO $ \s ->
64   case newByteArray# size s of { (# s, arr #) ->
65   (# s, FastMutPtr arr #) }
66   where !(I# size) = SIZEOF_VOID_P
67
68 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
69   case readAddrArray# arr 0# s of { (# s, i #) ->
70   (# s, Ptr i #) }
71
72 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
73   case writeAddrArray# arr 0# i s of { s ->
74   (# s, () #) }
75 #else /* ! __GLASGOW_HASKELL__ */
76 --maybe someday we could use
77 --http://haskell.org/haskellwiki/Library/ArrayRef
78 --which has an implementation of IOURefs
79 --that is unboxed in GHC and just strict in all other compilers...
80 newtype FastMutInt = FastMutInt (IORef Int)
81
82 -- If any default value was chosen, it surely would be 0,
83 -- so we will use that since IORef requires a default value.
84 -- Or maybe it would be more interesting to package an error,
85 -- assuming nothing relies on being able to read a bogus Int?
86 -- That could interfere with its strictness for smart optimizers
87 -- (are they allowed to optimize a 'newtype' that way?) ...
88 -- Well, maybe that can be added (in DEBUG?) later.
89 newFastMutInt = fmap FastMutInt (newIORef 0)
90
91 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
92
93 -- FastMutInt is strict in the value it contains.
94 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
95
96
97 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
98
99 -- If any default value was chosen, it surely would be 0,
100 -- so we will use that since IORef requires a default value.
101 -- Or maybe it would be more interesting to package an error,
102 -- assuming nothing relies on being able to read a bogus Ptr?
103 -- That could interfere with its strictness for smart optimizers
104 -- (are they allowed to optimize a 'newtype' that way?) ...
105 -- Well, maybe that can be added (in DEBUG?) later.
106 newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
107
108 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
109
110 -- FastMutPtr is strict in the value it contains.
111 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
112 #endif
113 \end{code}
114