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 {-# OPTIONS -w #-}
   9 -- The above warning supression flag is a temporary kludge.
  10 -- While working on this module you are encouraged to remove it and fix
  11 -- any warnings in the module. See
  12 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  13 -- for details
  14
  15 module FastMutInt(
  16         FastMutInt, newFastMutInt,
  17         readFastMutInt, writeFastMutInt
  18   ) where
  19
  20 #include "HsVersions.h"
  21
  22 #ifdef __GLASGOW_HASKELL__
  23
  24 #include "MachDeps.h"
  25 #ifndef SIZEOF_HSINT
  26 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
  27 #endif
  28
  29 import GHC.Base
  30 import GHC.IOBase
  31
  32 #else /* ! __GLASGOW_HASKELL__ */
  33
  34 import Data.IORef
  35
  36 #endif
  37
  38 newFastMutInt :: IO FastMutInt
  39 readFastMutInt :: FastMutInt -> IO Int
  40 writeFastMutInt :: FastMutInt -> Int -> IO ()
  41 \end{code}
  42
  43 \begin{code}
  44 #ifdef __GLASGOW_HASKELL__
  45 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
  46
  47 newFastMutInt = IO $ \s ->
  48   case newByteArray# size s of { (# s, arr #) ->
  49   (# s, FastMutInt arr #) }
  50   where I# size = SIZEOF_HSINT
  51
  52 readFastMutInt (FastMutInt arr) = IO $ \s ->
  53   case readIntArray# arr 0# s of { (# s, i #) ->
  54   (# s, I# i #) }
  55
  56 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
  57   case writeIntArray# arr 0# i s of { s ->
  58   (# s, () #) }
  59 #else /* ! __GLASGOW_HASKELL__ */
  60 --maybe someday we could use
  61 --http://haskell.org/haskellwiki/Library/ArrayRef
  62 --which has an implementation of IOURefs
  63 --that is unboxed in GHC and just strict in all other compilers...
  64 newtype FastMutInt = FastMutInt (IORef Int)
  65
  66 -- If any default value was chosen, it surely would be 0,
  67 -- so we will use that since IORef requires a default value.
  68 -- Or maybe it would be more interesting to package an error,
  69 -- assuming nothing relies on being able to read a bogus Int?
  70 -- That could interfere with its strictness for smart optimizers
  71 -- (are they allowed to optimize a 'newtype' that way?) ...
  72 -- Well, maybe that can be added (in DEBUG?) later.
  73 newFastMutInt = fmap FastMutInt (newIORef 0)
  74
  75 readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
  76
  77 -- FastMutInt is strict in the value it contains.
  78 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
  79 #endif
  80 \end{code}
  81