Commit 25ad1147 authored by Isaac Dupree's avatar Isaac Dupree
Browse files

implement FastMutInt in non-GHC using IORefs (#1405)

ghc still works, also the module was tested in hugs and ghc
parent 9bbcd77c
...@@ -10,36 +10,61 @@ module FastMutInt( ...@@ -10,36 +10,61 @@ module FastMutInt(
readFastMutInt, writeFastMutInt readFastMutInt, writeFastMutInt
) where ) where
#include "MachDeps.h" #include "HsVersions.h"
#ifdef __GLASGOW_HASKELL__
#include "MachDeps.h"
#ifndef SIZEOF_HSINT #ifndef SIZEOF_HSINT
#define SIZEOF_HSINT INT_SIZE_IN_BYTES #define SIZEOF_HSINT INT_SIZE_IN_BYTES
#endif #endif
import GHC.Base import GHC.Base
import GHC.IOBase import GHC.IOBase
#else /* ! __GLASGOW_HASKELL__ */
import Data.IORef
#endif
newFastMutInt :: IO FastMutInt
readFastMutInt :: FastMutInt -> IO Int
writeFastMutInt :: FastMutInt -> Int -> IO ()
\end{code} \end{code}
\begin{code} \begin{code}
#ifdef __GLASGOW_HASKELL__ #ifdef __GLASGOW_HASKELL__
data FastMutInt = FastMutInt (MutableByteArray# RealWorld) data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
newFastMutInt :: IO FastMutInt
newFastMutInt = IO $ \s -> newFastMutInt = IO $ \s ->
case newByteArray# size s of { (# s, arr #) -> case newByteArray# size s of { (# s, arr #) ->
(# s, FastMutInt arr #) } (# s, FastMutInt arr #) }
where I# size = SIZEOF_HSINT where I# size = SIZEOF_HSINT
readFastMutInt :: FastMutInt -> IO Int
readFastMutInt (FastMutInt arr) = IO $ \s -> readFastMutInt (FastMutInt arr) = IO $ \s ->
case readIntArray# arr 0# s of { (# s, i #) -> case readIntArray# arr 0# s of { (# s, i #) ->
(# s, I# i #) } (# s, I# i #) }
writeFastMutInt :: FastMutInt -> Int -> IO ()
writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s -> writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
case writeIntArray# arr 0# i s of { s -> case writeIntArray# arr 0# i s of { s ->
(# s, () #) } (# s, () #) }
#else /* ! __GLASGOW_HASKELL__ */
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
#endif #endif
\end{code} \end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment