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