ghc/compiler/utils/FastMutInt.lhs

   1 {-# OPTIONS -cpp #-}
   2 --
   3 -- (c) The University of Glasgow 2002
   4 --
   5 -- Unboxed mutable Ints
   6
   7 \begin{code}
   8 module FastMutInt(
   9         FastMutInt, newFastMutInt,
  10         readFastMutInt, writeFastMutInt,
  11         incFastMutInt, incFastMutIntBy
  12   ) where
  13
  14 #include "MachDeps.h"
  15
  16 #ifndef SIZEOF_HSINT
  17 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
  18 #endif
  19
  20
  21 #if __GLASGOW_HASKELL__ < 503
  22 import GlaExts
  23 import PrelIOBase
  24 #else
  25 import GHC.Base
  26 import GHC.IOBase
  27 #endif
  28
  29 #if __GLASGOW_HASKELL__ < 411
  30 newByteArray# = newCharArray#
  31 #endif
  32 \end{code}
  33
  34 \begin{code}
  35 #ifdef __GLASGOW_HASKELL__
  36 data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
  37
  38 newFastMutInt :: IO FastMutInt
  39 newFastMutInt = IO $ \s ->
  40   case newByteArray# size s of { (# s, arr #) ->
  41   (# s, FastMutInt arr #) }
  42   where I# size = SIZEOF_HSINT
  43
  44 readFastMutInt :: FastMutInt -> IO Int
  45 readFastMutInt (FastMutInt arr) = IO $ \s ->
  46   case readIntArray# arr 0# s of { (# s, i #) ->
  47   (# s, I# i #) }
  48
  49 writeFastMutInt :: FastMutInt -> Int -> IO ()
  50 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
  51   case writeIntArray# arr 0# i s of { s ->
  52   (# s, () #) }
  53
  54 incFastMutInt :: FastMutInt -> IO Int   -- Returns original value
  55 incFastMutInt (FastMutInt arr) = IO $ \s ->
  56   case readIntArray# arr 0# s of { (# s, i #) ->
  57   case writeIntArray# arr 0# (i +# 1#) s of { s ->
  58   (# s, I# i #) } }
  59
  60 incFastMutIntBy :: FastMutInt -> Int -> IO Int  -- Returns original value
  61 incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s ->
  62   case readIntArray# arr 0# s of { (# s, i #) ->
  63   case writeIntArray# arr 0# (i +# n) s of { s ->
  64   (# s, I# i #) } }
  65 \end{code}
  66 #endif
  67