diffarray (empty) → 0.1
raw patch · 4 files changed
+565/−0 lines, 4 filesdep +arraydep +basesetup-changed
Dependencies added: array, base
Files
- Data/Array/Diff.hs +456/−0
- LICENSE +83/−0
- Setup.hs +6/−0
- diffarray.cabal +20/−0
+ Data/Array/Diff.hs view
@@ -0,0 +1,456 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.Diff+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : libraries@haskell.org+-- Stability : experimental+-- Portability : non-portable (uses Data.Array.IArray)+--+-- 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".++ IOToDiffArray, -- 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:+ DiffArray, -- = IOToDiffArray IOArray+ -- ...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 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 )+import Data.Word ( Word, Word8, Word16, Word32, Word64 )++import System.IO.Unsafe ( unsafePerformIO )+import Control.Exception ( evaluate )+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+-- -XUndecidableInstances, 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 Bool) 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++instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where+ showsPrec = showsIArray++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 IArray (IOToDiffArray IOArray) e where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray 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) Bool where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray 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) Char where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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) Word where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray 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) (Ptr a) where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray 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+ numElements a = unsafePerformIO $ numElementsDiffArray a+ unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies+ unsafeAt a i = unsafePerformIO $ a `readDiffArray` i+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` 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')++-- The elements of the diff list might recursively reference the+-- array, so we must seq them before taking the MVar to avoid+-- deadlock.+replaceDiffArray1 :: (MArray a e IO, Ix i)+ => IOToDiffArray a i e+ -> [(Int, e)]+ -> IO (IOToDiffArray a i e)+a `replaceDiffArray1` ies = do+ mapM_ (evaluate . fst) ies+ a `replaceDiffArray` ies++-- If the array contains unboxed elements, then the elements of the+-- diff list may also recursively reference the array from inside+-- replaceDiffArray, so we must seq them too.+replaceDiffArray2 :: (MArray a e IO, Ix i)+ => IOToDiffArray a i e+ -> [(Int, e)]+ -> IO (IOToDiffArray a i e)+arr `replaceDiffArray2` ies = do+ mapM_ (\(a,b) -> evaluate a >> evaluate b) ies+ arr `replaceDiffArray` ies+++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' -> getBounds a'+ Diff a' _ -> boundsDiffArray a'++numElementsDiffArray :: (MArray a e IO, Ix ix)+ => IOToDiffArray a ix e+ -> IO Int+numElementsDiffArray a+ = do d <- readMVar (varDiffArray a)+ case d of+ Current a' -> getNumElements a'+ Diff a' _ -> numElementsDiffArray a'++freezeDiffArray :: (MArray a e IO, Ix ix)+ => a ix e+ -> IO (IOToDiffArray a ix e)+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+ #-}++-- 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+ #-}++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' -> do+ (l,u) <- getBounds a'+ 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+ #-}++-- 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+ #-}
+ LICENSE view
@@ -0,0 +1,83 @@+This library (libraries/diffarray) is derived from code from several+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++ * Code from the Haskell Foreign Function Interface specification,+ which is (c) Manuel M. T. Chakravarty and freely redistributable+ (but see the full license for restrictions).++The full text of these licenses is reproduced below. All of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++ Copyright (c) 2002 Manuel M. T. Chakravarty++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Foreign Function Interface.++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ diffarray.cabal view
@@ -0,0 +1,20 @@+name: diffarray+version: 0.1+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+synopsis: DiffArray+category: Data Structures+description:+ This package defines the DiffArray type.+cabal-version: >=1.6+build-type: Simple++library+ build-depends: base >= 4 && < 5,+ array+ exposed-modules:+ Data.Array.Diff+ extensions: FlexibleInstances, FlexibleContexts,+ MultiParamTypeClasses, TypeSynonymInstances+