X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FFastMutInt.lhs;h=90b4b9e9e55a52bb4fbe915c25c2361cbbd88ce1;hb=0ee1d0fd7b5cae2857fe6632cbee5441c011bb99;hp=3c2a199198fc8a2f277f5e85f7b5d2c2de5b808d;hpb=317fc69d18eda68fd65f5ba634feafbe4a3923da;p=ghc-hetmet.git diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index 3c2a199..90b4b9e 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -10,36 +10,65 @@ module FastMutInt( readFastMutInt, writeFastMutInt ) where -#include "MachDeps.h" +#include "HsVersions.h" + +#ifdef __GLASGOW_HASKELL__ +#include "MachDeps.h" #ifndef SIZEOF_HSINT #define SIZEOF_HSINT INT_SIZE_IN_BYTES #endif - import GHC.Base import GHC.IOBase + +#else /* ! __GLASGOW_HASKELL__ */ + +import Data.IORef + +#endif + +newFastMutInt :: IO FastMutInt +readFastMutInt :: FastMutInt -> IO Int +writeFastMutInt :: FastMutInt -> Int -> IO () \end{code} \begin{code} #ifdef __GLASGOW_HASKELL__ data FastMutInt = FastMutInt (MutableByteArray# RealWorld) -newFastMutInt :: IO FastMutInt newFastMutInt = IO $ \s -> case newByteArray# size s of { (# s, arr #) -> (# s, FastMutInt arr #) } where I# size = SIZEOF_HSINT -readFastMutInt :: FastMutInt -> IO Int readFastMutInt (FastMutInt arr) = IO $ \s -> case readIntArray# arr 0# s of { (# s, i #) -> (# s, I# i #) } -writeFastMutInt :: FastMutInt -> Int -> IO () writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s -> case writeIntArray# arr 0# i s of { s -> (# s, () #) } -\end{code} +#else /* ! __GLASGOW_HASKELL__ */ +--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... +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 +\end{code}