X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FFastMutInt.lhs;h=26183071f15c2622b5d5cd8ad7eafd5612822535;hp=fae79d66be7fa7c74b62d102ed781a071efbb7b3;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4

diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index fae79d6..2618307 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -1,33 +1,32 @@
+\begin{code}
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS -cpp #-}
+{-# OPTIONS_GHC -O #-}
+-- We always optimise this, otherwise performance of a non-optimised
+-- compiler is severely affected
+
 --
 -- (c) The University of Glasgow 2002-2006
 --
 -- Unboxed mutable Ints
 
-\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module FastMutInt(
 	FastMutInt, newFastMutInt,
-	readFastMutInt, writeFastMutInt
-  ) where
+	readFastMutInt, writeFastMutInt,
 
-#include "HsVersions.h"
+	FastMutPtr, newFastMutPtr,
+	readFastMutPtr, writeFastMutPtr
+  ) where
 
 #ifdef __GLASGOW_HASKELL__
 
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 #ifndef SIZEOF_HSINT
 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
 #endif
 
 import GHC.Base
-import GHC.IOBase
+import GHC.Ptr
 
 #else /* ! __GLASGOW_HASKELL__ */
 
@@ -38,6 +37,10 @@ import Data.IORef
 newFastMutInt :: IO FastMutInt
 readFastMutInt :: FastMutInt -> IO Int
 writeFastMutInt :: FastMutInt -> Int -> IO ()
+
+newFastMutPtr :: IO FastMutPtr
+readFastMutPtr :: FastMutPtr -> IO (Ptr a)
+writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
 \end{code}
 
 \begin{code}
@@ -47,7 +50,7 @@ data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
 newFastMutInt = IO $ \s ->
   case newByteArray# size s of { (# s, arr #) ->
   (# s, FastMutInt arr #) }
-  where I# size = SIZEOF_HSINT
+  where !(I# size) = SIZEOF_HSINT
 
 readFastMutInt (FastMutInt arr) = IO $ \s ->
   case readIntArray# arr 0# s of { (# s, i #) ->
@@ -56,6 +59,21 @@ readFastMutInt (FastMutInt arr) = IO $ \s ->
 writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
   case writeIntArray# arr 0# i s of { s ->
   (# s, () #) }
+
+data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)
+
+newFastMutPtr = IO $ \s ->
+  case newByteArray# size s of { (# s, arr #) ->
+  (# s, FastMutPtr arr #) }
+  where !(I# size) = SIZEOF_VOID_P
+
+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, () #) }
 #else /* ! __GLASGOW_HASKELL__ */
 --maybe someday we could use
 --http://haskell.org/haskellwiki/Library/ArrayRef
@@ -76,6 +94,23 @@ readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
 
 -- FastMutInt is strict in the value it contains.
 writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
+
+
+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
 #endif
 \end{code}