packages feed

ArrayRef 0.1 → 0.1.2

raw patch · 15 files changed

+187/−113 lines, 15 files

Files

ArrayRef.cabal view
@@ -1,5 +1,5 @@ Name:               ArrayRef-Version:            0.1+Version:            0.1.2 Category:           Data Synopsis:           Unboxed references, dynamic arrays and more Description:        This array library supports: unboxed references,
Control/Concurrent/LockingBZ.hs view
@@ -163,21 +163,27 @@ 
 {-# INLINE liftLock1 #-}
 -- | Lift 1-parameter action to operation on locked variable
+liftLock1 :: (Locking lh h) => (h -> IO a) -> lh -> IO a
 liftLock1 action h         = lock h (\a -> action a)
 
 {-# INLINE liftLock2 #-}
 -- | Lift 2-parameter action to operation on locked variable
+liftLock2 :: (Locking lh h) => (h -> t -> IO a) -> lh -> t -> IO a
 liftLock2 action h x       = lock h (\a -> action a x)
 
 {-# INLINE liftLock3 #-}
 -- | Lift 3-parameter action to operation on locked variable
+liftLock3 :: (Locking lh h) => (h -> t -> t1 -> IO a) -> lh -> t -> t1 -> IO a
 liftLock3 action h x y     = lock h (\a -> action a x y)
 
 {-# INLINE liftLock4 #-}
 -- | Lift 4-parameter action to operation on locked variable
+liftLock4 :: (Locking lh h) => (h -> t -> t1 -> t2 -> IO a) -> lh -> t -> t1 -> t2 -> IO a
 liftLock4 action h x y z   = lock h (\a -> action a x y z)
 
 {-# INLINE liftLock5 #-}
 -- | Lift 5-parameter action to operation on locked variable
+liftLock5 :: (Locking lh h) => (h -> t -> t1 -> t2 -> t3 -> IO a)
+              -> lh -> t -> t1 -> t2 -> t3 -> IO a
 liftLock5 action h x y z t = lock h (\a -> action a x y z t)
Data/ArrayBZ/Diff.hs view
@@ -74,14 +74,11 @@ ------------------------------------------------------------------------ -- Imports. -import Data.Ix- import System.IO.Unsafe   ( unsafePerformIO ) import Control.Exception  ( evaluate ) import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )  import Data.ArrayBZ.Internals.IArray-import Data.ArrayBZ.Internals.MArray import Data.ArrayBZ.Boxed import Data.ArrayBZ.Unboxed import Data.HasDefaultValue@@ -223,7 +220,7 @@                 -> [(Int, e)]                 -> IO (IOToDiffArray a i e) a `replaceDiffArray2` ies = do-    mapM_ (\(a,b) -> do evaluate a; evaluate b) ies+    mapM_ (\(b,c) -> do evaluate b; evaluate c) ies     a `replaceDiffArray` ies  boundsDiffArray :: (HasBounds a, Ix ix)@@ -249,10 +246,9 @@ "freeze/DiffArray" freeze = freezeDiffArray     #-} --- unsafeFreezeDiffArray is really unsafe. Better don't use the old+-- | unsafeFreezeDiffArray is really unsafe. Better don't use the old -- array at all after freezing. The contents of the source array will -- be changed when '//' is applied to the resulting array.- unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)                       => a ix e                       -> IO (IOToDiffArray a ix e)
Data/ArrayBZ/Dynamic.hs view
@@ -102,28 +102,31 @@ -- | Create new dynamic array with default value for new cells set to `init`. --   `f` is a growing strategy and may be `noGrow`, `growMinimally` --    or `growTwoTimes`-newDynamicArray f bounds init = do-    arr <- newArray  bounds init+newDynamicArray :: (Ref t r, Ix i, MArray a e t) => GrowBoundsF i -> (i, i) -> e -> t (Dynamic r a i e)+newDynamicArray f bnds initial = do+    arr <- newArray  bnds initial     a   <- newRef arr-    return (Dynamic f (Just init) a)+    return (Dynamic f (Just initial) a)  -- | Create new dynamic array where all new cells will remain uninitialized. --   `f` is a growing strategy and may be `noGrow`, `growMinimally` --    or `growTwoTimes`-newDynamicArray_ f bounds = do-    arr <- newArray_  bounds+newDynamicArray_ :: (Ref t r, Ix i, MArray a e t) => GrowBoundsF i -> (i, i) -> t (Dynamic r a i e)+newDynamicArray_ f bnds = do+    arr <- newArray_  bnds     a   <- newRef arr     return (Dynamic f Nothing a)  -- | Extend/shrink dynamic array to new bounds+resizeDynamicArray :: (Ix i, MArray a t t2, Ref t2 t1) => Dynamic t1 a i t -> (i, i) -> t2 () resizeDynamicArray (Dynamic _ e a) newbounds = do     arr <- readRef a-    bounds <- getBounds arr+    bnds <- getBounds arr     newarr <- case e of-                Just init -> newArray  newbounds init+                Just initial -> newArray  newbounds initial                 Nothing   -> newArray_ newbounds     sequence_ [ readArray arr i >>= writeArray newarr i-              | i <- range bounds, inRange newbounds i ]+              | i <- range bnds, inRange newbounds i ]     writeRef a newarr  -- ---------------------------------------------------------------------------@@ -148,33 +151,41 @@     {-# INLINE writeArray #-}     writeArray dyn@(Dynamic _ _ a) i e = do         arr <- readRef a-        bounds <- getBounds arr-        if inRange bounds i-          then unsafeWrite arr (unsafeIndex bounds i) e-          else extendAndWrite dyn arr bounds i e+        bnds <- getBounds arr+        if inRange bnds i+          then unsafeWrite arr (unsafeIndex bnds i) e+          else extendAndWrite dyn arr bnds i e  -- Helper function used to make `writeArray` look as non-recursive function, -- what is required for GHC's optimization-extendAndWrite dyn@(Dynamic extend _ a) arr bounds i e = do-    resizeDynamicArray dyn (extend bounds i)+extendAndWrite :: (Ix t2, Ref t5 t, MArray t1 t3 t5) => Dynamic t t1 t2 t3+                                              -> t4+                                              -> (t2, t2)+                                              -> t2+                                              -> t3+                                              -> t5 ()+extendAndWrite dyn@(Dynamic extend _ _) _ bnds i e = do+    resizeDynamicArray dyn (extend bnds i)     writeArray dyn i e - -- --------------------------------------------------------------------------- -- Bounds growing functions, that can be used with newDynamicArray/newDynamicArray_  -- | No automatic growing at all. This "growing" method is compatible with any -- bounds type+noGrow :: t -> t1 -> a noGrow _ _ = error "Dynamic array: index out of bounds"  -- | Grow minimally - only to include new index in array bounds. This growing -- method is compatible with any bounds type+growMinimally :: (Ix t) => (t, t) -> t -> (t, t) growMinimally (l,u) i | inRange (l,i) u = (l,i)                       | inRange (i,u) l = (i,u)                       | otherwise = error "can't compute new bounds for dynamic array"  -- | Grow number of elements at least 2 times. This growing method is compatible -- only with bounds belonging to class Num+growTwoTimes :: (Num a, Ord a) => (a, a) -> a -> (a, a) growTwoTimes (l,u) i = if i<l then (min (l-(u-l)) i, u)                               else (l, max (u+(u-l)) i)
Data/ArrayBZ/IO.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, UnliftedFFITypes #-}+{-# LANGUAGE CPP, UnliftedFFITypes, ForeignFunctionInterface #-} {-# INCLUDE "HsBase.hs" #-} {- |    Module     : Data.ArrayBZ.IO@@ -28,8 +28,6 @@    hPutArray,           -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()  ) where -import Data.Word- import Data.ArrayBZ.MArray import Data.ArrayBZ.Internals.Boxed   ( IOArray ) import Data.ArrayBZ.Internals.Unboxed@@ -63,7 +61,7 @@   = illegalBufferSize handle "hGetArray" count   | otherwise = do       wantReadableHandle "hGetArray" handle $-        \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do+        \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do         buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref         if bufferEmpty buf            then readChunk fd is_stream ptr 0 count@@ -89,14 +87,14 @@ readChunk fd is_stream ptr init_off bytes = loop init_off bytes  where   loop :: Int -> Int -> IO Int-  loop off bytes | bytes <= 0 = return (off - init_off)-  loop off bytes = do+  loop off byts | byts <= 0 = return (off - init_off)+  loop off byts = do     r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr-                                    (fromIntegral off) (fromIntegral bytes)+                                    (fromIntegral off) (fromIntegral byts)     let r = fromIntegral r'     if r == 0         then return (off - init_off)-        else loop (off + r) (bytes - r)+        else loop (off + r) (byts - r)  -- --------------------------------------------------------------------------- -- hPutArray@@ -115,9 +113,9 @@   = illegalBufferSize handle "hPutArray" count   | otherwise    = do wantWritableHandle "hPutArray" handle $-          \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do+          \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do -          old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }+          old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }             <- readIORef ref            -- enough room in handle buffer?
Data/ArrayBZ/Internals/Boxed.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances,+  MultiParamTypeClasses, FlexibleContexts #-} {- |    Module     : Data.ArrayBZ.Internals.Boxed    Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin@@ -112,12 +113,12 @@     getBounds (BMA l u _) = return (l,u)  instance (STorIO m s) => MArray (BoxedMutableArray s) e m where-    newArray (l,u) init = do arr <- allocBoxed (rangeSize (l,u)) init-                             return (BMA l u arr)+    newArray (l,u) initial = do arr <- allocBoxed (rangeSize (l,u)) initial+                                return (BMA l u arr)     {-# INLINE unsafeRead #-}-    unsafeRead  (BMA _ _ arr) index  =  readBoxed  arr index+    unsafeRead  (BMA _ _ arr) =  readBoxed  arr     {-# INLINE unsafeWrite #-}-    unsafeWrite (BMA _ _ arr) index  =  writeBoxed arr index+    unsafeWrite (BMA _ _ arr) =  writeBoxed arr  -- --------------------------------------------------------------------------- -- | Boxed mutable arrays in ST monad@@ -129,7 +130,7 @@  instance MArray (STArray s) e (Lazy.ST s) where     {-# INLINE newArray #-}-    newArray (l,u) init = strictToLazyST (newArray (l,u) init)+    newArray (l,u) initial = strictToLazyST (newArray (l,u) initial)     {-# INLINE unsafeRead #-}     unsafeRead  arr i   = strictToLazyST (unsafeRead  arr i)     {-# INLINE unsafeWrite #-}@@ -154,7 +155,7 @@     -- Create new array filled with (i,e) values     unsafeArray lu ies = runST (withNewArray lu arrEleBottom (doReplace ies))     {-# INLINE unsafeAt #-}-    unsafeAt (BA _ _ arr) index = indexBoxed arr index+    unsafeAt (BA _ _ arr) = indexBoxed arr     {-# INLINE unsafeReplace #-}     -- Make a copy of array and perform (i,e) replacements     unsafeReplace arr ies = runST (withArrayCopy arr (doReplace ies))@@ -163,54 +164,72 @@     unsafeAccum f arr ies = runST (withArrayCopy arr (doAccum f ies))     {-# INLINE unsafeAccumArray #-}     -- Create new array accumulating (i,e) values-    unsafeAccumArray f init lu ies = runST (withNewArray lu init (doAccum f ies))+    unsafeAccumArray f initial lu ies = runST (withNewArray lu initial (doAccum f ies))   -- Implementation helper functions -------------  -- Create new array and perform given action on it before freezing-withNewArray lu init action = do-    marr <- newArray lu init+withNewArray ::                               (STorIO t t2,+                                             Ix i,+                                             MArray (BoxedMutableArray t2) e t) =>+                                            (i, i)+                                            -> e+                                            -> (BoxedMutableArray t2 i e -> t t1)+                                            -> t (Array i e)+withNewArray lu initial action = do+    marr <- newArray lu initial     action marr     unsafeFreezeBA marr  -- Make a copy of array and perform given action on it before freezing+withArrayCopy ::                              (Ix t, STorIO t2 s) =>+                                             Array t t1+                                             -> (BoxedMutableArray s t t1 -> t2 t3)+                                             -> t2 (Array t t1) withArrayCopy arr action = do     marr <- thawBA arr     action marr     unsafeFreezeBA marr  -- Perform (i,e) replaces in mutable array+doReplace :: (Ix i, MArray a e t) => [(Int, e)] -> a i e -> t () doReplace ies marr = do     sequence_ [unsafeWrite marr i e | (i, e) <- ies]  -- Accumulate (i,e) values in mutable array+doAccum :: (Ix i, MArray a t1 t2) => (t1 -> t -> t1) -> [(Int, t)] -> a i t1 -> t2 () doAccum f ies marr = do     sequence_ [do old <- unsafeRead marr i                   unsafeWrite marr i (f old new)               | (i, new) <- ies]  -- Mutable->immutable array conversion which takes a copy of contents+freezeBA :: (STorIO t3 t, Ix t1) => BoxedMutableArray t t1 t2 -> t3 (Array t1 t2) freezeBA ua@(BMA l u marr) = do     arr <- freezeBoxed marr (sizeOfBA ua) arrEleBottom     return (BA l u arr)  -- Immutable->mutable array conversion which takes a copy of contents+thawBA :: (STorIO t2 s, Ix t) => Array t t1 -> t2 (BoxedMutableArray s t t1) thawBA ua@(BA l u arr) = do     marr <- thawBoxed arr (sizeOfBA ua) arrEleBottom     return (BMA l u marr)  -- On-the-place mutable->immutable array conversion+unsafeFreezeBA :: (STorIO t3 t1) => BoxedMutableArray t1 t t2 -> t3 (Array t t2) unsafeFreezeBA (BMA l u marr) = do     arr <- unsafeFreezeBoxed marr     return (BA l u arr)  -- On-the-place immutable->mutable array conversion-unsafeThawBA ua@(BA l u arr) = do+unsafeThawBA :: (STorIO t2 s) => Array t t1 -> t2 (BoxedMutableArray s t t1)+unsafeThawBA (BA l u arr) = do     marr <- unsafeThawBoxed arr     return (BMA l u marr)  -- | Number of array elements+sizeOfBA :: (Ix a1, HasBounds a) => a a1 e -> Int sizeOfBA arr = rangeSize (bounds arr)  -- ---------------------------------------------------------------------------@@ -268,7 +287,9 @@ #endif  +iOArrayTc :: TyCon INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") +stArrayTc :: TyCon INSTANCE_TYPEABLE3(STArray,stArrayTc,"STArray")
Data/ArrayBZ/Internals/IArray.hs view
@@ -14,7 +14,6 @@  module Data.ArrayBZ.Internals.IArray where -import Control.Monad.ST         ( ST, runST ) import Data.Ix #ifdef __GLASGOW_HASKELL__ import GHC.Arr                  ( unsafeIndex )@@ -149,8 +148,8 @@         -> (i,i)                -- ^ The bounds of the array         -> [(i, e')]            -- ^ List of associations         -> a i e                -- ^ Returns: the array-accumArray f init (l,u) ies =-    unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]+accumArray f initial (l,u) ies =+    unsafeAccumArray f initial (l,u) [(index (l,u) i, e) | (i, e) <- ies]  {-# INLINE (//) #-} {-|
Data/ArrayBZ/Internals/MArray.hs view
@@ -15,7 +15,6 @@  module Data.ArrayBZ.Internals.MArray where -import Control.Monad.ST         ( ST, runST ) import Data.Ix #ifdef __GLASGOW_HASKELL__ import GHC.Arr                  ( unsafeIndex )@@ -69,9 +68,9 @@         -- The INLINE is crucial, because until we know at least which monad         -- we are in, the code below allocates like crazy.  So inline it,         -- in the hope that the context will know the monad.-    newArray (l,u) init = do+    newArray (l,u) initial = do         marr <- newArray_ (l,u)-        sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]+        sequence_ [unsafeWrite marr i initial | i <- [0 .. rangeSize (l,u) - 1]]         return marr      newArray_ (l,u) = newArray (l,u) arrEleBottom
Data/ArrayBZ/Internals/Unboxed.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances,-  MultiParamTypeClasses #-}+  MultiParamTypeClasses, FlexibleContexts #-} {- |    Module     : Data.ArrayBZ.Internals.Unboxed    Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin@@ -47,15 +47,16 @@     newArray_ (l,u) = do arr <- allocUnboxed (rangeSize (l,u))                          return (UMA l u arr)     {-# INLINE unsafeRead #-}-    unsafeRead  (UMA _ _ arr) index  =  readUnboxed  arr index+    unsafeRead  (UMA _ _ arr) = readUnboxed arr     {-# INLINE unsafeWrite #-}-    unsafeWrite (UMA _ _ arr) index  =  writeUnboxed arr index+    unsafeWrite (UMA _ _ arr) = writeUnboxed arr  -- --------------------------------------------------------------------------- -- | Unboxed mutable arrays in ST monad  type STUArray = UnboxedMutableArray +stUArrayTc :: TyCon INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")  -- ---------------------------------------------------------------------------@@ -74,6 +75,7 @@  type IOUArray = IOSpecific3 UnboxedMutableArray +iOUArrayTc :: TyCon INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")  -- ---------------------------------------------------------------------------@@ -81,6 +83,7 @@  data UArray i e  =  UA !i !i !(UVec e) +uArrayTc :: TyCon INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")  instance HasBounds UArray where@@ -92,59 +95,76 @@     -- Create new array filled with (i,e) values     unsafeArray lu ies = runST (withNewArray lu defaultValue (doReplace ies))     {-# INLINE unsafeAt #-}-    unsafeAt (UA _ _ arr) index = indexUnboxed arr index+    unsafeAt (UA _ _ arr) = indexUnboxed arr     {-# INLINE unsafeReplace #-}     -- Make a copy of array and perform (i,e) replacements     unsafeReplace arr ies = runST (withArrayCopy arr (doReplace ies))     {-# INLINE unsafeAccum #-}     -- Make a copy of array and perform (i,e) accumulation in new array-    unsafeAccum f arr ies = runST (withArrayCopy arr (doAccum f ies))+    unsafeAccum f arr ies = runST (withArrayCopy arr $ doAccum f ies)     {-# INLINE unsafeAccumArray #-}     -- Create new array accumulating (i,e) values-    unsafeAccumArray f init lu ies = runST (withNewArray lu init (doAccum f ies))+    unsafeAccumArray f int lu ies = runST (withNewArray lu int $ doAccum f ies)   -- Implementation helper functions -------------  -- Create new array and perform given action on it before freezing-withNewArray lu init action = do-    marr <- newArray lu init+withNewArray :: (STorIO t t2,+                       Ix i,+                          MArray (UnboxedMutableArray t2) e t) =>+               (i, i)+                   -> e+                   -> (UnboxedMutableArray t2 i e -> t t1)+                   -> t (UArray i e)+withNewArray lu int action = do+    marr <- newArray lu int     action marr     unsafeFreezeUA marr  -- Make a copy of array and perform given action on it before freezing+withArrayCopy :: (Ix t, Unboxed t1, STorIO t2 s) =>+                                             UArray t t1+                                             -> (UnboxedMutableArray s t t1 -> t2 t3)+                                             -> t2 (UArray t t1) withArrayCopy arr action = do     marr <- thawUA arr     action marr     unsafeFreezeUA marr  -- Perform (i,e) replaces in mutable array+doReplace :: (Ix i, MArray a e t) => [(Int, e)] -> a i e -> t () doReplace ies marr = do     sequence_ [unsafeWrite marr i e | (i, e) <- ies]  -- Accumulate (i,e) values in mutable array+doAccum :: (Ix i, MArray a t1 t2) => (t1 -> t -> t1) -> [(Int, t)] -> a i t1 -> t2 () doAccum f ies marr = do     sequence_ [do old <- unsafeRead marr i                   unsafeWrite marr i (f old new)               | (i, new) <- ies]  -- Mutable->immutable array conversion which takes a copy of contents+freezeUA :: (STorIO t3 t, Unboxed t2, Ix t1) => UnboxedMutableArray t t1 t2 -> t3 (UArray t1 t2) freezeUA uma@(UMA l u marr) = do     arr <- freezeUnboxed marr (sizeOfUMA uma)     return (UA l u arr)  -- Immutable->mutable array conversion which takes a copy of contents+thawUA :: (STorIO t2 s, Unboxed t1, Ix t) => UArray t t1 -> t2 (UnboxedMutableArray s t t1) thawUA ua@(UA l u arr) = do     marr <- thawUnboxed arr (sizeOfUA ua)     return (UMA l u marr)  -- On-the-place mutable->immutable array conversion+unsafeFreezeUA :: (STorIO t3 t1) => UnboxedMutableArray t1 t t2 -> t3 (UArray t t2) unsafeFreezeUA (UMA l u marr) = do     arr <- unsafeFreezeUnboxed marr     return (UA l u arr)  -- On-the-place immutable->mutable array conversion-unsafeThawUA ua@(UA l u arr) = do+unsafeThawUA :: (STorIO t2 s) => UArray t t1 -> t2 (UnboxedMutableArray s t t1)+unsafeThawUA (UA l u arr) = do     marr <- unsafeThawUnboxed arr     return (UMA l u marr)
Data/ArrayBZ/Storable.hs view
@@ -62,10 +62,10 @@  instance Storable e => MArray StorableArray e IO where     {-# INLINE newArray #-}-    newArray (l,u) init = do+    newArray (l,u) initial = do         fp <- mallocForeignPtrArray size         withForeignPtr fp $ \a ->-            sequence_ [pokeElemOff a i init | i <- [0..size-1]]+            sequence_ [pokeElemOff a i initial | i <- [0..size-1]]         return (StorableArray l u fp)         where         size = rangeSize (l,u)
Data/Ref/Unboxed.hs view
@@ -28,23 +28,24 @@  newtype IOURef a = IOURef (IOSpecific2 MUVec a) +ioURefTc :: TyCon INSTANCE_TYPEABLE1(IOURef,ioURefTc,"IOURef")  -- | Create new unboxed reference in IO monad newIOURef :: (Unboxed a) => a -> IO (IOURef a)-newIOURef init = do var <- allocUnboxed 1-                    writeUnboxed var 0 init-                    return (IOURef var)+newIOURef initial = do var <- allocUnboxed (1::Int)+                       writeUnboxed var (0::Int) initial+                       return (IOURef var)  -- | Read current value of unboxed reference in IO monad {-# INLINE readIOURef #-} readIOURef :: (Unboxed a) => IOURef a -> IO a-readIOURef (IOURef ref) = readUnboxed ref 0+readIOURef (IOURef ref) = readUnboxed ref (0::Int)  -- | Change value of unboxed reference in IO monad {-# INLINE writeIOURef #-} writeIOURef :: (Unboxed a) => IOURef a -> a -> IO ()-writeIOURef (IOURef ref) = writeUnboxed ref 0+writeIOURef (IOURef ref) = writeUnboxed ref (0::Int)  -- |Modify contents of an 'IOURef' by applying pure function to it {-# INLINE modifyIOURef #-}@@ -56,23 +57,24 @@  newtype STURef s a = STURef (MUVec s a) +stURefTc :: TyCon INSTANCE_TYPEABLE2(STURef,stURefTc,"STURef")  -- | Create new unboxed reference in ST monad newSTURef :: (Unboxed a) => a -> ST s (STURef s a)-newSTURef init = do var <- allocUnboxed 1-                    writeUnboxed var 0 init-                    return (STURef var)+newSTURef initial = do var <- allocUnboxed (1::Int)+                       writeUnboxed var (0::Int) initial+                       return (STURef var)  -- | Read current value of unboxed reference in ST monad {-# INLINE readSTURef #-} readSTURef :: (Unboxed a) => STURef s a -> ST s a-readSTURef (STURef ref) = readUnboxed ref 0+readSTURef (STURef ref) = readUnboxed ref (0::Int)  -- | Change value of unboxed reference in ST monad {-# INLINE writeSTURef #-} writeSTURef :: (Unboxed a) => STURef s a -> a -> ST s ()-writeSTURef (STURef ref) = writeUnboxed ref 0+writeSTURef (STURef ref) = writeUnboxed ref (0::Int)  -- |Modify contents of an 'STURef' by applying pure function to it {-# INLINE modifySTURef #-}
Data/Ref/Universal.hs view
@@ -36,11 +36,11 @@ --     (suitable for writing code that will work in IO, ST and other monads)  class (Monad m) => Ref m r | m->r, r->m where-    -- |Create a new 'Ref' with given initial value+    -- | Create a new 'Ref' with given initial value     newRef :: a -> m (r a)-    -- |Read the value of an 'Ref'+    -- | Read the value of an 'Ref'     readRef   :: r a -> m a-    -- |Write new value into an 'Ref'+    -- | Write new value into an 'Ref'     writeRef  :: r a -> a -> m ()  instance Ref IO IORef where@@ -52,12 +52,14 @@     readRef = readSTRef     writeRef = writeSTRef --- |Modify the contents of an 'Ref' by applying pure function to it+-- | Modify the contents of an 'Ref' by applying pure function to it {-# INLINE modifyRef #-}+modifyRef :: (Ref m r) => r a -> (a -> a) -> m () modifyRef  ref f  =  readRef ref >>= writeRef ref . f --- |Modify the contents of an 'Ref' by applying monadic computation to it+-- | Modify the contents of an 'Ref' by applying monadic computation to it {-# INLINE modifyRefM #-}+modifyRefM :: (Ref m r) => r a -> (a -> m a) -> m () modifyRefM ref f  =  readRef ref >>= f >>= writeRef ref  -- -----------------------------------------------------------------------------@@ -65,11 +67,11 @@ --     (suitable for writing code that will work in IO, ST and other monads)  class (Monad m) => URef m r | m->r, r->m where-    -- |Create a new 'URef' with given initial value+    -- | Create a new 'URef' with given initial value     newURef    :: (Unboxed a) => a -> m (r a)-    -- |Read the value of an 'URef'+    -- | Read the value of an 'URef'     readURef   :: (Unboxed a) => r a -> m a-    -- |Write new value into an 'URef'+    -- | Write new value into an 'URef'     writeURef  :: (Unboxed a) => r a -> a -> m ()  instance URef IO IOURef where@@ -81,11 +83,13 @@     readURef = readSTURef     writeURef = writeSTURef --- |Modify the contents of an 'URef' by applying pure function to it+-- | Modify the contents of an 'URef' by applying pure function to it {-# INLINE modifyURef #-}-modifyURef  ref f  =  readURef ref >>= writeURef ref . f+modifyURef :: (Unboxed a, URef m r) => r a -> (a -> a) -> m ()+modifyURef  ref f =  readURef ref >>= writeURef ref . f --- |Modify the contents of an 'URef' by applying monadic computation to it+-- | Modify the contents of an 'URef' by applying monadic computation to it {-# INLINE modifyURefM #-}+modifyURefM :: (Unboxed a, URef m r) => r a -> (a -> m a) -> m () modifyURefM ref f  =  readURef ref >>= f >>= writeURef ref
Data/SyntaxSugar.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, FunctionalDependencies, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE CPP, FunctionalDependencies, FlexibleInstances,+  MultiParamTypeClasses, TypeOperators #-} {- |    Module     : Data.SyntaxSugar    Copyright  : Copyright (C) 2006 Bulat Ziganshin@@ -30,17 +31,19 @@ --   (references, array and hash elements)  class (Monad m) => Mutable m r a | r->a where-    -- |Read the value of an 'Mutable'+    -- | Read the value of an 'Mutable'     readVar  :: r -> m a-    -- |Write new value into an 'Mutable'+    -- | Write new value into an 'Mutable'     writeVar :: r -> a -> m () --- |Modify the contents of an 'Mutable' by applying pure function to it+-- | Modify the contents of an 'Mutable' by applying pure function to it {-# INLINE modifyVar #-}+modifyVar :: (Mutable m r b) => r -> (b -> b) -> m () modifyVar  var f  =  readVar var >>= writeVar var . f --- |Modify the contents of an 'Mutable' by applying monadic computation to it+-- | Modify the contents of an 'Mutable' by applying monadic computation to it {-# INLINE modifyVarM #-}+modifyVarM :: (Mutable m r a) => r -> (a -> m a) -> m () modifyVarM var f  =  readVar var >>= f >>= writeVar var  -- -----------------------------------------------------------------------------@@ -103,6 +106,7 @@  #if defined(__HUGS_VERSION__)  ||  defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 604) -- Define this only for Hugs2005+ and GHC 6.4++hashUpdate :: HashTable key val -> key -> val -> IO Bool hashUpdate table = Hash.update table #else -- Slower implementation for old compilers@@ -115,13 +119,27 @@ -- Syntax sugar for using mutables  infixl 0 =:, +=, -=, .=, .<-+ref :: (Ref m r) => a -> m (r a) ref  x  = newRef  x                           -- create new boxed reference++uref :: (Unboxed a, URef m r) => a -> m (r a) uref x  = newURef x                           -- create new unboxed reference++val :: (Mutable m r a) => r -> m a val var = readVar    var                      -- read current value of mutable++(=:) :: (Mutable m r a) => r -> a -> m () var=:x  = writeVar   var x                    -- assign new value to mutable+(+=) :: (Mutable m r b, Num b) => r -> b -> m () var+=x  = modifyVar  var (\old -> old+x)      -- increase value of mutable++(-=) :: (Mutable m r b, Num b) => r -> b -> m () var-=x  = modifyVar  var (\old -> old-x)      -- decrease value of mutable++(.=) :: (Mutable m r b) => r -> (b -> b) -> m () var.=f  = modifyVar  var (\old -> f old)      -- apply pure function to the value of mutable++(.<-) :: (Mutable m r a) => r -> (a -> m a) -> m () var.<-f = modifyVarM var (\old -> f old)      -- apply monadic computation to the value of mutable  {-# INLINE ref  #-}
GHC/ArrBZ.hs view
@@ -36,22 +36,22 @@ thawBoxed :: (STorIO m s) => Vec a -> Int -> a -> m (MVec s a)  -allocBoxed elems init = mLift ( \s ->-  case newArray# (fromI# elems) init s of { (# s, arr #) ->-  (# s, MVec arr #) } )+allocBoxed elems initial = mLift ( \s ->+  case newArray# (fromI# elems) initial s of+    (# q, arr #) -> (# q, MVec arr #) )  {-# INLINE unsafeFreezeBoxed #-} unsafeFreezeBoxed (MVec mvec) = mLift ( \s ->-  case unsafeFreezeArray# mvec s of { (# s, vec #) ->-  (# s, Vec vec #) } )+  case unsafeFreezeArray# mvec s of+    (# q, vec #) -> (# q, Vec vec #) )  {-# INLINE unsafeThawBoxed #-} unsafeThawBoxed (Vec arr#) = mLift ( \s ->-  case unsafeThawArray# arr# s of { (# s, marr# #) ->-  (# s, MVec marr# #) } )+  case unsafeThawArray# arr# s of+    (# q, marr# #) -> (# q, MVec marr# #)) -freezeBoxed (MVec marr#) (I# n#) init = mLift ( \s1# ->-    case newArray# n# init                s1#  of { (# s2#, tmparr# #) ->+freezeBoxed (MVec marr#) (I# n#) initial = mLift ( \s1# ->+    case newArray# n# initial                s1#  of { (# s2#, tmparr# #) ->      let copy i# s01# | i# ==# n# =        s01#                      | otherwise =@@ -63,8 +63,8 @@     case unsafeFreezeArray# tmparr#       s3#  of { (# s4#, arr# #) ->     (# s4#, Vec arr# #) }}} ) -thawBoxed (Vec vec#) (I# n#) init = mLift ( \s1# ->-    case newArray# n# init s1#               of { (# s2#, mvec# #) ->+thawBoxed (Vec vec#) (I# n#) initial = mLift ( \s1# ->+    case newArray# n# initial s1#               of { (# s2#, mvec# #) ->      let copy i# s01# | i# ==# n# =      s01#                      | otherwise =@@ -96,8 +96,8 @@  {-# INLINE writeBoxed #-} writeBoxed (MVec vec) index value  =  mLift ( \s ->-    case writeArray# vec (fromI# index) value s of { s ->-    (# s, () #) } )+    case writeArray# vec (fromI# index) value s of+      q -> (# q, () #))  {-# INLINE indexBoxed #-} indexBoxed (Vec vec) index  =
GHC/Unboxed.hs view
@@ -19,7 +19,7 @@  module GHC.Unboxed where -import GHC.ST           ( ST(..), runST )+import GHC.ST           ( ST(..)) import GHC.IOBase       ( IO(..) ) import GHC.Base import GHC.Word         ( Word(..) )@@ -64,15 +64,15 @@ allocUnboxedBytes :: (STorIO m s, Integral bytes, Unboxed a)                   => bytes -> m (MUVec s a) allocUnboxedBytes bytes = mLift ( \s ->-    case newByteArray# (fromI# bytes) s of { (# s, arr #) ->-    (# s, MUVec arr #) } )+    case newByteArray# (fromI# bytes) s of { (# t, arr #) ->+    (# t, MUVec arr #) } )  -- | Mutable->immutable byte vector on-place conversion {-# INLINE unsafeFreezeUnboxed #-} unsafeFreezeUnboxed :: (STorIO m s) => MUVec s a -> m (UVec a) unsafeFreezeUnboxed (MUVec marr#) = mLift ( \s ->-    case unsafeFreezeByteArray# marr# s of { (# s, arr# #) ->-    (# s, UVec arr# #) } )+    case unsafeFreezeByteArray# marr# s of { (# t, arr# #) ->+    (# t, UVec arr# #) } )  -- | Immutable->mutable byte vector on-place conversion {-# INLINE unsafeThawUnboxed #-}@@ -85,7 +85,7 @@ freezeUnboxed (MUVec marr#) (I# size) = mLift ( \s1# ->     case newByteArray# size                      s1# of { (# s2#, tmparr# #) ->     case unsafeCoerce# memcpy tmparr# marr# size s2# of { (# s3#, () #) ->-    case unsafeFreezeByteArray# tmparr#          s3# of { (# s4#, arr# #) ->+    case unsafeFreezeByteArray# tmparr#          s3# of { (# _, arr# #) ->     (# s3#, UVec arr# #) }}} )  -- | Immutable->mutable byte vector conversion which takes a copy of contents@@ -130,13 +130,13 @@ {     {-# INLINE readUnboxed #-};     readUnboxed (MUVec arr) index  =  mLift ( \s ->-        case readInt8Array# arr (fromI# index) s of { (# s, value# #) ->-        (# s, tagToEnum# value# #) } );+        case readInt8Array# arr (fromI# index) s of { (# t, value# #) ->+        (# t, tagToEnum# value# #) } );      {-# INLINE writeUnboxed #-};     writeUnboxed (MUVec arr) index value  =  mLift ( \s ->-        case writeInt8Array# arr (fromI# index) (getTag value) s of { s ->-        (# s, () #) } );+        case writeInt8Array# arr (fromI# index) (getTag value) s of { t ->+        (# t, () #) } );      {-# INLINE indexUnboxed #-};     indexUnboxed (UVec arr) index  =  tagToEnum# (indexInt8Array# arr (fromI# index));@@ -151,13 +151,13 @@ {                                                                     \     {-# INLINE readUnboxed #-};                                       \     readUnboxed (MUVec arr) index  =  mLift ( \s ->                   \-        case read arr (fromI# index) s of { (# s, value# #) ->        \-        (# s, cast value# #) } );                                     \+        case read arr (fromI# index) s of { (# t, value# #) ->        \+        (# t, cast value# #) } );                                     \                                                                       \     {-# INLINE writeUnboxed #-};                                      \     writeUnboxed (MUVec arr) index (cast value#)  =  mLift ( \s ->    \-        case write arr (fromI# index) value# s of { s ->              \-        (# s, () #) } );                                              \+        case write arr (fromI# index) value# s of { t ->              \+        (# t, () #) } );                                              \                                                                       \     {-# INLINE indexUnboxed #-};                                      \     indexUnboxed (UVec arr) index  =  cast (at arr (fromI# index));   \