compiler/utils/FastMutInt.lhs

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