compiler/utils/FastMutInt.lhs

   1 \begin{code}
   2 {-# OPTIONS -cpp #-}
   3 {-# OPTIONS_GHC -O #-}
   4 -- We always optimise this, otherwise performance of a non-optimised
   5 -- compiler is severely affected
   6
   7 --
   8 -- (c) The University of Glasgow 2002-2006
   9 --
  10 -- Unboxed mutable Ints
  11
  12 module FastMutInt(
  13         FastMutInt, newFastMutInt,
  14         readFastMutInt, writeFastMutInt,
  15
  16         FastMutPtr, newFastMutPtr,
  17         readFastMutPtr, writeFastMutPtr
  18   ) where
  19
  20 #ifdef __GLASGOW_HASKELL__
  21
  22 #include "MachDeps.h"
  23 #ifndef SIZEOF_HSINT
  24 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
  25 #endif
  26
  27 import GHC.Base
  28 import GHC.Ptr
  29
  30 #if __GLASGOW_HASKELL__ >= 611
  31 import GHC.IO ( IO(..) )
  32 #else
  33 import GHC.IOBase ( IO(..) )
  34 #endif
  35
  36 #else /* ! __GLASGOW_HASKELL__ */
  37
  38 import Data.IORef
  39
  40 #endif
  41
  42 newFastMutInt :: IO FastMutInt
  43 readFastMutInt :: FastMutInt -> IO Int
  44 writeFastMutInt :: FastMutInt -> Int -> IO ()
  45
  46 newFastMutPtr :: IO FastMutPtr
  47 readFastMutPtr :: FastMutPtr -> IO (Ptr a)
  48 writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
  49 \end{code}
  50
  51 \begin{code}
  52 #ifdef __GLASGOW_HASKELL__
  53 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
  54
  55 newFastMutInt = IO $ \s ->
  56   case newByteArray# size s of { (# s, arr #) ->
  57   (# s, FastMutInt arr #) }
  58   where !(I# size) = SIZEOF_HSINT
  59
  60 readFastMutInt (FastMutInt arr) = IO $ \s ->
  61   case readIntArray# arr 0# s of { (# s, i #) ->
  62   (# s, I# i #) }
  63
  64 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
  65   case writeIntArray# arr 0# i s of { s ->
  66   (# s, () #) }
  67
  68 data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
  69
  70 newFastMutPtr = IO $ \s ->
  71   case newByteArray# size s of { (# s, arr #) ->
  72   (# s, FastMutPtr arr #) }
  73   where !(I# size) = SIZEOF_VOID_P
  74
  75 readFastMutPtr (FastMutPtr arr) = IO $ \s ->
  76   case readAddrArray# arr 0# s of { (# s, i #) ->
  77   (# s, Ptr i #) }
  78
  79 writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
  80   case writeAddrArray# arr 0# i s of { s ->
  81   (# 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)
  88
  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)
  97
  98 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
  99
 100 -- FastMutInt is strict in the value it contains.
 101 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
 102
 103
 104 newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
 105
 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))
 114
 115 readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
 116
 117 -- FastMutPtr is strict in the value it contains.
 118 writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
 119 #endif
 120 \end{code}
 121