FastMutInt.lhs 3.42 KB
 Ian Lynagh committed Jul 10, 2008 1 \begin{code}  simonpj committed Apr 01, 2002 2 {-# OPTIONS -cpp #-}  Ian Lynagh committed Jul 10, 2008 3 4 5 6 {-# OPTIONS_GHC -O #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected  simonpj committed Apr 01, 2002 7 --  Simon Marlow committed Oct 11, 2006 8 -- (c) The University of Glasgow 2002-2006  simonpj committed Apr 01, 2002 9 10 11 12 13 -- -- Unboxed mutable Ints module FastMutInt( FastMutInt, newFastMutInt,  Simon Marlow committed May 28, 2008 14 15 16 17  readFastMutInt, writeFastMutInt, FastMutPtr, newFastMutPtr, readFastMutPtr, writeFastMutPtr  simonpj committed Apr 01, 2002 18 19  ) where  Isaac Dupree committed Jun 01, 2007 20 #ifdef __GLASGOW_HASKELL__  simonpj committed Apr 01, 2002 21   Simon Marlow committed Aug 02, 2009 22 #include "../includes/MachDeps.h"  simonpj committed Apr 01, 2002 23 24 25 26 #ifndef SIZEOF_HSINT #define SIZEOF_HSINT INT_SIZE_IN_BYTES #endif  panne committed Apr 01, 2002 27 import GHC.Base  Simon Marlow committed May 28, 2008 28 import GHC.Ptr  Isaac Dupree committed Jun 01, 2007 29   Simon Marlow committed May 29, 2009 30 #if __GLASGOW_HASKELL__ >= 611  simonpj@microsoft.com committed Jul 06, 2009 31 -- import GHC.IO ( IO(..) )  Simon Marlow committed May 29, 2009 32 33 34 35 #else import GHC.IOBase ( IO(..) ) #endif  Isaac Dupree committed Jun 01, 2007 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 ()  Simon Marlow committed May 28, 2008 45 46 47 48  newFastMutPtr :: IO FastMutPtr readFastMutPtr :: FastMutPtr -> IO (Ptr a) writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()  simonpj committed Apr 01, 2002 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 #) }  Ian Lynagh committed Apr 24, 2009 58  where !(I# size) = SIZEOF_HSINT  simonpj committed Apr 01, 2002 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, () #) }  Simon Marlow committed May 28, 2008 67 68 69 70 71 72  data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld) newFastMutPtr = IO$ \s -> case newByteArray# size s of { (# s, arr #) -> (# s, FastMutPtr arr #) }  Ian Lynagh committed Apr 24, 2009 73  where !(I# size) = SIZEOF_VOID_P  Simon Marlow committed May 28, 2008 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, () #) }  Isaac Dupree committed Jun 01, 2007 82 #else /* ! __GLASGOW_HASKELL__ */  Isaac Dupree committed Aug 06, 2007 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...  Isaac Dupree committed Jun 01, 2007 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  Simon Marlow committed May 28, 2008 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  simonpj committed Apr 01, 2002 119 #endif  Isaac Dupree committed May 19, 2007 120 \end{code}  simonpj committed Apr 01, 2002 121