From 25ad11473b8ba3d7596d83e95e2bee72af9790b1 Mon Sep 17 00:00:00 2001
From: Isaac Dupree <id@isaac.cedarswampstudios.org>
Date: Fri, 1 Jun 2007 20:49:48 +0000
Subject: [PATCH] implement FastMutInt in non-GHC using IORefs (#1405) ghc
 still works, also the module was tested in hugs and ghc

---
 compiler/utils/FastMutInt.lhs |   35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index 2bdec9b..bdcf502 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -10,36 +10,61 @@ 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, () #) }
+#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
 \end{code}
 
-- 
1.7.10.4