FastMutInt.lhs 3.42 KB
Newer Older
1
\begin{code}
2
{-# OPTIONS -cpp #-}
3 4 5 6
{-# OPTIONS_GHC -O #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected

7
--
Simon Marlow's avatar
Simon Marlow committed
8
-- (c) The University of Glasgow 2002-2006
9 10 11 12 13
--
-- Unboxed mutable Ints

module FastMutInt(
	FastMutInt, newFastMutInt,
14 15 16 17
	readFastMutInt, writeFastMutInt,

	FastMutPtr, newFastMutPtr,
	readFastMutPtr, writeFastMutPtr
18 19
  ) where

20
#ifdef __GLASGOW_HASKELL__
21

Simon Marlow's avatar
Simon Marlow committed
22
#include "../includes/MachDeps.h"
23 24 25 26
#ifndef SIZEOF_HSINT
#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
#endif

27
import GHC.Base
28
import GHC.Ptr
29

30
#if __GLASGOW_HASKELL__ >= 611
31
-- import GHC.IO ( IO(..) )
32 33 34 35
#else
import GHC.IOBase ( IO(..) )
#endif

36 37 38 39 40 41 42 43 44
#else /* ! __GLASGOW_HASKELL__ */

import Data.IORef

#endif

newFastMutInt :: IO FastMutInt
readFastMutInt :: FastMutInt -> IO Int
writeFastMutInt :: FastMutInt -> Int -> IO ()
45 46 47 48

newFastMutPtr :: IO FastMutPtr
readFastMutPtr :: FastMutPtr -> IO (Ptr a)
writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
49 50 51 52 53 54 55 56 57
\end{code}

\begin{code}
#ifdef __GLASGOW_HASKELL__
data FastMutInt = FastMutInt (MutableByteArray# RealWorld)

newFastMutInt = IO $ \s ->
  case newByteArray# size s of { (# s, arr #) ->
  (# s, FastMutInt arr #) }
58
  where !(I# size) = SIZEOF_HSINT
59 60 61 62 63 64 65 66

readFastMutInt (FastMutInt arr) = IO $ \s ->
  case readIntArray# arr 0# s of { (# s, i #) ->
  (# s, I# i #) }

writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
  case writeIntArray# arr 0# i s of { s ->
  (# s, () #) }
67 68 69 70 71 72

data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)

newFastMutPtr = IO $ \s ->
  case newByteArray# size s of { (# s, arr #) ->
  (# s, FastMutPtr arr #) }
73
  where !(I# size) = SIZEOF_VOID_P
74 75 76 77 78 79 80 81

readFastMutPtr (FastMutPtr arr) = IO $ \s ->
  case readAddrArray# arr 0# s of { (# s, i #) ->
  (# s, Ptr i #) }

writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
  case writeAddrArray# arr 0# i s of { s ->
  (# s, () #) }
82
#else /* ! __GLASGOW_HASKELL__ */
83 84 85 86
--maybe someday we could use
--http://haskell.org/haskellwiki/Library/ArrayRef
--which has an implementation of IOURefs
--that is unboxed in GHC and just strict in all other compilers...
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
newtype FastMutInt = FastMutInt (IORef Int)

-- If any default value was chosen, it surely would be 0,
-- so we will use that since IORef requires a default value.
-- Or maybe it would be more interesting to package an error,
-- assuming nothing relies on being able to read a bogus Int?
-- That could interfere with its strictness for smart optimizers
-- (are they allowed to optimize a 'newtype' that way?) ...
-- Well, maybe that can be added (in DEBUG?) later.
newFastMutInt = fmap FastMutInt (newIORef 0)

readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt

-- FastMutInt is strict in the value it contains.
writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118


newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))

-- If any default value was chosen, it surely would be 0,
-- so we will use that since IORef requires a default value.
-- Or maybe it would be more interesting to package an error,
-- assuming nothing relies on being able to read a bogus Ptr?
-- That could interfere with its strictness for smart optimizers
-- (are they allowed to optimize a 'newtype' that way?) ...
-- Well, maybe that can be added (in DEBUG?) later.
newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))

readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr

-- FastMutPtr is strict in the value it contains.
writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
119
#endif
120
\end{code}
121