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