Data/Array/Diff.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Data.Array.Diff
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: Diff.hs,v 1.1 2001/07/04 10:48:39 simonmar Exp $
  12 --
  13 -- Functional arrays with constant-time update.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Array.Diff (
  18
  19     -- Diff arrays have immutable interface, but rely on internal
  20     -- updates in place to provide fast functional update operator
  21     -- '//'.
  22     --
  23     -- When the '//' operator is applied to a diff array, its contents
  24     -- are physically updated in place. The old array silently changes
  25     -- its representation without changing the visible behavior:
  26     -- it stores a link to the new current array along with the
  27     -- difference to be applied to get the old contents.
  28     --
  29     -- So if a diff array is used in a single-threaded style,
  30     -- i.e. after '//' application the old version is no longer used,
  31     -- 'a!i' takes O(1) time and 'a // d' takes O(length d). Accessing
  32     -- elements of older versions gradually becomes slower.
  33     --
  34     -- Updating an array which is not current makes a physical copy.
  35     -- The resulting array is unlinked from the old family. So you
  36     -- can obtain a version which is guaranteed to be current and
  37     -- thus have fast element access by 'a // []'.
  38
  39     -- Possible improvement for the future (not implemented now):
  40     -- make it possible to say "I will make an update now, but when
  41     -- I later return to the old version, I want it to mutate back
  42     -- instead of being copied".
  43
  44     -- An arbitrary MArray type living in the IO monad can be converted
  45     -- to a diff array.
  46     IOToDiffArray, -- data IOToDiffArray
  47                    --     (a :: * -> * -> *) -- internal mutable array
  48                    --     (i :: *)           -- indices
  49                    --     (e :: *)           -- elements
  50
  51     -- Two most important diff array types are fully polymorphic
  52     -- lazy boxed DiffArray:
  53     DiffArray,     -- = IOToDiffArray IOArray
  54     -- ...and strict unboxed DiffUArray, working only for elements
  55     -- of primitive types but more compact and usually faster:
  56     DiffUArray,    -- = IOToDiffArray IOUArray
  57
  58     -- Module IArray provides the interface of diff arrays. They are
  59     -- instances of class IArray.
  60     module Data.Array.IArray,
  61
  62     -- These are really internal functions, but you will need them
  63     -- to make further IArray instances of various DiffArrays (for
  64     -- either more MArray types or more unboxed element types).
  65     newDiffArray, readDiffArray, replaceDiffArray
  66     )
  67     where
  68
  69 ------------------------------------------------------------------------
  70 -- Imports.
  71
  72 import Prelude
  73
  74 import Data.Ix
  75 import Data.Array.Base
  76 import Data.Array.IArray
  77 import Data.Array.IO
  78
  79 import Foreign.Ptr        ( Ptr, FunPtr )
  80 import Foreign.StablePtr  ( StablePtr )
  81 import Data.Int           ( Int8,  Int16,  Int32,  Int64 )
  82 import Data.Word          ( Word, Word8, Word16, Word32, Word64)
  83
  84 import System.IO.Unsafe   ( unsafePerformIO )
  85 import Control.Concurrent ( MVar, newMVar, takeMVar, putMVar, readMVar )
  86
  87 ------------------------------------------------------------------------
  88 -- Diff array types.
  89
  90 -- Convert an IO array type to a diff array.
  91 newtype IOToDiffArray a i e =
  92     DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}
  93
  94 -- Internal representation: either a mutable array, or a link to
  95 -- another diff array patched with a list of index+element pairs.
  96 data DiffArrayData a i e = Current (a i e)
  97                          | Diff (IOToDiffArray a i e) [(Int, e)]
  98
  99 -- Type synonyms for two most important IO array types.
 100 type DiffArray  = IOToDiffArray IOArray
 101 type DiffUArray = IOToDiffArray IOUArray
 102
 103 -- Having 'MArray a e IO' in instance context would require
 104 -- -fallow-undecidable-instances, so each instance is separate here.
 105
 106 ------------------------------------------------------------------------
 107 -- Boring instances.
 108
 109 instance HasBounds a => HasBounds (IOToDiffArray a) where
 110     bounds a = unsafePerformIO $ boundsDiffArray a
 111
 112 instance IArray (IOToDiffArray IOArray) e where
 113     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 114     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 115     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 116
 117 instance IArray (IOToDiffArray IOUArray) Char where
 118     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 119     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 120     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 121
 122 instance IArray (IOToDiffArray IOUArray) Int where
 123     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 124     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 125     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 126
 127 instance IArray (IOToDiffArray IOUArray) Word where
 128     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 129     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 130     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 131
 132 instance IArray (IOToDiffArray IOUArray) (Ptr a) where
 133     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 134     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 135     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 136
 137 instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
 138     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 139     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 140     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 141
 142 instance IArray (IOToDiffArray IOUArray) Float where
 143     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 144     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 145     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 146
 147 instance IArray (IOToDiffArray IOUArray) Double where
 148     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 149     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 150     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 151
 152 instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
 153     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 154     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 155     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 156
 157 instance IArray (IOToDiffArray IOUArray) Int8 where
 158     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 159     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 160     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 161
 162 instance IArray (IOToDiffArray IOUArray) Int16 where
 163     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 164     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 165     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 166
 167 instance IArray (IOToDiffArray IOUArray) Int32 where
 168     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 169     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 170     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 171
 172 instance IArray (IOToDiffArray IOUArray) Int64 where
 173     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 174     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 175     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 176
 177 instance IArray (IOToDiffArray IOUArray) Word8 where
 178     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 179     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 180     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 181
 182 instance IArray (IOToDiffArray IOUArray) Word16 where
 183     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 184     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 185     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 186
 187 instance IArray (IOToDiffArray IOUArray) Word32 where
 188     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 189     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 190     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 191
 192 instance IArray (IOToDiffArray IOUArray) Word64 where
 193     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
 194     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
 195     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray` ies
 196
 197 ------------------------------------------------------------------------
 198 -- The important stuff.
 199
 200 newDiffArray :: (MArray a e IO, Ix i)
 201              => (i,i)
 202              -> [(Int, e)]
 203              -> IO (IOToDiffArray a i e)
 204 newDiffArray (l,u) ies = do
 205     a <- newArray_ (l,u)
 206     sequence_ [unsafeWrite a i e | (i, e) <- ies]
 207     var <- newMVar (Current a)
 208     return (DiffArray var)
 209
 210 readDiffArray :: (MArray a e IO, Ix i)
 211               => IOToDiffArray a i e
 212               -> Int
 213               -> IO e
 214 a `readDiffArray` i = do
 215     d <- readMVar (varDiffArray a)
 216     case d of
 217         Current a'  -> unsafeRead a' i
 218         Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)
 219
 220 replaceDiffArray :: (MArray a e IO, Ix i)
 221                 => IOToDiffArray a i e
 222                 -> [(Int, e)]
 223                 -> IO (IOToDiffArray a i e)
 224 a `replaceDiffArray` ies = do
 225     d <- takeMVar (varDiffArray a)
 226     case d of
 227         Current a' -> case ies of
 228             [] -> do
 229                 -- We don't do the copy when there is nothing to change
 230                 -- and this is the current version. But see below.
 231                 putMVar (varDiffArray a) d
 232                 return a
 233             _:_ -> do
 234                 diff <- sequence [do e <- unsafeRead a' i; return (i, e)
 235                                   | (i, _) <- ies]
 236                 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
 237                 var' <- newMVar (Current a')
 238                 putMVar (varDiffArray a) (Diff (DiffArray var') diff)
 239                 return (DiffArray var')
 240         Diff _ _ -> do
 241             -- We still do the copy when there is nothing to change
 242             -- but this is not the current version. So you can use
 243             -- 'a // []' to make sure that the resulting array has
 244             -- fast element access.
 245             putMVar (varDiffArray a) d
 246             a' <- thawDiffArray a
 247                 -- thawDiffArray gives a fresh array which we can
 248                 -- safely mutate.
 249             sequence_ [unsafeWrite a' i e | (i, e) <- ies]
 250             var' <- newMVar (Current a')
 251             return (DiffArray var')
 252
 253 boundsDiffArray :: (HasBounds a, Ix ix)
 254                 => IOToDiffArray a ix e
 255                 -> IO (ix,ix)
 256 boundsDiffArray a = do
 257     d <- readMVar (varDiffArray a)
 258     case d of
 259         Current a' -> return (bounds a')
 260         Diff a' _  -> boundsDiffArray a'
 261
 262 freezeDiffArray :: (MArray a e IO, Ix ix)
 263                 => a ix e
 264                 -> IO (IOToDiffArray a ix e)
 265 freezeDiffArray a | (l,u) <- bounds a = do
 266     a' <- newArray_ (l,u)
 267     sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
 268     var <- newMVar (Current a')
 269     return (DiffArray var)
 270
 271 {-# RULES
 272 "freeze/DiffArray" freeze = freezeDiffArray
 273     #-}
 274
 275 -- unsafeFreezeDiffArray is really unsafe. Better don't use the old
 276 -- array at all after freezing. The contents of the source array will
 277 -- be changed when '//' is applied to the resulting array.
 278
 279 unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
 280                       => a ix e
 281                       -> IO (IOToDiffArray a ix e)
 282 unsafeFreezeDiffArray a = do
 283     var <- newMVar (Current a)
 284     return (DiffArray var)
 285
 286 {-# RULES
 287 "unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
 288     #-}
 289
 290 thawDiffArray :: (MArray a e IO, Ix ix)
 291               => IOToDiffArray a ix e
 292               -> IO (a ix e)
 293 thawDiffArray a = do
 294     d <- readMVar (varDiffArray a)
 295     case d of
 296         Current a' | (l,u) <- bounds a' -> do
 297             a'' <- newArray_ (l,u)
 298             sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
 299             return a''
 300         Diff a' ies -> do
 301             a'' <- thawDiffArray a'
 302             sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
 303             return a''
 304
 305 {-# RULES
 306 "thaw/DiffArray" thaw = thawDiffArray
 307     #-}
 308
 309 -- unsafeThawDiffArray is really unsafe. Better don't use the old
 310 -- array at all after thawing. The contents of the resulting array
 311 -- will be changed when '//' is applied to the source array.
 312
 313 unsafeThawDiffArray :: (MArray a e IO, Ix ix)
 314                     => IOToDiffArray a ix e
 315                     -> IO (a ix e)
 316 unsafeThawDiffArray a = do
 317     d <- readMVar (varDiffArray a)
 318     case d of
 319         Current a'  -> return a'
 320         Diff a' ies -> do
 321             a'' <- unsafeThawDiffArray a'
 322             sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
 323             return a''
 324
 325 {-# RULES
 326 "unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
 327     #-}