compiler/utils/FastMutInt.lhs

   1 {-# OPTIONS -cpp #-}
   2 --
   3 -- (c) The University of Glasgow 2002-2006
   4 --
   5 -- Unboxed mutable Ints
   6
   7 \begin{code}
   8 module FastMutInt(
   9         FastMutInt, newFastMutInt,
  10         readFastMutInt, writeFastMutInt
  11   ) where
  12
  13 #include "HsVersions.h"
  14
  15 #ifdef __GLASGOW_HASKELL__
  16
  17 #include "MachDeps.h"
  18 #ifndef SIZEOF_HSINT
  19 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
  20 #endif
  21
  22 import GHC.Base
  23 import GHC.IOBase
  24
  25 #else /* ! __GLASGOW_HASKELL__ */
  26
  27 import Data.IORef
  28
  29 #endif
  30
  31 newFastMutInt :: IO FastMutInt
  32 readFastMutInt :: FastMutInt -> IO Int
  33 writeFastMutInt :: FastMutInt -> Int -> IO ()
  34 \end{code}
  35
  36 \begin{code}
  37 #ifdef __GLASGOW_HASKELL__
  38 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
  39
  40 newFastMutInt = IO $ \s ->
  41   case newByteArray# size s of { (# s, arr #) ->
  42   (# s, FastMutInt arr #) }
  43   where I# size = SIZEOF_HSINT
  44
  45 readFastMutInt (FastMutInt arr) = IO $ \s ->
  46   case readIntArray# arr 0# s of { (# s, i #) ->
  47   (# s, I# i #) }
  48
  49 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
  50   case writeIntArray# arr 0# i s of { s ->
  51   (# s, () #) }
  52 #else /* ! __GLASGOW_HASKELL__ */
  53 newtype FastMutInt = FastMutInt (IORef Int)
  54
  55 -- If any default value was chosen, it surely would be 0,
  56 -- so we will use that since IORef requires a default value.
  57 -- Or maybe it would be more interesting to package an error,
  58 -- assuming nothing relies on being able to read a bogus Int?
  59 -- That could interfere with its strictness for smart optimizers
  60 -- (are they allowed to optimize a 'newtype' that way?) ...
  61 -- Well, maybe that can be added (in DEBUG?) later.
  62 newFastMutInt = fmap FastMutInt (newIORef 0)
  63
  64 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
  65
  66 -- FastMutInt is strict in the value it contains.
  67 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
  68 #endif
  69 \end{code}
  70