--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (uses Data.Array.IArray)
--
-- Functional arrays with constant-time update.
--
import Foreign.Ptr ( Ptr, FunPtr )
import Foreign.StablePtr ( StablePtr )
import Data.Int ( Int8, Int16, Int32, Int64 )
-#ifdef __GLASGOW_HASKELL__
-import Data.Word ( Word )
-#endif
-import Data.Word ( Word8, Word16, Word32, Word64 )
+import Data.Word ( Word, Word8, Word16, Word32, Word64 )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Exception ( evaluate )
instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where
showsPrec = showsIArray
-#ifdef __GLASGOW_HASKELL__
instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where
showsPrec = showsIArray
-#endif
instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where
showsPrec = showsIArray
------------------------------------------------------------------------
-- Boring instances.
-instance HasBounds a => HasBounds (IOToDiffArray a) where
- bounds a = unsafePerformIO $ boundsDiffArray a
-
instance IArray (IOToDiffArray IOArray) e where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies
instance IArray (IOToDiffArray IOUArray) Char where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
-#ifdef __GLASGOW_HASKELL__
instance IArray (IOToDiffArray IOUArray) Word where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
-#endif
instance IArray (IOToDiffArray IOUArray) (Ptr a) where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Float where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Double where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int8 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int16 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int32 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int64 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word8 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word16 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word32 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word64 where
+ bounds a = unsafePerformIO $ boundsDiffArray a
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
a `replaceDiffArray` ies
-boundsDiffArray :: (HasBounds a, Ix ix)
+boundsDiffArray :: (MArray a e IO, Ix ix)
=> IOToDiffArray a ix e
-> IO (ix,ix)
boundsDiffArray a = do
d <- readMVar (varDiffArray a)
case d of
- Current a' -> return (bounds a')
+ Current a' -> getBounds a'
Diff a' _ -> boundsDiffArray a'
freezeDiffArray :: (MArray a e IO, Ix ix)
=> a ix e
-> IO (IOToDiffArray a ix e)
-freezeDiffArray a = case bounds a of
- (l,u) -> do
- a' <- newArray_ (l,u)
- sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
- var <- newMVar (Current a')
- return (DiffArray var)
+freezeDiffArray a = do
+ (l,u) <- getBounds a
+ a' <- newArray_ (l,u)
+ sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
+ var <- newMVar (Current a')
+ return (DiffArray var)
{-# RULES
"freeze/DiffArray" freeze = freezeDiffArray
thawDiffArray a = do
d <- readMVar (varDiffArray a)
case d of
- Current a' -> case bounds a' of
- (l,u) -> do
+ Current a' -> do
+ (l,u) <- getBounds a'
a'' <- newArray_ (l,u)
sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
return a''