-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Array.Diff
  Copyright    :   ( c ) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Functional arrays with constant-time update.
--
-----------------------------------------------------------------------------

module Data.Array.Diff (

    -- * Diff array types

    -- | Diff arrays have an immutable interface, but rely on internal
    -- updates in place to provide fast functional update operator
    -- '//'.
    --
    -- When the '//' operator is applied to a diff array, its contents
    -- are physically updated in place. The old array silently changes
    -- its representation without changing the visible behavior:
    -- it stores a link to the new current array along with the
    -- difference to be applied to get the old contents.
    --
    -- So if a diff array is used in a single-threaded style,
    -- i.e. after '//' application the old version is no longer used,
  @a'!'i@ takes O(1 ) time and @a ' // ' d@ takes O(@length d@ ) .
    -- Accessing elements of older versions gradually becomes slower.
    --
    -- Updating an array which is not current makes a physical copy.
    -- The resulting array is unlinked from the old family. So you
    -- can obtain a version which is guaranteed to be current and
  thus have fast element access by @a ' // ' [ ] @.

    -- Possible improvement for the future (not implemented now):
    -- make it possible to say "I will make an update now, but when
    -- I later return to the old version, I want it to mutate back
    -- instead of being copied".

  data IOToDiffArray
                   --     (a :: * -> * -> *) -- internal mutable array
                   --     (i :: *)           -- indices
                   --     (e :: *)           -- elements

  | Type synonyms for the two most important IO array types .

  Two most important diff array types are fully polymorphic
  lazy boxed DiffArray :
  =  
    -- ...and strict unboxed DiffUArray, working only for elements
    -- of primitive types but more compact and usually faster:
    DiffUArray,    -- = IOToDiffArray IOUArray

    -- * Overloaded immutable array interface
    
    -- | Module "Data.Array.IArray" provides the interface of diff arrays.
  They are instances of class ' IArray ' .
    module Data.Array.IArray,

    -- * Low-level interface

    -- | These are really internal functions, but you will need them
  to make further ' IArray ' instances of various diff array types
    -- (for either more 'MArray' types or more unboxed element types).
    newDiffArray, readDiffArray, replaceDiffArray
    )
    where

------------------------------------------------------------------------
-- Imports.

import Prelude

import Data.Ix
import Data.Array.Base
import Data.Array.IArray
import Data.Array.IO

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 System.IO.Unsafe	  ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )

------------------------------------------------------------------------
-- Diff array types.

-- | An arbitrary 'MArray' type living in the 'IO' monad can be converted
-- to a diff array.

newtype IOToDiffArray a i e =
    DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}

  Internal representation : either a mutable array , or a link to
-- another diff array patched with a list of index+element pairs.
data DiffArrayData a i e = Current (a i e)
                         | Diff (IOToDiffArray a i e) [(Int, e)]

-- | Fully polymorphic lazy boxed diff array.
type DiffArray  = IOToDiffArray IOArray

-- | Strict unboxed diff array, working only for elements
  of primitive types but more compact and usually faster than ' DiffArray ' .
type DiffUArray = IOToDiffArray IOUArray

-- Having 'MArray a e IO' in instance context would require
-- -fallow-undecidable-instances, so each instance is separate here.

------------------------------------------------------------------------
  Showing DiffArrays

instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
  showsPrec = showsIArray

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

instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
  showsPrec = showsIArray

------------------------------------------------------------------------
-- Boring instances.

instance HasBounds a => HasBounds (IOToDiffArray a) where
    bounds a = unsafePerformIO $ boundsDiffArray a

instance IArray (IOToDiffArray IOArray) e where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Char where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

#ifdef __GLASGOW_HASKELL__
instance IArray (IOToDiffArray IOUArray) Word where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
#endif

instance IArray (IOToDiffArray IOUArray) (Ptr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Float where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Double where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int8 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int16 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int32 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int64 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word8 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word16 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word32 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word64 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies



------------------------------------------------------------------------
-- The important stuff.

newDiffArray :: (MArray a e IO, Ix i)
             => (i,i)
             -> [(Int, e)]
             -> IO (IOToDiffArray a i e)
newDiffArray (l,u) ies = do
    a <- newArray_ (l,u)
    sequence_ [unsafeWrite a i e | (i, e) <- ies]
    var <- newMVar (Current a)
    return (DiffArray var)

readDiffArray :: (MArray a e IO, Ix i)
              => IOToDiffArray a i e
              -> Int
              -> IO e
a `readDiffArray` i = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a'  -> unsafeRead a' i
        Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)

replaceDiffArray :: (MArray a e IO, Ix i)
                => IOToDiffArray a i e
                -> [(Int, e)]
                -> IO (IOToDiffArray a i e)
a `replaceDiffArray` ies = do
    d <- takeMVar (varDiffArray a)
    case d of
        Current a' -> case ies of
            [] -> do
                -- We don't do the copy when there is nothing to change
                -- and this is the current version. But see below.
                putMVar (varDiffArray a) d
                return a
            _:_ -> do
                diff <- sequence [do e <- unsafeRead a' i; return (i, e)
                                  | (i, _) <- ies]
                sequence_ [unsafeWrite a' i e | (i, e) <- ies]
                var' <- newMVar (Current a')
                putMVar (varDiffArray a) (Diff (DiffArray var') diff)
                return (DiffArray var')
        Diff _ _ -> do
            -- We still do the copy when there is nothing to change
            -- but this is not the current version. So you can use
            -- 'a // []' to make sure that the resulting array has
            -- fast element access.
            putMVar (varDiffArray a) d
            a' <- thawDiffArray a
  thawDiffArray gives a fresh array which we can
                -- safely mutate.
            sequence_ [unsafeWrite a' i e | (i, e) <- ies]
            var' <- newMVar (Current a')
            return (DiffArray var')

boundsDiffArray :: (HasBounds a, Ix ix)
                => IOToDiffArray a ix e
                -> IO (ix,ix)
boundsDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a' -> return (bounds 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)

# RULES 
 " freeze / DiffArray " freeze = freezeDiffArray 
     #
"freeze/DiffArray" freeze = freezeDiffArray
    #-}

-- 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)
unsafeFreezeDiffArray a = do
    var <- newMVar (Current a)
    return (DiffArray var)

# RULES 
 " unsafeFreeze / DiffArray " unsafeFreeze = unsafeFreezeDiffArray 
     #
"unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
    #-}

thawDiffArray :: (MArray a e IO, Ix ix)
              => IOToDiffArray a ix e
              -> IO (a ix e)
thawDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current 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]]
            return a''
        Diff a' ies -> do
            a'' <- thawDiffArray a'
            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
            return a''

# RULES 
 " thaw / DiffArray " thaw = thawDiffArray 
     #
"thaw/DiffArray" thaw = thawDiffArray
    #-}

-- unsafeThawDiffArray is really unsafe. Better don't use the old
-- array at all after thawing. The contents of the resulting array
-- will be changed when '//' is applied to the source array.

unsafeThawDiffArray :: (MArray a e IO, Ix ix)
                    => IOToDiffArray a ix e
                    -> IO (a ix e)
unsafeThawDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a'  -> return a'
        Diff a' ies -> do
            a'' <- unsafeThawDiffArray a'
            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
            return a''

# RULES 
 " unsafeThaw / DiffArray " unsafeThaw = unsafeThawDiffArray 
     #
"unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
    #-}

---------------------------------------------------------------------------
 |
 Module      :  Data.Array.Diff
 License     :  BSD-style (see the file libraries/base/LICENSE)
 
 Maintainer  :  
 Stability   :  experimental
 Portability :  non-portable

 Functional arrays with constant-time update.

---------------------------------------------------------------------------
 * Diff array types
 | Diff arrays have an immutable interface, but rely on internal
 updates in place to provide fast functional update operator
 '//'.

 When the '//' operator is applied to a diff array, its contents
 are physically updated in place. The old array silently changes
 its representation without changing the visible behavior:
 it stores a link to the new current array along with the
 difference to be applied to get the old contents.

 So if a diff array is used in a single-threaded style,
 i.e. after '//' application the old version is no longer used,
 Accessing elements of older versions gradually becomes slower.

 Updating an array which is not current makes a physical copy.
 The resulting array is unlinked from the old family. So you
 can obtain a version which is guaranteed to be current and
 Possible improvement for the future (not implemented now):
 make it possible to say "I will make an update now, but when
 I later return to the old version, I want it to mutate back
 instead of being copied".
     (a :: * -> * -> *) -- internal mutable array
     (i :: *)           -- indices
     (e :: *)           -- elements
 ...and strict unboxed DiffUArray, working only for elements
 of primitive types but more compact and usually faster:
 = IOToDiffArray IOUArray
 * Overloaded immutable array interface
 | Module "Data.Array.IArray" provides the interface of diff arrays.
 * Low-level interface
 | These are really internal functions, but you will need them
 (for either more 'MArray' types or more unboxed element types).
----------------------------------------------------------------------
 Imports.
----------------------------------------------------------------------
 Diff array types.
 | An arbitrary 'MArray' type living in the 'IO' monad can be converted
 to a diff array.
 another diff array patched with a list of index+element pairs.
 | Fully polymorphic lazy boxed diff array.
 | Strict unboxed diff array, working only for elements
 Having 'MArray a e IO' in instance context would require
 -fallow-undecidable-instances, so each instance is separate here.
----------------------------------------------------------------------
----------------------------------------------------------------------
 Boring instances.
----------------------------------------------------------------------
 The important stuff.
 We don't do the copy when there is nothing to change
 and this is the current version. But see below.
 We still do the copy when there is nothing to change
 but this is not the current version. So you can use
 'a // []' to make sure that the resulting array has
 fast element access.
 safely mutate.
 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.
 unsafeThawDiffArray is really unsafe. Better don't use the old
 array at all after thawing. The contents of the resulting array
 will be changed when '//' is applied to the source array.
  Copyright    :   ( c ) The University of Glasgow 2001

module Data.Array.Diff (


  @a'!'i@ takes O(1 ) time and @a ' // ' d@ takes O(@length d@ ) .
  thus have fast element access by @a ' // ' [ ] @.


  data IOToDiffArray

  | Type synonyms for the two most important IO array types .

  Two most important diff array types are fully polymorphic
  lazy boxed DiffArray :
  =  

    
  They are instances of class ' IArray ' .
    module Data.Array.IArray,


  to make further ' IArray ' instances of various diff array types
    newDiffArray, readDiffArray, replaceDiffArray
    )
    where


import Prelude

import Data.Ix
import Data.Array.Base
import Data.Array.IArray
import Data.Array.IO

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 System.IO.Unsafe	  ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )



newtype IOToDiffArray a i e =
    DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}

  Internal representation : either a mutable array , or a link to
data DiffArrayData a i e = Current (a i e)
                         | Diff (IOToDiffArray a i e) [(Int, e)]

type DiffArray  = IOToDiffArray IOArray

  of primitive types but more compact and usually faster than ' DiffArray ' .
type DiffUArray = IOToDiffArray IOUArray


  Showing DiffArrays

instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
  showsPrec = showsIArray

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

instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
  showsPrec = showsIArray

instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
  showsPrec = showsIArray


instance HasBounds a => HasBounds (IOToDiffArray a) where
    bounds a = unsafePerformIO $ boundsDiffArray a

instance IArray (IOToDiffArray IOArray) e where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Char where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

#ifdef __GLASGOW_HASKELL__
instance IArray (IOToDiffArray IOUArray) Word where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
#endif

instance IArray (IOToDiffArray IOUArray) (Ptr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Float where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Double where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int8 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int16 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int32 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Int64 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word8 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word16 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word32 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies

instance IArray (IOToDiffArray IOUArray) Word64 where
    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies




newDiffArray :: (MArray a e IO, Ix i)
             => (i,i)
             -> [(Int, e)]
             -> IO (IOToDiffArray a i e)
newDiffArray (l,u) ies = do
    a <- newArray_ (l,u)
    sequence_ [unsafeWrite a i e | (i, e) <- ies]
    var <- newMVar (Current a)
    return (DiffArray var)

readDiffArray :: (MArray a e IO, Ix i)
              => IOToDiffArray a i e
              -> Int
              -> IO e
a `readDiffArray` i = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a'  -> unsafeRead a' i
        Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)

replaceDiffArray :: (MArray a e IO, Ix i)
                => IOToDiffArray a i e
                -> [(Int, e)]
                -> IO (IOToDiffArray a i e)
a `replaceDiffArray` ies = do
    d <- takeMVar (varDiffArray a)
    case d of
        Current a' -> case ies of
            [] -> do
                putMVar (varDiffArray a) d
                return a
            _:_ -> do
                diff <- sequence [do e <- unsafeRead a' i; return (i, e)
                                  | (i, _) <- ies]
                sequence_ [unsafeWrite a' i e | (i, e) <- ies]
                var' <- newMVar (Current a')
                putMVar (varDiffArray a) (Diff (DiffArray var') diff)
                return (DiffArray var')
        Diff _ _ -> do
            putMVar (varDiffArray a) d
            a' <- thawDiffArray a
  thawDiffArray gives a fresh array which we can
            sequence_ [unsafeWrite a' i e | (i, e) <- ies]
            var' <- newMVar (Current a')
            return (DiffArray var')

boundsDiffArray :: (HasBounds a, Ix ix)
                => IOToDiffArray a ix e
                -> IO (ix,ix)
boundsDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a' -> return (bounds 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)

# RULES 
 " freeze / DiffArray " freeze = freezeDiffArray 
     #
"freeze/DiffArray" freeze = freezeDiffArray
    #-}


unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
                      => a ix e
                      -> IO (IOToDiffArray a ix e)
unsafeFreezeDiffArray a = do
    var <- newMVar (Current a)
    return (DiffArray var)

# RULES 
 " unsafeFreeze / DiffArray " unsafeFreeze = unsafeFreezeDiffArray 
     #
"unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
    #-}

thawDiffArray :: (MArray a e IO, Ix ix)
              => IOToDiffArray a ix e
              -> IO (a ix e)
thawDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current 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]]
            return a''
        Diff a' ies -> do
            a'' <- thawDiffArray a'
            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
            return a''

# RULES 
 " thaw / DiffArray " thaw = thawDiffArray 
     #
"thaw/DiffArray" thaw = thawDiffArray
    #-}


unsafeThawDiffArray :: (MArray a e IO, Ix ix)
                    => IOToDiffArray a ix e
                    -> IO (a ix e)
unsafeThawDiffArray a = do
    d <- readMVar (varDiffArray a)
    case d of
        Current a'  -> return a'
        Diff a' ies -> do
            a'' <- unsafeThawDiffArray a'
            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
            return a''

# RULES 
 " unsafeThaw / DiffArray " unsafeThaw = unsafeThawDiffArray 
     #
"unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
    #-}
