ArrayRef (empty) → 0.1

raw patch · 42 files changed

+3840/−0 lines, 42 filesdep +basesetup-changed

Dependencies added: base

Files

• ArrayRef.cabal +66/−0
• Control/Concurrent/LockingBZ.hs +183/−0
• Control/Monad/STorIO.hs +56/−0
• Data/ArrayBZ/Boxed.hs +26/−0
• Data/ArrayBZ/Diff.hs +305/−0
• Data/ArrayBZ/Dynamic.hs +180/−0
• Data/ArrayBZ/IArray.hs +50/−0
• Data/ArrayBZ/IO.hs +193/−0
• Data/ArrayBZ/Internals/Boxed.hs +274/−0
• Data/ArrayBZ/Internals/IArray.hs +253/−0
• Data/ArrayBZ/Internals/MArray.hs +276/−0
• Data/ArrayBZ/Internals/Unboxed.hs +247/−0
• Data/ArrayBZ/Internals/readme.txt +21/−0
• Data/ArrayBZ/Internals/unused.hs +137/−0
• Data/ArrayBZ/MArray.hs +61/−0
• Data/ArrayBZ/ST.hs +56/−0
• Data/ArrayBZ/Storable.hs +106/−0
• Data/ArrayBZ/Unboxed.hs +27/−0
• Data/HasDefaultValue.hs +51/−0
• Data/Ref.hs +24/−0
• Data/Ref/LazyST.hs +45/−0
• Data/Ref/Unboxed.hs +81/−0
• Data/Ref/Universal.hs +91/−0
• Data/SyntaxSugar.hs +131/−0
• Data/Unboxed.hs +151/−0
• Examples/Array/Boxed.hs +36/−0
• Examples/Array/Diff.hs +25/−0
• Examples/Array/Dynamic.hs +45/−0
• Examples/Array/IO.hs +26/−0
• Examples/Array/ST.hs +27/−0
• Examples/Array/Storable.hs +14/−0
• Examples/Array/Unboxed.hs +36/−0
• Examples/SyntaxSugar.hs +81/−0
• Examples/URef.hs +29/−0
• Examples/Universal.hs +37/−0
• GHC/ArrBZ.hs +105/−0
• GHC/Unboxed.hs +185/−0
• Hugs/Typeable.h +70/−0
• LICENSE +28/−0
• README +0/−0
• Setup.hs +5/−0
• TODO +0/−0

@@ -0,0 +1,66 @@+Name:               ArrayRef+Version:            0.1+Category:           Data+Synopsis:           Unboxed references, dynamic arrays and more+Description:        This array library supports: unboxed references,+                    Monad-independent references, syntax sugar for mutable types,+                    a reimplemented Arrays library, changes in MArray usage,+                    and using dynamic (resizable) arrays+License:            BSD3+License-file:       LICENSE+Stability:          experimental+Author:             Bulat Ziganshin+Maintainer:         Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+Homepage:           http://haskell.org/haskellwiki/Library/ArrayRef++Build-type:         Simple+Tested-with:        GHC==6.8.2+Build-Depends:      base+Extensions:         CPP, FlexibleContexts, FlexibleInstances, FunctionalDependencies,+                    KindSignatures, ForeignFunctionInterface,+                    MagicHash, RankNTypes, ScopedTypeVariables, TypeOperators,+                    TypeSynonymInstances, UnboxedTuples, UnliftedFFITypes+ghc-options:         -O2 -Wall -optl-Wl,-s+ghc-prof-options:    -prof -auto-all++Exposed-modules:+                    Control.Concurrent.LockingBZ,+                    Control.Monad.STorIO,+                    Data.HasDefaultValue,+                    Data.Ref,+                    Data.SyntaxSugar,+                    Data.Unboxed,+                    Data.ArrayBZ.Boxed,+                    Data.ArrayBZ.Diff,+                    Data.ArrayBZ.Dynamic,+                    Data.ArrayBZ.IArray,+                    Data.ArrayBZ.IO,+                    Data.ArrayBZ.MArray,+                    Data.ArrayBZ.ST,+                    Data.ArrayBZ.Storable,+                    Data.ArrayBZ.Unboxed,+                    Data.ArrayBZ.Internals.Boxed,+                    Data.ArrayBZ.Internals.IArray,+                    Data.ArrayBZ.Internals.MArray,+                    Data.ArrayBZ.Internals.Unboxed,+                    Data.Ref.LazyST,+                    Data.Ref.Unboxed,+                    Data.Ref.Universal,+                    GHC.ArrBZ,+                    GHC.Unboxed+Extra-source-files:+                    README+                    TODO,+                    Hugs/Typeable.h,+                    Data/ArrayBZ/Internals/readme.txt,+                    Data/ArrayBZ/Internals/unused.hs,+                    Examples/SyntaxSugar.hs,+                    Examples/Universal.hs,+                    Examples/URef.hs,+                    Examples/Array/Boxed.hs,+                    Examples/Array/Diff.hs,+                    Examples/Array/Dynamic.hs,+                    Examples/Array/IO.hs,+                    Examples/Array/ST.hs,+                    Examples/Array/Storable.hs,+                    Examples/Array/Unboxed.hs

@@ -0,0 +1,183 @@+{-# LANGUAGE CPP, FunctionalDependencies, FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.LockingBZ
+-- Copyright   :  (c) Bulat Ziganshin <Bulat.Ziganshin@gmail.com> 2006
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- Attaching lock to immutable value.
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.LockingBZ
+  (
+          -- * Locking
+
+          -- $intro
+
+          -- ** The 'WithLocking h' type constructor
+        WithLocking(..),        -- instance of Show
+
+          -- ** Attaching lock to value
+        addLocking,             -- :: h -> IO (WithLocking h)
+        withLocking,            -- :: h -> (WithLocking h -> IO a) -> IO a
+
+          -- ** Using value inside lock
+#if defined (__GLASGOW_HASKELL__) || defined (__HUGS__)
+        Locking(..),
+#else
+        lock,
+#endif
+
+          -- ** Promoting operations to use locks
+        liftLock1,
+        liftLock2,
+        liftLock3,
+        liftLock4,
+        liftLock5,
+
+   ) where
+
+import Control.Concurrent.MVar
+import Control.Exception as Exception
+
+{- $intro
+
+This library allows to attach lock to any immutable value so that access
+to this value can be obtained only via the 'lock' operation that ensures
+that this value will never be used at the same time by concurrent threads.
+Lock attached to value by 'addLocking' operation, it's also possible to run
+code block with locked version of some value by 'withLocking' operation.
+
+To work with value contained inside lock, you should use 'lock' operation;
+it's usage is very like to using 'withMVar' for the same purpose, but you
+don't got ability to return new value of internal data from the action
+performed. On the other side, 'lock' operation is about two times faster
+than 'withMVar' according to my tests. There are also 'liftLock*'
+operations that simplifies promoting operations on original value to
+operations on it's locked version. Hugs/GHC version of this library defines
+'lock' as operation of class 'Locking' that opens possibility to define
+alternative 'lock' implementations.
+
+First usage example - adding lock to mutable array and promoting the mutable
+array with lock to support mutable array interface again. This can be done
+with any objects what are accessed through some interface defined via type
+class:
+
+>   import Control.Concurrent.Locking
+>
+>   type WithLocking2 a e m = WithLocking (a e m)
+>
+>   instance (MArray a e m) => (MArray (WithLocking2 a) e m) where
+>       newArray lu e = newArray lu e >>= addLocking
+>       newArray_ lu  = newArray_ lu  >>= addLocking
+>       unsafeRead = liftLock2 unsafeRead
+>       unsafeWrite = liftLock3 unsafeWrite
+>
+>   main = do arr <- newArray (0,9) 0 >>= addLocking
+>             readArray arr 0 >>= writeArray arr 1
+>             .....
+>
+
+Another example where 'lock' operation used to get exclusive access to file
+while performing sequence of operations on it:
+
+>   main = do lh <- openBinaryFile "test" ReadMode >>= addLocking
+>             ....
+>             str <- readStringAt lh pos
+>             ....
+>
+>   readStringAt lh pos =
+>       lock lh $ \h -> do
+>           saved_pos <- hTell h
+>           hSeek h AbsoluteSeek pos
+>           str <- hGetLine h
+>           hSeek h AbsoluteSeek saved_pos
+>           return str
+
+In this example, any thread can use 'readStringAt' on the same locked handle
+without risk to interfere with each other's operation
+
+-}
+
+
+-- -----------------------------------------------------------------------------
+-- 'WithLocking' type constructor and it's constructor functions
+
+-- | Type constructor that attaches lock to immutable value @h@
+data WithLocking h = WithLocking h !(MVar ())
+
+instance (Show h) => Show (WithLocking h) where
+    show (WithLocking h _) = "WithLocking ("++ show h ++")"
+
+-- | Add lock to object to ensure it's proper use in concurrent threads
+addLocking :: h -> IO (WithLocking h)
+addLocking h = do
+    mvar <- newMVar ()
+    return (WithLocking h mvar)
+
+-- | Run @action@ with locked version of object
+withLocking :: h -> (WithLocking h -> IO a) -> IO a
+withLocking h action = do
+    addLocking h >>= action
+
+-- -----------------------------------------------------------------------------
+-- 'lock' operation definition: use MPTC+FD for Hugs/GHC or simple function for
+-- compilers that don't support MPTC+FD
+
+#if defined (__GLASGOW_HASKELL__) || defined (__HUGS__)
+
+-- | Define class of locking implementations, where 'lh' holds lock around 'h'
+class Locking lh h | lh->h where
+    -- | Perform action while exclusively locking wrapped object
+    -- (faster analog of using 'withMVar' for the same purpose)
+    lock :: lh -> (h->IO a) -> IO a
+
+instance Locking (WithLocking h) h where
+    {-# INLINE lock #-}
+    lock
+
+#else
+
+{-# INLINE lock #-}
+-- | Perform action while exclusively locking wrapped object
+-- (faster analog of using 'withMVar' for the same purpose)
+lock :: (WithLocking h) -> (h->IO a) -> IO a
+lock
+
+#endif
+     (WithLocking h mvar) action = do
+        Exception.catch (do takeMVar mvar
+                            result <- action h
+                            putMVar mvar ()
+                            return result
+                        )
+                        (\e -> do tryPutMVar mvar (); throw e)
+
+-- -----------------------------------------------------------------------------
+-- Helper operations - wrappers around 'lock'
+
+{-# INLINE liftLock1 #-}
+-- | Lift 1-parameter action to operation on locked variable
+liftLock1 action h         = lock h (\a -> action a)
+
+{-# INLINE liftLock2 #-}
+-- | Lift 2-parameter action to operation on locked variable
+liftLock2 action h x       = lock h (\a -> action a x)
+
+{-# INLINE liftLock3 #-}
+-- | Lift 3-parameter action to operation on locked variable
+liftLock3 action h x y     = lock h (\a -> action a x y)
+
+{-# INLINE liftLock4 #-}
+-- | Lift 4-parameter action to operation on locked variable
+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 action h x y z t = lock h (\a -> action a x y z t)
+

@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Control.Monad.STorIO+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Unification of ST and IO operations!++-}++module Control.Monad.STorIO (+           STorIO(..),+           IOSpecific,+           IOSpecific2,+           IOSpecific3,+       )+where++#ifdef __GLASGOW_HASKELL__++import GHC.Unboxed++#else++import Control.Monad.ST+import qualified Control.Monad.ST.Lazy as Lazy++-- ---------------------------------------------------------------------------+-- | That's all we need to unify ST and IO operations!++class (Monad m) => STorIO m s | m->s where+    mLift :: IO a -> m a++instance STorIO (ST s) s where+    {-# INLINE mLift #-}+    mLift = unsafeIOToST++instance STorIO (Lazy.ST s) s where+    {-# INLINE mLift #-}+    mLift = Lazy.unsafeIOToST++instance STorIO IO () where+    {-# INLINE mLift #-}+    mLift = id++-- | Type functions which converts universal ST/IO types to IO-specific ones+type IOSpecific  a = a ()+type IOSpecific2 a b = a () b+type IOSpecific3 a = a ()++#endif+

@@ -0,0 +1,26 @@+{- |+   Module     : Data.ArrayBZ.Boxed+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Boxed arrays++-}++module Data.ArrayBZ.Boxed (+           Array,+           IOArray,+           STArray,+           module Data.Ix,+           module Data.ArrayBZ.Internals.IArray,+           module Data.ArrayBZ.Internals.MArray,+  ) where++import Data.Ix+import Data.ArrayBZ.Internals.Boxed+import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray

@@ -0,0 +1,305 @@+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts,+  MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Diff+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Functional arrays with constant-time update.++-}++module Data.ArrayBZ.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.ArrayBZ.Internals.IArray" provides the interface+    -- of diff arrays. They are instances of class 'IArray'.+    module Data.ArrayBZ.Internals.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.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+import Data.Unboxed++------------------------------------------------------------------------+-- 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++------------------------------------------------------------------------+-- Instances.++instance HasBounds a => HasBounds (IOToDiffArray a) where+    bounds a = unsafePerformIO $ boundsDiffArray a++instance IArray DiffArray e where+    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies+    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i+    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray1` ies++instance (Unboxed e) => IArray DiffUArray e where+    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies+    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i+    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies++------------------------------------------------------------------------+-- Showing DiffArrays.++instance (Ix i, Show i, Show e) => Show (DiffArray i e) where+  showsPrec = showsIArray++instance (Ix i, Show i, Show e, Unboxed e, HasDefaultValue e) => Show (DiffUArray i e) where+  showsPrec = showsIArray++-- ---------------------------------------------------------------------------+-- Comparing DiffArrays.++instance (Ix i, Eq i, Eq e) => Eq (DiffArray i e) where+    (==) = eqIArray++instance (Ix i, Ord i, Ord e) => Ord (DiffArray i e) where+    compare = cmpIArray++instance (Ix i, Eq i, Eq e, Unboxed e, HasDefaultValue e) => Eq (DiffUArray i e) where+    (==) = eqIArray++instance (Ix i, Ord i, Ord e, Unboxed e, HasDefaultValue e) => Ord (DiffUArray i e) where+    compare = cmpIArray++------------------------------------------------------------------------+-- Helper functions.++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)+a `replaceDiffArray2` ies = do+    mapM_ (\(a,b) -> do evaluate a; evaluate b) ies+    a `replaceDiffArray` ies++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 = do+    lu <- getBounds a+    a' <- newArray_ lu+    sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize lu - 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+            lu <- getBounds a'+            a'' <- newArray_ lu+            sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize lu - 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+    #-}

@@ -0,0 +1,180 @@+{-# LANGUAGE CPP, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Dynamic+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Arrays with dynamically changed bounds in IO and ST monads.++-}++module Data.ArrayBZ.Dynamic (+   -- $info+   -- * Type constructors+   Dynamic,+   DynamicIO,+   DynamicIOArray,+   DynamicIOUArray,+   DynamicST,+   DynamicSTArray,+   DynamicSTUArray,+   GrowBoundsF,+   -- * Operations+   newDynamicArray,+   newDynamicArray_,+   resizeDynamicArray,+   -- * Array growing strategies+   noGrow,+   growMinimally,+   growTwoTimes,+   -- Reexported MArray interface+   module Data.ArrayBZ.Internals.MArray+ ) where++import Data.Ref+import Data.ArrayBZ.Internals.MArray+import Data.ArrayBZ.IO+import Data.ArrayBZ.ST+#ifdef __GLASGOW_HASKELL__+import GHC.Arr                  ( unsafeIndex )+#endif+#ifdef __HUGS__+import Hugs.Array               ( unsafeIndex )+#endif++{- $info++Array with dynamically changed bounds can be created from any mutable array+type by using type converter Dynamic. I have created synonyms for widely used+array constructors, for example "DynamicIOUArray Int Double".+Dynamic array supports the same MArray and HasMutableBounds interfaces as other+mutable arrays, but they don't support HasBounds interface. Dynamic array can be+resized explicitly by operation `resizeDynamicArray`.++Dynamic array can also grow automatically when `writeArray` is used with index+that is out of current array bounds. For this to work, array should be created+using non-standard operations `newDynamicArray` or `newDynamicArray_`. The first+argument of these operations is "growing strategy", i.e. the function of type+`GrowBoundsF i`, other arguments are the same as for newArray/newArray_. The+predefined growing strategies include `noGrow` that disables automatic growing,+`growMinimally` that extends array only to include new index and `growTwoTimes`+that extend array at least 2 times each time it needs to grow.++When array grows, either explicitly or automatically, new elements are+initialized with `init` value if this array was created by+newArray/newDynamicArray.++-}++-- ---------------------------------------------------------------------------+-- Types++-- | Representation of dynamic array. Includes+--     * function to calculate new array bounds when it needs to grow+--     * optional value used for initializing new elements when array grows+--     * reference to current array contents+data Dynamic r a i e = Dynamic (GrowBoundsF i) (Maybe e) (r (a i e))++-- | Dynamic arrays in IO monad+type DynamicIO         = Dynamic IORef+-- |Dynamic version of IOArray+type DynamicIOArray    = DynamicIO IOArray+-- |Dynamic version of IOUArray+type DynamicIOUArray   = DynamicIO IOUArray++-- | Dynamic arrays in ST monad+type DynamicST       s =  Dynamic (STRef s)+-- |Dynamic version of STArray+type DynamicSTArray  s = (DynamicST s) (STArray  s)+-- |Dynamic version of STUArray+type DynamicSTUArray s = (DynamicST s) (STUArray s)++-- | This type represents function that calculates new array bounds when it needs to grow+type GrowBoundsF i  =  (i,i) -> i -> (i,i)++-- ---------------------------------------------------------------------------+-- Operations++-- | 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+    a   <- newRef arr+    return (Dynamic f (Just init) 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+    a   <- newRef arr+    return (Dynamic f Nothing a)++-- | Extend/shrink dynamic array to new bounds+resizeDynamicArray (Dynamic _ e a) newbounds = do+    arr <- readRef a+    bounds <- getBounds arr+    newarr <- case e of+                Just init -> newArray  newbounds init+                Nothing   -> newArray_ newbounds+    sequence_ [ readArray arr i >>= writeArray newarr i+              | i <- range bounds, inRange newbounds i ]+    writeRef a newarr++-- ---------------------------------------------------------------------------+-- Instances++instance (HasMutableBounds a m, Ref m r) => HasMutableBounds (Dynamic r a) m where+    {-# INLINE getBounds #-}+    getBounds (Dynamic _ _ a)  =  readRef a >>= getBounds++instance (MArray a e m, Ref m r) => MArray (Dynamic r a) e m where+    newArray_ =  newDynamicArray_ noGrow+    newArray  =  newDynamicArray  noGrow++    {-# INLINE unsafeRead #-}+    unsafeRead  (Dynamic _ _ a) i = do arr <- readRef a+                                       unsafeRead arr i++    {-# INLINE unsafeWrite #-}+    unsafeWrite (Dynamic _ _ a) i e = do arr <- readRef a+                                         unsafeWrite arr i e++    {-# 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++-- 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)+    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 _ _ = 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 (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 (l,u) i = if i<l then (min (l-(u-l)) i, u)+                              else (l, max (u+(u-l)) i)+

@@ -0,0 +1,50 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Data.ArrayBZ.IArray+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Immutable arrays, with an overloaded interface.  For array types which+can be used with this interface, see the 'Array' type exported by this+module, and the "Data.ArrayBZ.Unboxed" and "Data.ArrayBZ.Diff" modules.++-}++module Data.ArrayBZ.IArray (+    -- * Array classes+    HasBounds,  -- :: (* -> * -> *) -> class+    IArray,     -- :: (* -> * -> *) -> * -> class++    module Data.Ix,++    -- * Immutable non-strict (boxed) arrays+    Array,++    -- * Array construction+    array,      -- :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e+    listArray,  -- :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e+    accumArray, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e++    -- * Accessing arrays+    (!),        -- :: (IArray a e, Ix i) => a i e -> i -> e+    bounds,     -- :: (HasBounds a, Ix i) => a i e -> (i,i)+    indices,    -- :: (HasBounds a, Ix i) => a i e -> [i]+    elems,      -- :: (IArray a e, Ix i) => a i e -> [e]+    assocs,     -- :: (IArray a e, Ix i) => a i e -> [(i, e)]++    -- * Incremental array updates+    (//),       -- :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e+    accum,      -- :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e++    -- * Derived arrays+    amap,       -- :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e+    ixmap,      -- :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e+ )  where++import Data.Ix+import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.Boxed (Array)

@@ -0,0 +1,193 @@+{-# LANGUAGE CPP, UnliftedFFITypes #-}+{-# INCLUDE "HsBase.hs" #-}+{- |+   Module     : Data.ArrayBZ.IO+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Mutable boxed and unboxed arrays in the IO monad.+-}++module Data.ArrayBZ.IO (+   -- * @IO@ arrays with boxed elements+   IOArray,             -- instance of: Eq, Typeable++   -- * @IO@ arrays with unboxed elements+   IOUArray,            -- instance of: Eq, Typeable+   castIOUArray,        -- :: IOUArray i a -> IO (IOUArray i b)++   -- * Overloaded mutable array interface+   module Data.ArrayBZ.MArray,++   -- * Doing I\/O with @IOUArray@s+   hGetArray,           -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int+   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++#ifdef __GLASGOW_HASKELL__+import Foreign+import Foreign.C++import GHC.IOBase hiding (IOArray)+import GHC.Handle+import GHC.Unboxed++-- ---------------------------------------------------------------------------+-- hGetArray++-- | Reads a number of 'Word8's from the specified 'Handle' directly+-- into an array.+hGetArray+        :: Handle               -- ^ Handle to read from+        -> IOUArray Int Word8   -- ^ Array in which to place the values+        -> Int                  -- ^ Number of 'Word8's to read+        -> IO Int+                -- ^ Returns: the number of 'Word8's actually+                -- read, which might be smaller than the number requested+                -- if the end of file was reached.++hGetArray handle (UMA l u (MUVec ptr)) count+  | count == 0+  = return 0+  | count < 0 || count > rangeSize (l,u)+  = illegalBufferSize handle "hGetArray" count+  | otherwise = do+      wantReadableHandle "hGetArray" handle $+        \ handle_@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+           else do+                let avail = w - r+                copied <- if (count >= avail)+                            then do+                                memcpy_ba_baoff ptr raw r (fromIntegral avail)+                                writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }+                                return avail+                            else do+                                memcpy_ba_baoff ptr raw r (fromIntegral count)+                                writeIORef ref buf{ bufRPtr = r + count }+                                return count++                let remaining = count - copied+                if remaining > 0+                   then do rest <- readChunk fd is_stream ptr copied remaining+                           return (rest + copied)+                   else return count++readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int+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+    r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr+                                    (fromIntegral off) (fromIntegral bytes)+    let r = fromIntegral r'+    if r == 0+        then return (off - init_off)+        else loop (off + r) (bytes - r)++-- ---------------------------------------------------------------------------+-- hPutArray++-- | Writes an array of 'Word8' to the specified 'Handle'.+hPutArray+        :: Handle                       -- ^ Handle to write to+        -> IOUArray Int Word8           -- ^ Array to write from+        -> Int                          -- ^ Number of 'Word8's to write+        -> IO ()++hPutArray handle (UMA l u (MUVec raw)) count+  | count == 0+  = return ()+  | count < 0 || count > rangeSize (l,u)+  = illegalBufferSize handle "hPutArray" count+  | otherwise+   = do wantWritableHandle "hPutArray" handle $+          \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do++          old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }+            <- readIORef ref++          -- enough room in handle buffer?+          if (size - w > count)+                -- There's enough room in the buffer:+                -- just copy the data in and update bufWPtr.+            then do memcpy_baoff_ba old_raw w raw (fromIntegral count)+                    writeIORef ref old_buf{ bufWPtr = w + count }+                    return ()++                -- else, we have to flush+            else do flushed_buf <- flushWriteBuffer fd stream old_buf+                    writeIORef ref flushed_buf+                    let this_buf =+                            Buffer{ bufBuf=raw, bufState=WriteBuffer,+                                    bufRPtr=0, bufWPtr=count, bufSize=count }+                    flushWriteBuffer fd stream this_buf+                    return ()++-- ---------------------------------------------------------------------------+-- Internal Utils++foreign import ccall unsafe "__hscore_memcpy_dst_off"+   memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())+foreign import ccall unsafe "__hscore_memcpy_src_off"+   memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())++illegalBufferSize :: Handle -> String -> Int -> IO a+illegalBufferSize handle fn sz =+        ioException (IOError (Just handle)+                            InvalidArgument  fn+                            ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])+                            Nothing)++#else /* !__GLASGOW_HASKELL__ */+import Data.Char+import System.IO+import System.IO.Error+import Data.ArrayBZ.Internals.MArray++hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int+hGetArray handle arr count+  | count < 0 || count > rangeSize (bounds arr)+  = illegalBufferSize handle "hGetArray" count+  | otherwise = get 0+ where+  get i | i == count = return i+        | otherwise = do+                error_or_c <- try (hGetChar handle)+                case error_or_c of+                    Left ex+                        | isEOFError ex -> return i+                        | otherwise -> ioError ex+                    Right c -> do+                        unsafeWrite arr i (fromIntegral (ord c))+                        get (i+1)++hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO ()+hPutArray handle arr count+  | count < 0 || count > rangeSize (bounds arr)+  = illegalBufferSize handle "hPutArray" count+  | otherwise = put 0+ where+  put i | i == count = return ()+        | otherwise = do+                w <- unsafeRead arr i+                hPutChar handle (chr (fromIntegral w))+                put (i+1)++illegalBufferSize :: Handle -> String -> Int -> IO a+illegalBufferSize _ fn sz = ioError $+        userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) [])+#endif /* !__GLASGOW_HASKELL__ */

@@ -0,0 +1,274 @@+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Internals.Boxed+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Boxed arrays++-}++module Data.ArrayBZ.Internals.Boxed+#ifdef __HUGS__+         ( -- * Types+           Array,+           IOArray,+           STArray,++           -- * Freeze/thaw operations+           freezeIOArray,+           thawIOArray,+           unsafeFreezeIOArray,+           freezeSTArray,+           thawSTArray,+           unsafeFreezeSTArray,+         )+#endif+   where++import Control.Monad.ST         ( ST, runST )+import Control.Monad.ST.Lazy    ( strictToLazyST )+import qualified Control.Monad.ST.Lazy as Lazy (ST)+import Data.Ix+import Data.Typeable+#include "Typeable.h"++import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray++#ifdef __HUGS__+-- ---------------------------------------------------------------------------+-- Hugs primitives are higher-level than GHC/NHC's+-- ---------------------------------------------------------------------------++import Hugs.Array as Arr+import Hugs.IOArray+import Hugs.ST++-----------------------------------------------------------------------------+-- Normal polymorphic arrays++instance HasBounds Array where+    bounds           = Arr.bounds++instance IArray Array e where+    unsafeArray      = Arr.unsafeArray+    unsafeAt         = Arr.unsafeAt+    unsafeReplace    = Arr.unsafeReplace+    unsafeAccum      = Arr.unsafeAccum+    unsafeAccumArray = Arr.unsafeAccumArray++-----------------------------------------------------------------------------+-- | Instance declarations for 'IOArray's++instance HasBounds IOArray where+    bounds      = boundsIOArray++instance HasMutableBounds IOArray IO where+    getBounds   = return . boundsIOArray++instance MArray IOArray e IO where+    newArray    = newIOArray+    unsafeRead  = unsafeReadIOArray+    unsafeWrite = unsafeWriteIOArray++-----------------------------------------------------------------------------+-- Polymorphic non-strict mutable arrays (ST monad)++instance HasBounds (STArray s) where+    bounds      = boundsSTArray++instance HasMutableBounds (STArray s) (ST s) where+    getBounds   = return . boundsSTArray++instance MArray (STArray s) e (ST s) where+    newArray    = newSTArray+    unsafeRead  = unsafeReadSTArray+    unsafeWrite = unsafeWriteSTArray++#else+-- ---------------------------------------------------------------------------+-- Non-Hugs implementation+-- ---------------------------------------------------------------------------++import Control.Monad.STorIO+import GHC.ArrBZ++-- ---------------------------------------------------------------------------+-- | Boxed mutable arrays++data BoxedMutableArray s i e  =  BMA !i !i !(MVec s e)++instance HasBounds (BoxedMutableArray s) where+    {-# INLINE bounds #-}+    bounds (BMA l u _) = (l,u)++instance (STorIO m s) => HasMutableBounds (BoxedMutableArray s) m where+    {-# INLINE getBounds #-}+    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)+    {-# INLINE unsafeRead #-}+    unsafeRead  (BMA _ _ arr) index  =  readBoxed  arr index+    {-# INLINE unsafeWrite #-}+    unsafeWrite (BMA _ _ arr) index  =  writeBoxed arr index++-- ---------------------------------------------------------------------------+-- | Boxed mutable arrays in ST monad++type STArray = BoxedMutableArray++-- ---------------------------------------------------------------------------+-- STArray also works in Lazy ST monad++instance MArray (STArray s) e (Lazy.ST s) where+    {-# INLINE newArray #-}+    newArray (l,u) init = strictToLazyST (newArray (l,u) init)+    {-# INLINE unsafeRead #-}+    unsafeRead  arr i   = strictToLazyST (unsafeRead  arr i)+    {-# INLINE unsafeWrite #-}+    unsafeWrite arr i e = strictToLazyST (unsafeWrite arr i e)++-- ---------------------------------------------------------------------------+-- | Boxed mutable arrays in IO monad++type IOArray = IOSpecific3 BoxedMutableArray++-- ---------------------------------------------------------------------------+-- | Boxed immutable arrays++data Array i e  =  BA !i !i !(Vec e)++instance HasBounds Array where+    {-# INLINE bounds #-}+    bounds (BA l u _) = (l,u)++instance IArray Array e where+    {-# INLINE unsafeArray #-}+    -- 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+    {-# 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))+    {-# INLINE unsafeAccumArray #-}+    -- Create new array accumulating (i,e) values+    unsafeAccumArray f init lu ies = runST (withNewArray lu init (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+    action marr+    unsafeFreezeBA marr++-- Make a copy of array and perform given action on it before freezing+withArrayCopy arr action = do+    marr <- thawBA arr+    action marr+    unsafeFreezeBA marr++-- Perform (i,e) replaces in mutable array+doReplace ies marr = do+    sequence_ [unsafeWrite marr i e | (i, e) <- ies]++-- Accumulate (i,e) values in mutable array+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 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 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 (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+    marr <- unsafeThawBoxed arr+    return (BMA l u marr)++-- | Number of array elements+sizeOfBA arr = rangeSize (bounds arr)++-- ---------------------------------------------------------------------------+-- | Freeze/thaw rules for IOArray++freezeIOArray       :: (Ix i) => IOArray i e -> IO (Array i e)+thawIOArray         :: (Ix i) => Array i e -> IO (IOArray i e)+unsafeFreezeIOArray :: (Ix i) => IOArray i e -> IO (Array i e)+unsafeThawIOArray   :: (Ix i) => Array i e -> IO (IOArray i e)++freezeIOArray       = freezeBA+thawIOArray         = thawBA+unsafeFreezeIOArray = unsafeFreezeBA+unsafeThawIOArray   = unsafeThawBA++{-# RULES+"freeze/IOArray" freeze = freezeIOArray+"thaw/IOArray"   thaw   = thawIOArray+"unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray+"unsafeThaw/IOArray"   unsafeThaw   = unsafeThawIOArray+    #-}++-- ---------------------------------------------------------------------------+-- | Freeze/thaw rules for STArray++freezeSTArray       :: (Ix i) => STArray s i e -> ST s (Array i e)+thawSTArray         :: (Ix i) => Array i e -> ST s (STArray s i e)+unsafeFreezeSTArray :: (Ix i) => STArray s i e -> ST s (Array i e)+unsafeThawSTArray   :: (Ix i) => Array i e -> ST s (STArray s i e)++freezeSTArray       = freezeBA+thawSTArray         = thawBA+unsafeFreezeSTArray = unsafeFreezeBA+unsafeThawSTArray   = unsafeThawBA++{-# RULES+"freeze/STArray" freeze = freezeSTArray+"thaw/STArray"   thaw   = thawSTArray+"unsafeFreeze/STArray" unsafeFreeze = unsafeFreezeSTArray+"unsafeThaw/STArray"   unsafeThaw   = unsafeThawSTArray+    #-}++-- ---------------------------------------------------------------------------+-- | Instances++instance (Ix i, Show i, Show e) => Show (Array i e) where+    showsPrec = showsIArray++instance (Ix i, Eq i, Eq e) => Eq (Array i e) where+    (==) = eqIArray++instance (Ix i, Ord i, Ord e) => Ord (Array i e) where+    compare = cmpIArray++#endif+++INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")++INSTANCE_TYPEABLE3(STArray,stArrayTc,"STArray")+

@@ -0,0 +1,253 @@+{-# LANGUAGE CPP, MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Internals.IArray+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Immutable arrays: class, general algorithms and Show/Ord/Eq implementations++-}++module Data.ArrayBZ.Internals.IArray where++import Control.Monad.ST         ( ST, runST )+import Data.Ix+#ifdef __GLASGOW_HASKELL__+import GHC.Arr                  ( unsafeIndex )+#endif+#ifdef __HUGS__+import Hugs.Array               ( unsafeIndex )+#endif++-----------------------------------------------------------------------------+-- Class of immutable arrays++-- | Class of array types with immutable bounds+-- (even if the array elements are mutable).+class HasBounds a where+    -- | Extracts the bounds of an array+    bounds :: Ix i => a i e -> (i,i)++{- | Class of immutable array types.++An array type has the form @(a i e)@ where @a@ is the array type+constructor (kind @* -> * -> *@), @i@ is the index type (a member of+the class 'Ix'), and @e@ is the element type.  The @IArray@ class is+parameterised over both @a@ and @e@, so that instances specialised to+certain element types can be defined.+-}+class HasBounds a => IArray a e where+    unsafeArray      :: Ix i => (i,i) -> [(Int, e)] -> a i e+    unsafeAt         :: Ix i => a i e -> Int -> e+    unsafeReplace    :: Ix i => a i e -> [(Int, e)] -> a i e+    unsafeAccum      :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e+    unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e++-----------------------------------------------------------------------------+-- Algorithms on immutable arrays++{-# INLINE array #-}+{-|+Constructs an immutable array from a pair of bounds and a list of+initial associations.++The bounds are specified as a pair of the lowest and highest bounds in+the array respectively.  For example, a one-origin vector of length 10+has bounds (1,10), and a one-origin 10 by 10 matrix has bounds+((1,1),(10,10)).++An association is a pair of the form @(i,x)@, which defines the value of+the array at index @i@ to be @x@.  The array is undefined if any index+in the list is out of bounds.  If any two associations in the list have+the same index, the value at that index is implementation-dependent.+(In GHC, the last value specified for that index is used.+Other implementations will also do this for unboxed arrays, but Haskell+98 requires that for 'Array' the value at such indices is bottom.)++Because the indices must be checked for these errors, 'array' is+strict in the bounds argument and in the indices of the association+list.  Whether @array@ is strict or non-strict in the elements depends+on the array type: 'Data.Array.Array' is a non-strict array type, but+all of the 'Data.Array.Unboxed.UArray' arrays are strict.  Thus in a+non-strict array, recurrences such as the following are possible:++> a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]])++Not every index within the bounds of the array need appear in the+association list, but the values associated with indices that do not+appear will be undefined.++If, in any dimension, the lower bound is greater than the upper bound,+then the array is legal, but empty. Indexing an empty array always+gives an array-bounds error, but 'bounds' still yields the bounds with+which the array was constructed.+-}+array   :: (IArray a e, Ix i)+        => (i,i)        -- ^ bounds of the array: (lowest,highest)+        -> [(i, e)]     -- ^ list of associations+        -> a i e+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]++-- Since unsafeFreeze is not guaranteed to be only a cast, we will+-- use unsafeArray and zip instead of a specialized loop to implement+-- listArray, unlike Array.listArray, even though it generates some+-- unnecessary heap allocation. Will use the loop only when we have+-- fast unsafeFreeze, namely for Array and UArray (well, they cover+-- almost all cases).++{-# INLINE listArray #-}+-- | Constructs an immutable array from a list of initial elements.+-- The list gives the elements of the array in ascending order+-- beginning with the lowest index.+listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e+listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)++{-# INLINE (!) #-}+-- | Returns the element of an immutable array at the specified index.+(!) :: (IArray a e, Ix i) => a i e -> i -> e+arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i)++{-# INLINE indices #-}+-- | Returns a list of all the valid indices in an array.+indices :: (HasBounds a, Ix i) => a i e -> [i]+indices arr = case bounds arr of (l,u) -> range (l,u)++{-# INLINE elems #-}+-- | Returns a list of all the elements of an array, in the same order+-- as their indices.+elems :: (IArray a e, Ix i) => a i e -> [e]+elems arr = case bounds arr of+    (l,u) -> [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]++{-# INLINE assocs #-}+-- | Returns the contents of an array as a list of associations.+assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]+assocs arr = case bounds arr of+    (l,u) -> [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]++{-# INLINE accumArray #-}+{-|+Constructs an immutable array from a list of associations.  Unlike+'array', the same index is allowed to occur multiple times in the list+of associations; an /accumulating function/ is used to combine the+values of elements with the same index.++For example, given a list of values of some index type, hist produces+a histogram of the number of occurrences of each index within a+specified range:++> hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+> hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i]+-}+accumArray :: (IArray a e, Ix i)+        => (e -> e' -> e)       -- ^ An accumulating function+        -> e                    -- ^ A default element+        -> (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]++{-# INLINE (//) #-}+{-|+Takes an array and a list of pairs and returns an array identical to+the left argument except that it has been updated by the associations+in the right argument.  For example, if m is a 1-origin, n by n matrix,+then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with+the diagonal zeroed.++As with the 'array' function, if any two associations in the list have+the same index, the value at that index is implementation-dependent.+(In GHC, the last value specified for that index is used.+Other implementations will also do this for unboxed arrays, but Haskell+98 requires that for 'Array' the value at such indices is bottom.)++For most array types, this operation is O(/n/) where /n/ is the size+of the array.  However, the 'Data.Array.Diff.DiffArray' type provides+this operation with complexity linear in the number of updates.+-}+(//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e+arr // ies = case bounds arr of+    (l,u) -> unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE accum #-}+{-|+@accum f@ takes an array and an association list and accumulates pairs+from the list into the array with the accumulating function @f@. Thus+'accumArray' can be defined using 'accum':++> accumArray f z b = accum f (array b [(i, z) | i \<- range b])+-}+accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e+accum f arr ies = case bounds arr of+    (l,u) -> unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE amap #-}+-- | Returns a new array derived from the original array by applying a+-- function to each of the elements.+amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e+amap f arr = case bounds arr of+    (l,u) -> unsafeArray (l,u) [(i, f (unsafeAt arr i))+                               | i <- [0 .. rangeSize (l,u) - 1]]+{-# INLINE ixmap #-}+-- | Returns a new array derived from the original array by applying a+-- function to each of the indices.+ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e+ixmap (l,u) f arr =+    unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]++-----------------------------------------------------------------------------+-- Implementation of Show instance++{-# SPECIALISE+    showsIArray :: (IArray a e, Ix i, Show i, Show e) =>+                   Int -> a i e -> ShowS+  #-}++showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS+showsIArray p a =+    showParen (p > 9) $+    showString "array " .+    shows (bounds a) .+    showChar ' ' .+    shows (assocs a)++-----------------------------------------------------------------------------+-- Implementation of Eq/Ord instances++{-# INLINE eqIArray #-}+eqIArray :: (IArray a e, Ix i, Eq e) => a i e -> a i e -> Bool+eqIArray arr1 arr2 =+    case bounds arr1 of { (l1,u1) ->+    case bounds arr2 of { (l2,u2) ->+    if rangeSize (l1,u1) == 0+      then rangeSize (l2,u2) == 0+      else l1 == l2 && u1 == u2 &&+           and [ unsafeAt arr1 i == unsafeAt arr2 i+               | i <- [0 .. rangeSize (l1,u1) - 1]]}}++{-# INLINE cmpIArray #-}+cmpIArray :: (IArray a e, Ix i, Ord e) => a i e -> a i e -> Ordering+cmpIArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntIArray #-}+cmpIntIArray :: (IArray a e, Ord e) => a Int e -> a Int e -> Ordering+cmpIntIArray arr1 arr2 =+    case bounds arr1 of { (l1,u1) ->+    case bounds arr2 of { (l2,u2) ->+    if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else+    if rangeSize (l2,u2) == 0 then GT else+    case compare l1 l2 of+        EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]+        other -> other } }+    where+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+        EQ    -> rest+        other -> other++{-# RULES "cmpIArray/Int" cmpIArray = cmpIntIArray #-}+

@@ -0,0 +1,276 @@+{-# LANGUAGE CPP, MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Internals.MArray+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Mutable arrays: class and general algorithms+Freeze/Thaw: mutable<->immutable arrays conversion++-}++module Data.ArrayBZ.Internals.MArray where++import Control.Monad.ST         ( ST, runST )+import Data.Ix+#ifdef __GLASGOW_HASKELL__+import GHC.Arr                  ( unsafeIndex )+#endif+#ifdef __HUGS__+import Hugs.Array               ( unsafeIndex )+#endif++import Data.ArrayBZ.Internals.IArray++-----------------------------------------------------------------------------+-- Mutable arrays++-- | Value used to initialize undefined array elements+{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "MArray: undefined array element"++-- | Class of array types with mutable bounds+class (Monad m) => HasMutableBounds a m where+    -- | Get the current bounds of an array+    getBounds :: Ix i => a i e -> m (i,i)++{-| Class of mutable array types.++An array type has the form @(a i e)@ where @a@ is the array type+constructor (kind @* -> * -> *@), @i@ is the index type (a member of+the class 'Ix'), and @e@ is the element type.++The @MArray@ class is parameterised over both @a@ and @e@ (so that+instances specialised to certain element types can be defined, in the+same way as for 'IArray'), and also over the type of the monad, @m@,+in which the mutable array will be manipulated.+-}+class (Monad m, HasMutableBounds a m) => MArray a e m where++    -- | Builds a new array, with every element initialised to the supplied+    -- value.+    newArray    :: Ix i => (i,i) -> e -> m (a i e)++    -- | Builds a new array, with every element initialised to undefined.+    newArray_   :: Ix i => (i,i) -> m (a i e)++    unsafeRead  :: Ix i => a i e -> Int -> m e+    unsafeWrite :: Ix i => a i e -> Int -> e -> m ()++    readArray   :: Ix i => a i e -> i -> m e+    writeArray  :: Ix i => a i e -> i -> e -> m ()++    {-# INLINE newArray #-}+        -- 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+        marr <- newArray_ (l,u)+        sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]+        return marr++    newArray_ (l,u) = newArray (l,u) arrEleBottom++    -- newArray takes an initialiser which all elements of+    -- the newly created array are initialised to.  newArray_ takes+    -- no initialiser, it is assumed that the array is initialised with+    -- "undefined" values.++    -- why not omit newArray_?  Because in the unboxed array case we would+    -- like to omit the initialisation altogether if possible.  We can't do+    -- this for boxed arrays, because the elements must all have valid values+    -- at all times in case of garbage collection.++    -- why not omit newArray?  Because in the boxed case, we can omit the+    -- default initialisation with undefined values if we *do* know the+    -- initial value and it is constant for all elements.++    {-# INLINE readArray #-}+    -- | Read an element from a mutable array+    readArray marr i = do+        (l,u) <- getBounds marr+        unsafeRead marr (index (l,u) i)++    {-# INLINE writeArray #-}+    -- | Write an element in a mutable array+    writeArray marr i e = do+        (l,u) <- getBounds marr+        unsafeWrite marr (index (l,u) i) e+++-----------------------------------------------------------------------------+-- Algorithms on mutable arrays++{-# INLINE newListArray #-}+-- | Constructs a mutable array from a list of initial elements.+-- The list gives the elements of the array in ascending order+-- beginning with the lowest index.+newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)+newListArray (l,u) es = do+    marr <- newArray_ (l,u)+    let n = rangeSize (l,u)+    let fillFromList i xs | i == n    = return ()+                          | otherwise = case xs of+            []   -> return ()+            y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+    fillFromList 0 es+    return marr++{-# INLINE getIndices #-}+-- | Return a list of all the indexes of a mutable array+getIndices :: (MArray a e m, Ix i) => a i e -> m [i]+getIndices marr = do+    (l,u) <- getBounds marr+    return (range (l,u))++{-# INLINE getElems #-}+-- | Return a list of all the elements of a mutable array+getElems :: (MArray a e m, Ix i) => a i e -> m [e]+getElems marr = do+    (l,u) <- getBounds marr+    sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]++{-# INLINE getAssocs #-}+-- | Return a list of all the associations of a mutable array, in+-- index order.+getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]+getAssocs marr = do+    (l,u) <- getBounds marr+    sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e)+             | i <- range (l,u)]++{-# INLINE mapArray #-}+-- | Constructs a new array derived from the original array by applying a+-- function to each of the elements.+mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)+mapArray f marr = do+    (l,u) <- getBounds marr+    marr' <- newArray_ (l,u)+    sequence_ [do+        e <- unsafeRead marr i+        unsafeWrite marr' i (f e)+        | i <- [0 .. rangeSize (l,u) - 1]]+    return marr'++{-# INLINE mapIndices #-}+-- | Constructs a new array derived from the original array by applying a+-- function to each of the indices.+mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)+mapIndices (l,u) f marr = do+    marr' <- newArray_ (l,u)+    sequence_ [do+        e <- readArray marr (f i)+        unsafeWrite marr' (unsafeIndex (l,u) i) e+        | i <- range (l,u)]+    return marr'++-----------------------------------------------------------------------------+-- Freezing++-- | Converts a mutable array (any instance of 'MArray') to an+-- immutable array (any instance of 'IArray') by taking a complete+-- copy of it.+freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+freeze marr = do+    (l,u) <- getBounds marr+    ies <- sequence [do e <- unsafeRead marr i; return (i,e)+                     | i <- [0 .. rangeSize (l,u) - 1]]+    return (unsafeArray (l,u) ies)++-- In-place conversion of mutable arrays to immutable ones places+-- a proof obligation on the user: no other parts of your code can+-- have a reference to the array at the point where you unsafely+-- freeze it (and, subsequently mutate it, I suspect).++{- |+   Converts an mutable array into an immutable array.  The+   implementation may either simply cast the array from+   one type to the other without copying the array, or it+   may take a full copy of the array.++   Note that because the array is possibly not copied, any subsequent+   modifications made to the mutable version of the array may be+   shared with the immutable version.  It is safe to use, therefore, if+   the mutable version is never modified after the freeze operation.++   The non-copying implementation is supported between certain pairs+   of array types only; one constraint is that the array types must+   have identical representations.  In GHC, The following pairs of+   array types have a non-copying O(1) implementation of+   'unsafeFreeze'.  Because the optimised versions are enabled by+   specialisations, you will need to compile with optimisation (-O) to+   get them.++     * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'++     * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'++     * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'++     * 'Data.Array.ST.STArray' -> 'Data.Array.Array'+-}+{-# INLINE unsafeFreeze #-}+unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+unsafeFreeze = freeze++-----------------------------------------------------------------------------+-- Thawing++-- | Converts an immutable array (any instance of 'IArray') into a+-- mutable array (any instance of 'MArray') by taking a complete copy+-- of it.+thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+thaw arr = case bounds arr of+  (l,u) -> do+    marr <- newArray_ (l,u)+    sequence_ [unsafeWrite marr i (unsafeAt arr i)+               | i <- [0 .. rangeSize (l,u) - 1]]+    return marr++-- In-place conversion of immutable arrays to mutable ones places+-- a proof obligation on the user: no other parts of your code can+-- have a reference to the array at the point where you unsafely+-- thaw it (and, subsequently mutate it, I suspect).++{- |+   Converts an immutable array into a mutable array.  The+   implementation may either simply cast the array from+   one type to the other without copying the array, or it+   may take a full copy of the array.++   Note that because the array is possibly not copied, any subsequent+   modifications made to the mutable version of the array may be+   shared with the immutable version.  It is only safe to use,+   therefore, if the immutable array is never referenced again in this+   thread, and there is no possibility that it can be also referenced+   in another thread.  If you use an unsafeThaw/write/unsafeFreeze+   sequence in a multi-threaded setting, then you must ensure that+   this sequence is atomic with respect to other threads, or a garbage+   collector crash may result (because the write may be writing to a+   frozen array).++   The non-copying implementation is supported between certain pairs+   of array types only; one constraint is that the array types must+   have identical representations.  In GHC, The following pairs of+   array types have a non-copying O(1) implementation of+   'unsafeThaw'.  Because the optimised versions are enabled by+   specialisations, you will need to compile with optimisation (-O) to+   get them.++     * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'++     * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'++     * 'Data.Array.Array'  -> 'Data.Array.IO.IOArray'++     * 'Data.Array.Array'  -> 'Data.Array.ST.STArray'+-}+{-# INLINE unsafeThaw #-}+unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+unsafeThaw = thaw+

@@ -0,0 +1,247 @@+{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances,+  MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Internals.Unboxed+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Unboxed arrays++Based on the idea of Oleg Kiselyov+  (see http://www.haskell.org/pipermail/haskell-cafe/2004-July/006400.html)+-}++module Data.ArrayBZ.Internals.Unboxed where++import Control.Monad.ST         (ST, runST)+import Control.Monad.ST.Lazy    ( strictToLazyST )+import qualified Control.Monad.ST.Lazy as Lazy (ST)+import Data.Ix+import Data.Typeable+#include "Typeable.h"++import Control.Monad.STorIO+import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray+import Data.HasDefaultValue+import Data.Unboxed++-- ---------------------------------------------------------------------------+-- | Unboxed mutable arrays++data UnboxedMutableArray s i e  =  UMA !i !i !(MUVec s e)++instance HasBounds (UnboxedMutableArray s) where+    {-# INLINE bounds #-}+    bounds (UMA l u _) = (l,u)++instance (STorIO m s) => HasMutableBounds (UnboxedMutableArray s) m where+    {-# INLINE getBounds #-}+    getBounds (UMA l u _) = return (l,u)++instance (STorIO m s, Unboxed e) => MArray (UnboxedMutableArray s) e m where+    newArray_ (l,u) = do arr <- allocUnboxed (rangeSize (l,u))+                         return (UMA l u arr)+    {-# INLINE unsafeRead #-}+    unsafeRead  (UMA _ _ arr) index  =  readUnboxed  arr index+    {-# INLINE unsafeWrite #-}+    unsafeWrite (UMA _ _ arr) index  =  writeUnboxed arr index++-- ---------------------------------------------------------------------------+-- | Unboxed mutable arrays in ST monad++type STUArray = UnboxedMutableArray++INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")++-- ---------------------------------------------------------------------------+-- STUArray also works in Lazy ST monad++instance (Unboxed e) => MArray (STUArray s) e (Lazy.ST s) where+    {-# INLINE newArray_ #-}+    newArray_   (l,u)   = strictToLazyST (newArray_ (l,u))+    {-# INLINE unsafeRead #-}+    unsafeRead  arr i   = strictToLazyST (unsafeRead  arr i)+    {-# INLINE unsafeWrite #-}+    unsafeWrite arr i e = strictToLazyST (unsafeWrite arr i e)++-- ---------------------------------------------------------------------------+-- | Unboxed mutable arrays in IO monad++type IOUArray = IOSpecific3 UnboxedMutableArray++INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")++-- ---------------------------------------------------------------------------+-- | Unboxed arrays++data UArray i e  =  UA !i !i !(UVec e)++INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")++instance HasBounds UArray where+    {-# INLINE bounds #-}+    bounds (UA l u _) = (l,u)++instance (Unboxed e, HasDefaultValue e) => IArray UArray e where+    {-# INLINE unsafeArray #-}+    -- 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+    {-# 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))+    {-# INLINE unsafeAccumArray #-}+    -- Create new array accumulating (i,e) values+    unsafeAccumArray f init lu ies = runST (withNewArray lu init (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+    action marr+    unsafeFreezeUA marr++-- Make a copy of array and perform given action on it before freezing+withArrayCopy arr action = do+    marr <- thawUA arr+    action marr+    unsafeFreezeUA marr++-- Perform (i,e) replaces in mutable array+doReplace ies marr = do+    sequence_ [unsafeWrite marr i e | (i, e) <- ies]++-- Accumulate (i,e) values in mutable array+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 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 ua@(UA l u arr) = do+    marr <- thawUnboxed arr (sizeOfUA ua)+    return (UMA l u marr)++-- On-the-place mutable->immutable array conversion+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+    marr <- unsafeThawUnboxed arr+    return (UMA l u marr)++-- | Array size in bytes+sizeOfUA :: forall i e. (Ix i, Unboxed e) => UArray i e -> Int+sizeOfUA  arr =+     rangeSize (bounds arr) * sizeOfUnboxed (undefined :: e)++sizeOfUMA :: forall i e s. (Ix i, Unboxed e) => UnboxedMutableArray s i e -> Int+sizeOfUMA marr =+    rangeSize (bounds marr) * sizeOfUnboxed (undefined :: e)++-- ---------------------------------------------------------------------------+-- | Freeze/thaw rules for IOUArray++freezeIOUArray       :: (Unboxed e, HasDefaultValue e, Ix i) => IOUArray i e -> IO (UArray i e)+thawIOUArray         :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> IO (IOUArray i e)+unsafeFreezeIOUArray :: (Unboxed e, HasDefaultValue e, Ix i) => IOUArray i e -> IO (UArray i e)+unsafeThawIOUArray   :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> IO (IOUArray i e)++freezeIOUArray       = freezeUA+thawIOUArray         = thawUA+unsafeFreezeIOUArray = unsafeFreezeUA+unsafeThawIOUArray   = unsafeThawUA++{-# RULES+"freeze/IOUArray" forall (x :: (forall s e i . (Unboxed e, HasDefaultValue e) => IOUArray i e)) . freeze x = freezeIOUArray x+"thaw/IOUArray"   forall (x :: (forall   e i . (Unboxed e, HasDefaultValue e) =>   UArray i e)) . thaw   x = thawIOUArray   x+"unsafeFreeze/IOUArray" forall (x :: (forall s e i . (Unboxed e, HasDefaultValue e) => IOUArray i e)) . unsafeFreeze x = unsafeFreezeIOUArray x+"unsafeThaw/IOUArray"   forall (x :: (forall   e i . (Unboxed e, HasDefaultValue e) =>   UArray i e)) . unsafeThaw   x = unsafeThawIOUArray   x+    #-}++-- ---------------------------------------------------------------------------+-- | Freeze/thaw rules for STUArray++freezeSTUArray       :: (Unboxed e, HasDefaultValue e, Ix i) => STUArray s i e -> ST s (UArray i e)+thawSTUArray         :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> ST s (STUArray s i e)+unsafeFreezeSTUArray :: (Unboxed e, HasDefaultValue e, Ix i) => STUArray s i e -> ST s (UArray i e)+unsafeThawSTUArray   :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> ST s (STUArray s i e)++freezeSTUArray       = freezeUA+thawSTUArray         = thawUA+unsafeFreezeSTUArray = unsafeFreezeUA+unsafeThawSTUArray   = unsafeThawUA++{-# RULES+"freeze/STUArray" forall (x :: (forall s e i . (Unboxed e, HasDefaultValue e) => STUArray s i e)) . freeze x = freezeSTUArray x+"thaw/STUArray"   forall (x :: (forall   e i . (Unboxed e, HasDefaultValue e) =>   UArray   i e)) . thaw   x = thawSTUArray   x+"unsafeFreeze/STUArray" forall (x :: (forall s e i . (Unboxed e, HasDefaultValue e) => STUArray s i e)) . unsafeFreeze x = unsafeFreezeSTUArray x+"unsafeThaw/STUArray"   forall (x :: (forall   e i . (Unboxed e, HasDefaultValue e) =>   UArray   i e)) . unsafeThaw   x = unsafeThawSTUArray   x+    #-}++-- ---------------------------------------------------------------------------+-- | Casts to arrays with different element type++-- | Casts an 'UArray' with one element type into 'UArray' with a+-- different element type. All the elements of the resulting array+-- are undefined (unless you know what you\'re doing...).+-- Upper array bound is recalculated according to elements size,+-- for example UArray (1,2) Word32 -> UArray (1,8) Word8+castUArray :: forall i e e'. (Ix i, Enum i, Unboxed e, Unboxed e')+           => UArray i e -> UArray i e'+castUArray (UA l u vec) =+    (UA l u' (castUnboxed vec))+        where u' = toEnum (fromEnum l - 1 + newSize)+              newSize = rangeSize (l,u)   *   sizeOfUnboxed (undefined::e)+                                        `div` sizeOfUnboxed (undefined::e')++-- | Casts an 'IOUArray' with one element type into 'IOUArray' with a different+-- element type (upper bound is recalculated).+castIOUArray :: forall i e e'. (Ix i, Enum i, Unboxed e, Unboxed e')+             => IOUArray i e -> IOUArray i e'+castIOUArray (UMA l u mvec) =+    (UMA l u' (castMUnboxed mvec))+        where u' = toEnum (fromEnum l - 1 + newSize)+              newSize = rangeSize (l,u)   *   sizeOfUnboxed (undefined::e)+                                        `div` sizeOfUnboxed (undefined::e')++-- | Casts an 'STUArray' with one element type into 'STUArray' with a different+-- element type (upper bound is recalculated).+castSTUArray :: forall i e e' s. (Ix i, Enum i, Unboxed e, Unboxed e')+             => STUArray s i e -> STUArray s i e'+castSTUArray (UMA l u mvec) =+    (UMA l u' (castMUnboxed mvec))+        where u' = toEnum (fromEnum l - 1 + newSize)+              newSize = rangeSize (l,u)   *   sizeOfUnboxed (undefined::e)+                                        `div` sizeOfUnboxed (undefined::e')++-- ---------------------------------------------------------------------------+-- | Instances++instance (Ix i, Show i, Show e, Unboxed e, HasDefaultValue e) => Show (UArray i e) where+    showsPrec = showsIArray++instance (Ix i, Eq i, Eq e, Unboxed e, HasDefaultValue e) => Eq (UArray i e) where+    (==) = eqIArray++instance (Ix i, Ord i, Ord e, Unboxed e, HasDefaultValue e) => Ord (UArray i e) where+    compare = cmpIArray+

@@ -0,0 +1,21 @@+Module hierarchy:++Module Data.ArrayBZ.Internals.MArray defines class MArray and general algorithms+working with any instance of this class++Module Data.ArrayBZ.Internals.IArray defines class IArray and general algorithms+working with any instance of this class. In addition, it defines functions+used to implement Show, Eq and Ord instances (these instances cannot be+defined here due to the "overlapped instances" problem)++Module Data.ArrayBZ.Internals.Boxed imports modules IArray and MArray, and then+defines Array/IOArray/STArray. Module Data.ArrayBZ.Internals.Unboxed also imports+modules IArray and MArray, and then defines UArray/IOUArray/STUArray++Modules Data.ArrayBZ.Boxed and Data.ArrayBZ.Unboxed reexports corresponding+internal modules together with IArray and MArray modules, what gives their users+ability to use all boxed (unboxed) arrays together with all general algorithms+defined for IArray and MArray classes++Also, file unused.hs contains parts of original code that's still not used in+new one

@@ -0,0 +1,137 @@++This file contains remaining code from old Data.Array.* library that is still+unused in new code. It mainly consists of speed tricks (that may be even not+needed in new code).++------------------------------------------------------------------------------------------+class HasBounds a => IArray a e where+    unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)+    unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)+    unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)++{-# INLINE unsafeReplaceST #-}+unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)+unsafeReplaceST arr ies = do+    marr <- thaw arr+    sequence_ [unsafeWrite marr i e | (i, e) <- ies]+    return marr++{-# INLINE unsafeAccumST #-}+unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)+unsafeAccumST f arr ies = do+    marr <- thaw arr+    sequence_ [do+        old <- unsafeRead marr i+        unsafeWrite marr i (f old new)+        | (i, new) <- ies]+    return marr++{-# INLINE unsafeAccumArrayST #-}+unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)+unsafeAccumArrayST f e (l,u) ies = do+    marr <- newArray (l,u) e+    sequence_ [do+        old <- unsafeRead marr i+        unsafeWrite marr i (f old new)+        | (i, new) <- ies]+    return marr++------------------------------------------------------------------------------------------+{-# INLINE listArrayST #-}+listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)+listArrayST (l,u) es = do+    marr <- newArray_ (l,u)+    let n = rangeSize (l,u)+    let fillFromList i xs | i == n    = return ()+                          | otherwise = case xs of+            []   -> return ()+            y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+    fillFromList 0 es+    return marr++{-# RULES+"listArray/Array" listArray =+    \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)+    #-}++{-# INLINE listUArrayST #-}+listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)+             => (i,i) -> [e] -> ST s (STUArray s i e)+listUArrayST (l,u) es = do+    marr <- newArray_ (l,u)+    let n = rangeSize (l,u)+    let fillFromList i xs | i == n    = return ()+                          | otherwise = case xs of+            []   -> return ()+            y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+    fillFromList 0 es+    return marr++-- I don't know how to write a single rule for listUArrayST, because+-- the type looks like constrained over 's', which runST doesn't+-- like. In fact all MArray (STUArray s) instances are polymorphic+-- wrt. 's', but runST can't know that.+--+-- More precisely, we'd like to write this:+--   listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i)+--              => (i,i) -> [e] -> UArray i e+--   listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray)+--   {-# RULES listArray = listUArray+-- Then we could call listUArray at any type 'e' that had a suitable+-- MArray instance.  But sadly we can't, because we don't have quantified+-- constraints.  Hence the mass of rules below.++-- I would like also to write a rule for listUArrayST (or listArray or+-- whatever) applied to unpackCString#. Unfortunately unpackCString#+-- calls seem to be floated out, then floated back into the middle+-- of listUArrayST, so I was not able to do this.++#ifdef __GLASGOW_HASKELL__+type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e++{-# RULES+"listArray/UArray/Bool"      listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool+"listArray/UArray/Char"      listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char+"listArray/UArray/Int"       listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int+"listArray/UArray/Word"      listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word+"listArray/UArray/Ptr"       listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)+"listArray/UArray/FunPtr"    listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)+"listArray/UArray/Float"     listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float+"listArray/UArray/Double"    listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double+"listArray/UArray/StablePtr" listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)+"listArray/UArray/Int8"      listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8+"listArray/UArray/Int16"     listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16+"listArray/UArray/Int32"     listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32+"listArray/UArray/Int64"     listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64+"listArray/UArray/Word8"     listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8+"listArray/UArray/Word16"    listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16+"listArray/UArray/Word32"    listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32+"listArray/UArray/Word64"    listArray+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64+    #-}+#endif++------------------------------------------------------------------------------------------+instance MArray (STArray s) e (Lazy.ST s) where+    {-# INLINE newArray #-}+    newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)+    {-# INLINE unsafeRead #-}+    unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)+    {-# INLINE unsafeWrite #-}+    unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)

@@ -0,0 +1,61 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Data.ArrayBZ.MArray+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++An overloaded interface to mutable arrays.  For array types which can be+used with this interface, see "Data.ArrayBZ.IO", "Data.ArrayBZ.ST",+and "Data.ArrayBZ.Storable".++-}++module Data.ArrayBZ.MArray (+    -- * Class of mutable array types+    MArray,       -- :: (* -> * -> *) -> * -> (* -> *) -> class++    -- * Class of array types with bounds+    HasBounds,    -- :: (* -> * -> *) -> class++    -- * Class of array types with mutable bounds+    HasMutableBounds,    -- :: (* -> * -> *) -> (* -> *) -> class++    -- * The @Ix@ class and operations+    module Data.Ix,++    -- * Constructing mutable arrays+    newArray,     -- :: (MArray a e m, Ix i) => (i,i) -> e -> m (a i e)+    newArray_,    -- :: (MArray a e m, Ix i) => (i,i) -> m (a i e)+    newListArray, -- :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)++    -- * Reading and writing mutable arrays+    readArray,    -- :: (MArray a e m, Ix i) => a i e -> i -> m e+    writeArray,   -- :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()++    -- * Derived arrays+    mapArray,     -- :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)+    mapIndices,   -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)++    -- * Deconstructing mutable arrays+    bounds,       -- :: (HasBounds a, Ix i) => a i e -> (i,i)+    indices,      -- :: (HasBounds a, Ix i) => a i e -> [i]+    getBounds,    -- :: (HasMutableBounds a, Ix i) => a i e -> m (i,i)+    getIndices,   -- :: (HasMutableBounds a, Ix i) => a i e -> m [i]+    getElems,     -- :: (MArray a e m, Ix i) => a i e -> m [e]+    getAssocs,    -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)]++    -- * Conversions between mutable and immutable arrays+    freeze,       -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+    unsafeFreeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+    thaw,         -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+    unsafeThaw,   -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+  ) where++import Data.Ix++import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray

@@ -0,0 +1,56 @@+{-# LANGUAGE RankNTypes, TypeOperators #-}+{- |+   Module     : Data.ArrayBZ.ST+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad.++-}++module Data.ArrayBZ.ST (++   -- * Boxed arrays+   STArray,             -- instance of: Eq, MArray+   runSTArray,++   -- * Unboxed arrays+   STUArray,            -- instance of: Eq, MArray+   runSTUArray,+   castSTUArray,        -- :: STUArray s i a -> ST s (STUArray s i b)++   -- * Overloaded mutable array interface+   module Data.ArrayBZ.MArray,+ ) where++import Control.Monad.ST ( ST, runST )++import Data.HasDefaultValue+import Data.Unboxed+import Data.ArrayBZ.MArray+import Data.ArrayBZ.Internals.Boxed+import Data.ArrayBZ.Internals.Unboxed++-- | A safe way to create and work with a mutable array before returning an+-- immutable array for later perusal.  This function avoids copying+-- the array before returning it - it uses 'unsafeFreeze' internally, but+-- this wrapper is a safe interface to that function.+runSTArray :: (Ix i)+           => (forall s . ST s (STArray s i e))+           -> Array i e+runSTArray st = runST (st >>= unsafeFreezeSTArray)++-- | A safe way to create and work with an unboxed mutable array before+-- returning an immutable array for later perusal.  This function+-- avoids copying the array before returning it - it uses+-- 'unsafeFreeze' internally, but this wrapper is a safe interface to+-- that function.+runSTUArray :: (Unboxed e, HasDefaultValue e, Ix i)+           => (forall s . ST s (STUArray s i e))+           -> UArray i e+runSTUArray st = runST (st >>= unsafeFreezeSTUArray)+

@@ -0,0 +1,106 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{- |+   Module     : Data.ArrayBZ.Storable+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++A storable array is an IO-mutable array which stores its+contents in a contiguous memory block living in the C+heap. Elements are stored according to the class 'Storable'.+You can obtain the pointer to the array contents to manipulate+elements from languages like C.++It is similar to 'Data.ArrayBZ.IO.IOUArray' but slower.+Its advantage is that it's compatible with C.++-}++module Data.ArrayBZ.Storable (++    -- * Arrays of 'Storable' things.+    StorableArray, -- data StorableArray index element+                   --     -- index type must be in class Ix+                   --     -- element type must be in class Storable++    -- * Overloaded mutable array interface+    -- | Module "Data.ArrayBZ.Internals.MArray" provides the interface of storable arrays.+    -- They are instances of class 'MArray' (with the 'IO' monad).+    module Data.ArrayBZ.Internals.MArray,++    -- * Accessing the pointer to the array contents+    withStorableArray,  -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a++    touchStorableArray, -- :: StorableArray i e -> IO ()++    -- * Casting ForeignPtr to StorableArray+    unsafeForeignPtrToStorableArray+    )+    where++import Data.Ix+import Foreign hiding (newArray)++import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray++-- ---------------------------------------------------------------------------++-- |The array type+data StorableArray i e = StorableArray !i !i !(ForeignPtr e)++instance HasBounds StorableArray where+    {-# INLINE bounds #-}+    bounds (StorableArray l u _) = (l,u)++instance HasMutableBounds StorableArray IO where+    {-# INLINE getBounds #-}+    getBounds (StorableArray l u _) = return (l,u)++instance Storable e => MArray StorableArray e IO where+    {-# INLINE newArray #-}+    newArray (l,u) init = do+        fp <- mallocForeignPtrArray size+        withForeignPtr fp $ \a ->+            sequence_ [pokeElemOff a i init | i <- [0..size-1]]+        return (StorableArray l u fp)+        where+        size = rangeSize (l,u)++    newArray_ (l,u) = do+        fp <- mallocForeignPtrArray (rangeSize (l,u))+        return (StorableArray l u fp)++    {-# INLINE unsafeRead #-}+    unsafeRead (StorableArray _ _ fp) i =+        withForeignPtr fp $ \a -> peekElemOff a i++    {-# INLINE unsafeWrite #-}+    unsafeWrite (StorableArray _ _ fp) i e =+        withForeignPtr fp $ \a -> pokeElemOff a i e+++{-# INLINE withStorableArray #-}+-- |The pointer to the array contents is obtained by 'withStorableArray'.+-- The idea is similar to 'ForeignPtr' (used internally here).+-- The pointer should be used only during execution of the 'IO' action+-- retured by the function passed as argument to 'withStorableArray'.+withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a+withStorableArray (StorableArray _ _ fp) f = withForeignPtr fp f++-- |If you want to use it afterwards, ensure that you+-- 'touchStorableArray' after the last use of the pointer,+-- so the array is not freed too early.+touchStorableArray :: StorableArray i e -> IO ()+touchStorableArray (StorableArray _ _ fp) = touchForeignPtr fp++-- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'.  It is+-- the caller's responsibility to ensure that the 'ForeignPtr' points to+-- an area of memory sufficient for the specified bounds.+unsafeForeignPtrToStorableArray+   :: ForeignPtr e -> (i,i) -> IO (StorableArray i e)+unsafeForeignPtrToStorableArray p (l,u) =+   return (StorableArray l u p)

@@ -0,0 +1,27 @@+{- |+   Module     : Data.ArrayBZ.Unboxed+   Copyright  : (c) The University of Glasgow 2001 & (c) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Unboxed arrays++-}++module Data.ArrayBZ.Unboxed (+           UArray,+           IOUArray,+           STUArray,+           castUArray,+           castIOUArray,+           castSTUArray,+           module Data.ArrayBZ.Internals.IArray,+           module Data.ArrayBZ.Internals.MArray,+  ) where++import Data.ArrayBZ.Internals.Unboxed+import Data.ArrayBZ.Internals.IArray+import Data.ArrayBZ.Internals.MArray

@@ -0,0 +1,51 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Data.HasDefaultValue+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: portable++Class 'HasDefaultValue' allows to declare type's default value++-}++module Data.HasDefaultValue (+           HasDefaultValue(..),+       )+where++import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr++-- ---------------------------------------------------------------------------+-- | Types that has default value++class HasDefaultValue a where+    defaultValue :: a++instance HasDefaultValue Bool          where defaultValue = False+instance HasDefaultValue Char          where defaultValue = '\0'+instance HasDefaultValue Int           where defaultValue = 0+instance HasDefaultValue Int8          where defaultValue = 0+instance HasDefaultValue Int16         where defaultValue = 0+instance HasDefaultValue Int32         where defaultValue = 0+instance HasDefaultValue Int64         where defaultValue = 0+#if !defined(__HUGS__) || defined(__HUGS_VERSION__)+-- don't define this for Hugs2003+instance HasDefaultValue Word          where defaultValue = 0+#endif+instance HasDefaultValue Word8         where defaultValue = 0+instance HasDefaultValue Word16        where defaultValue = 0+instance HasDefaultValue Word32        where defaultValue = 0+instance HasDefaultValue Word64        where defaultValue = 0+instance HasDefaultValue Float         where defaultValue = 0+instance HasDefaultValue Double        where defaultValue = 0+instance HasDefaultValue (Ptr a)       where defaultValue = nullPtr+instance HasDefaultValue (FunPtr a)    where defaultValue = nullFunPtr+instance HasDefaultValue (StablePtr a) where defaultValue = castPtrToStablePtr nullPtr+

@@ -0,0 +1,24 @@+{- |+   Module     : Data.Ref+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++References (mutable vars)++-}++module Data.Ref (+    module Data.IORef,+    module Data.STRef,+    module Data.Ref.Unboxed,+    module Data.Ref.Universal,+  ) where++import Data.IORef+import Data.STRef+import Data.Ref.Unboxed+import Data.Ref.Universal

@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Data.Ref.LazyST+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Mutable boxed and unboxed references in the lazy ST monad.++-}++module Data.Ref.LazyST (+        -- * STRefs+        STRef,          -- abstract, instance Eq+        newSTRef,       -- :: a -> ST s (STRef s a)+        readSTRef,      -- :: STRef s a -> ST s a+        writeSTRef,     -- :: STRef s a -> a -> ST s ()+        modifySTRef,    -- :: STRef s a -> (a -> a) -> ST s ()++        -- * STURefs+        ST.STURef,      -- abstract, instance Eq+        newSTURef,      -- :: a -> ST s (STURef s a)+        readSTURef,     -- :: STURef s a -> ST s a+        writeSTURef,    -- :: STURef s a -> a -> ST s ()+        modifySTURef    -- :: STURef s a -> (a -> a) -> ST s ()+ ) where++import Control.Monad.ST.Lazy+import Data.STRef.Lazy+import qualified Data.Ref.Unboxed as ST+import Data.Unboxed++newSTURef    :: (Unboxed a) => a -> ST s (ST.STURef s a)+readSTURef   :: (Unboxed a) => ST.STURef s a -> ST s a+writeSTURef  :: (Unboxed a) => ST.STURef s a -> a -> ST s ()+modifySTURef :: (Unboxed a) => ST.STURef s a -> (a -> a) -> ST s ()++newSTURef   = strictToLazyST . ST.newSTURef+readSTURef  = strictToLazyST . ST.readSTURef+writeSTURef r a = strictToLazyST (ST.writeSTURef r a)+modifySTURef r f = strictToLazyST (ST.modifySTURef r f)+

@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}+{- |+   Module     : Data.Ref.Unboxed+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC/Hugs++Unboxed references++Based on the idea of Oleg Kiselyov+  (see http://www.haskell.org/pipermail/haskell-cafe/2004-July/006400.html)+-}++module Data.Ref.Unboxed where++import Control.Monad.ST  (ST)+import Data.Typeable+#include "Typeable.h"++import Control.Monad.STorIO+import Data.Unboxed++-- -----------------------------------------------------------------------------+-- | Unboxed references in IO monad++newtype IOURef a = IOURef (IOSpecific2 MUVec a)++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)++-- | Read current value of unboxed reference in IO monad+{-# INLINE readIOURef #-}+readIOURef :: (Unboxed a) => IOURef a -> IO a+readIOURef (IOURef ref) = readUnboxed ref 0++-- | Change value of unboxed reference in IO monad+{-# INLINE writeIOURef #-}+writeIOURef :: (Unboxed a) => IOURef a -> a -> IO ()+writeIOURef (IOURef ref) = writeUnboxed ref 0++-- |Modify contents of an 'IOURef' by applying pure function to it+{-# INLINE modifyIOURef #-}+modifyIOURef :: (Unboxed a) => IOURef a -> (a -> a) -> IO ()+modifyIOURef ref f  =  readIOURef ref >>= writeIOURef ref . f++-- -----------------------------------------------------------------------------+-- | Unboxed references in ST monad++newtype STURef s a = STURef (MUVec s a)++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)++-- | 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++-- | 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++-- |Modify contents of an 'STURef' by applying pure function to it+{-# INLINE modifySTURef #-}+modifySTURef :: (Unboxed a) => STURef s a -> (a -> a) -> ST s ()+modifySTURef ref f  =  readSTURef ref >>= writeSTURef ref . f+

@@ -0,0 +1,91 @@+{-# LANGUAGE CPP, FunctionalDependencies, MultiParamTypeClasses #-}+{- |+   Module     : Data.Ref.Universal+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Monad-independent interfaces for boxed and unboxed references++-}++module Data.Ref.Universal (+           -- * Monad-independent interface for boxed references+           Ref(..),+           modifyRef,+           modifyRefM,+           -- * Monad-independent interface for unboxed references+           URef(..),+           modifyURef,+           modifyURefM,+       )+where++import Control.Monad.ST (ST)+import Data.IORef+import Data.STRef++import Data.Unboxed+import Data.Ref.Unboxed++-- -----------------------------------------------------------------------------+-- | This class allows to create new boxed reference in monad-independent way+--     (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+    newRef :: a -> m (r a)+    -- |Read the value of an 'Ref'+    readRef   :: r a -> m a+    -- |Write new value into an 'Ref'+    writeRef  :: r a -> a -> m ()++instance Ref IO IORef where+    newRef = newIORef+    readRef = readIORef+    writeRef = writeIORef+instance Ref (ST s) (STRef s) where+    newRef = newSTRef+    readRef = readSTRef+    writeRef = writeSTRef++-- |Modify the contents of an 'Ref' by applying pure function to it+{-# INLINE modifyRef #-}+modifyRef  ref f  =  readRef ref >>= writeRef ref . f++-- |Modify the contents of an 'Ref' by applying monadic computation to it+{-# INLINE modifyRefM #-}+modifyRefM ref f  =  readRef ref >>= f >>= writeRef ref++-- -----------------------------------------------------------------------------+-- | This class allows to create new unboxed reference in monad-independent way+--     (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+    newURef    :: (Unboxed a) => a -> m (r a)+    -- |Read the value of an 'URef'+    readURef   :: (Unboxed a) => r a -> m a+    -- |Write new value into an 'URef'+    writeURef  :: (Unboxed a) => r a -> a -> m ()++instance URef IO IOURef where+    newURef = newIOURef+    readURef = readIOURef+    writeURef = writeIOURef+instance URef (ST s) (STURef s) where+    newURef = newSTURef+    readURef = readSTURef+    writeURef = writeSTURef++-- |Modify the contents of an 'URef' by applying pure function to it+{-# INLINE modifyURef #-}+modifyURef  ref f  =  readURef ref >>= writeURef ref . f++-- |Modify the contents of an 'URef' by applying monadic computation to it+{-# INLINE modifyURefM #-}+modifyURefM ref f  =  readURef ref >>= f >>= writeURef ref+

@@ -0,0 +1,131 @@+{-# LANGUAGE CPP, FunctionalDependencies, FlexibleInstances, MultiParamTypeClasses #-}+{- |+   Module     : Data.SyntaxSugar+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Universal interface for reading and writing mutable data+  (references, array and hash elements)+Syntax sugar (=:, +=, val...) based on this interface++-}++module Data.SyntaxSugar where++import Control.Monad.ST (ST)+import Data.ArrayBZ.IO+import Data.ArrayBZ.ST+import Data.ArrayBZ.Storable+import Data.HashTable as Hash+import Data.Ref+import Data.Unboxed+import Foreign.Storable++-- -----------------------------------------------------------------------------+-- Universal interface for reading and writing mutable data+--   (references, array and hash elements)++class (Monad m) => Mutable m r a | r->a where+    -- |Read the value of an 'Mutable'+    readVar  :: r -> m a+    -- |Write new value into an 'Mutable'+    writeVar :: r -> a -> m ()++-- |Modify the contents of an 'Mutable' by applying pure function to it+{-# INLINE modifyVar #-}+modifyVar  var f  =  readVar var >>= writeVar var . f++-- |Modify the contents of an 'Mutable' by applying monadic computation to it+{-# INLINE modifyVarM #-}+modifyVarM var f  =  readVar var >>= f >>= writeVar var++-- -----------------------------------------------------------------------------+-- Implementation of `Mutable` interface for references++instance Mutable IO (IORef a) a where+    readVar  = readRef+    writeVar = writeRef+instance Mutable (ST s) (STRef s a) a where+    readVar  = readRef+    writeVar = writeRef+instance (Unboxed a) => Mutable IO (IOURef a) a where+    readVar  = readURef+    writeVar = writeURef+    {-# INLINE readVar  #-}+    {-# INLINE writeVar #-}+instance (Unboxed a) => Mutable (ST s) (STURef s a) a where+    readVar  = readURef+    writeVar = writeURef++-- -----------------------------------------------------------------------------+-- Implementation of `Mutable` interface for elements of MArray,+--   including simplified interfaces for 2-dimensional and 3-dimensional arrays++instance (Ix i) => Mutable IO (IOArray i e, i) e where+    readVar  (arr,i) = readArray  arr i+    writeVar (arr,i) = writeArray arr i++instance (Unboxed e, Ix i) => Mutable IO (IOUArray i e, i) e where+    readVar  (arr,i) = readArray  arr i+    writeVar (arr,i) = writeArray arr i++instance (Storable e, Ix i) => Mutable IO (StorableArray i e, i) e where+    readVar  (arr,i) = readArray  arr i+    writeVar (arr,i) = writeArray arr i++instance (Ix i) => Mutable (ST s) (STArray s i e, i) e where+    readVar  (arr,i) = readArray  arr i+    writeVar (arr,i) = writeArray arr i++instance (Unboxed e, Ix i) => Mutable (ST s) (STUArray s i e, i) e where+    readVar  (arr,i) = readArray  arr i+    writeVar (arr,i) = writeArray arr i++instance (MArray a e m, Ix i, Ix j) => Mutable m (a (i,j) e, i, j) e where+    readVar  (arr,i,j) = readArray  arr (i,j)+    writeVar (arr,i,j) = writeArray arr (i,j)++instance (MArray a e m, Ix i, Ix j, Ix k) => Mutable m (a (i,j,k) e, i, j, k) e where+    readVar  (arr,i,j,k) = readArray  arr (i,j,k)+    writeVar (arr,i,j,k) = writeArray arr (i,j,k)++-- -----------------------------------------------------------------------------+-- Implementation of `Mutable` interface for values in HashTable++instance Mutable IO (HashTable key e, key) e where+    readVar  (table,key)   = do (Just x) <- Hash.lookup table key+                                return x+    writeVar (table,key) e = hashUpdate table key e >> return ()++#if defined(__HUGS_VERSION__)  ||  defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 604)+-- Define this only for Hugs2005+ and GHC 6.4++hashUpdate table = Hash.update table+#else+-- Slower implementation for old compilers+hashUpdate table key e = do Hash.delete table key+                            Hash.insert table key e+#endif+++-- -----------------------------------------------------------------------------+-- Syntax sugar for using mutables++infixl 0 =:, +=, -=, .=, .<-+ref  x  = newRef  x                           -- create new boxed reference+uref x  = newURef x                           -- create new unboxed reference+val var = readVar    var                      -- read current value of mutable+var=:x  = writeVar   var x                    -- assign new value to mutable+var+=x  = modifyVar  var (\old -> old+x)      -- increase value of mutable+var-=x  = modifyVar  var (\old -> old-x)      -- decrease value of mutable+var.=f  = modifyVar  var (\old -> f old)      -- apply pure function to the value of mutable+var.<-f = modifyVarM var (\old -> f old)      -- apply monadic computation to the value of mutable++{-# INLINE ref  #-}+{-# INLINE uref #-}+{-# INLINE (=:) #-}+{-# INLINE (+=) #-}+{-# INLINE (-=) #-}

@@ -0,0 +1,151 @@+{-# LANGUAGE CPP, ScopedTypeVariables #-}+{- |+   Module     : Data.Unboxed+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: Hugs/GHC++Class 'Unboxed' represents values that can be stored in unboxed vectors+  and unboxed references++Based on the: Hugs.ByteArray module+-}++module Data.Unboxed (+           UVec,+           MUVec,+           allocUnboxed,+           unsafeFreezeUnboxed,+           unsafeThawUnboxed,+           freezeUnboxed,+           thawUnboxed,+           castUnboxed,+           castMUnboxed,++           Unboxed,+           readUnboxed,+           writeUnboxed,+           indexUnboxed,+           sizeOfUnboxed,+       )+where++-- On GHC we use fast compiler-specific implementation.+-- On other compilers, slow but universal Storable-based implementation is used+#ifdef __GLASGOW_HASKELL__++import GHC.Unboxed++#else++import Control.Monad.STorIO+import Data.Int+import Data.Word+import Foreign.ForeignPtr+import Foreign.Marshal.Utils    ( copyBytes )+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.Storable+import System.IO.Unsafe++-- ---------------------------------------------------------------------------+-- | Immutable and mutable byte vectors++newtype  UVec   a =  UVec (ForeignPtr a)+newtype MUVec s a = MUVec (ForeignPtr a)++-- | Alloc the mutable byte vector+allocUnboxedBytes :: (STorIO m s, Integral bytes, Unboxed a)+                  => bytes -> m (MUVec s a)+allocUnboxedBytes bytes = do+    fp <- mLift (mallocForeignPtrBytes (fromIntegral bytes))+    return (MUVec fp)++-- | Mutable->immutable byte vector on-place conversion+{-# INLINE unsafeFreezeMUVec #-}+unsafeFreezeUnboxed :: (STorIO m s)+                => MUVec s a -> m (UVec a)+unsafeFreezeUnboxed (MUVec arr) = do+    return (UVec arr)++-- | Immutable->mutable byte vector on-place conversion+{-# INLINE unsafeThawUVec #-}+unsafeThawUnboxed :: (STorIO m s)+             => UVec a -> m (MUVec s a)+unsafeThawUnboxed (UVec arr) = do+    return (MUVec arr)++-- | Mutable->immutable byte vector conversion which takes a copy of contents+freezeUnboxed :: (STorIO m s)+                => MUVec s a -> Int -> m (UVec a)+freezeUnboxed (MUVec arr) size = mLift $ do+    arr' <- mallocForeignPtrBytes size+    withForeignPtr arr $ \p ->+        withForeignPtr arr' $ \p' ->+            copyBytes p' p size+    return (UVec arr')++-- | Immutable->mutable byte vector conversion which takes a copy of contents+thawUnboxed :: (STorIO m s) => UVec a -> Int -> m (MUVec s a)+thawUnboxed (UVec arr) size = mLift $ do+    arr' <- mallocForeignPtrBytes size+    withForeignPtr arr $ \p ->+        withForeignPtr arr' $ \p' ->+            copyBytes p' p size+    return (MUVec arr')++-- ---------------------------------------------------------------------------+-- | Unboxed defined via Storable++class    (Storable value) => Unboxed value+instance (Storable value) => Unboxed value++-- | Read the value from mutable byte vector at given `index`+{-# INLINE readUnboxed #-}+readUnboxed :: (STorIO m s, Unboxed value, Integral index)+            => MUVec s value -> index -> m value+readUnboxed (MUVec arr) index = mLift $+    withForeignPtr arr $ \a -> peekElemOff a (fromIntegral index)++-- | Write the value to mutable byte vector at given `index`+{-# INLINE writeUnboxed #-}+writeUnboxed :: (STorIO m s, Unboxed value, Integral index)+             => MUVec s value -> index -> value -> m ()+writeUnboxed (MUVec arr) index value = mLift $+    withForeignPtr arr $ \a -> pokeElemOff a (fromIntegral index) value++-- | Read the value from immutable byte vector at given `index`+{-# INLINE indexUnboxed #-}+indexUnboxed :: (Unboxed value, Integral index)+             => UVec value -> index -> value+indexUnboxed (UVec arr) index = unsafePerformIO $+    withForeignPtr arr $ \a -> peekElemOff a (fromIntegral index)++-- | How many bytes required to represent values of this type+{-# INLINE sizeOfUnboxed #-}+sizeOfUnboxed :: (Unboxed value, Integral size)+              => value -> size+sizeOfUnboxed = fromIntegral . sizeOf++-- | Recast immutable unboxed vector+castUnboxed :: UVec a    -> UVec b+castUnboxed   (UVec vec) =  UVec (castForeignPtr vec)++-- | Recast mutable unboxed vector+castMUnboxed :: MUVec s a   -> MUVec s b+castMUnboxed   (MUVec mvec) =  MUVec (castForeignPtr mvec)++#endif++-- ---------------------------------------------------------------------------+-- | Additional operations on byte vectors++-- | Alloc the mutable byte vector having `elems` elements of required type+allocUnboxed :: forall s a elems m. (STorIO m s, Integral elems, Unboxed a)+             => elems -> m (MUVec s a)+allocUnboxed elems =+    allocUnboxedBytes (fromIntegral elems * sizeOfUnboxed (undefined::a))+

@@ -0,0 +1,36 @@+-- This example demonstrates using of Array, IOArray and STArray+import Control.Monad.ST+import Data.ArrayBZ.Boxed++main = do+          -- This section demonstrates using of Array+          test_Array          |>  print++          -- This section demonstrates using of IOArray+          test_IOArray        >>= print++          -- This section demonstrates using of STArray+          runST test_STArray  |>  print+++-- Using Array+test_Array =+          let array = listArray (1,10) [1..10] :: Array Int Double+              elements = elems array+          in (sum elements)++-- Using IOArray+test_IOArray = do+          array <- newListArray (1,10) [1..10] :: IO (IOArray Int Double)+          elements <- getElems array+          return (sum elements)++-- Using STArray+test_STArray = do+          array <- newListArray (1,10) [1..10] :: ST s (STArray s Int Double)+          elements <- getElems array+          return (sum elements)++-- Helper operation+a |> b = b a+

@@ -0,0 +1,25 @@+-- This example demonstrates using of DiffArray and DiffUArray+import Data.ArrayBZ.Diff++main = do+          -- This section demonstrates using of DiffArray+          test_DiffArray          |>  print++          -- This section demonstrates using of DiffUArray+          test_DiffUArray         |>  print++-- Using DiffArray+test_DiffArray =+          let array = listArray (1,10) [1..10] :: DiffArray Int Double+              elements = elems array+          in (sum elements)++-- Using DiffUArray+test_DiffUArray =+          let array = listArray (1,10) [1..10] :: DiffUArray Int Double+              elements = elems array+          in (sum elements)++-- Helper operation+a |> b = b a+

@@ -0,0 +1,45 @@+-- This example demonstrates using of `DynamicIOArray`,+-- i.e. arrays whose bounds can be changed dynamically,+-- including automatic growth as `writeArray` requires.+--+-- Other types of dynamic arrays - DynamicIOUArray, DynamicSTArray,+-- DynamicSTUArray and manually constructed dynamic array types+-- can be used in the same fashion.+import Data.ArrayBZ.Dynamic++main = do+          -- This array will grow at least two times each time when index is out of bounds,+          -- because it is created using `newDynamicArray growTwoTimes`+          arr <- newDynamicArray growTwoTimes (0,-1) 99 :: IO (DynamicIOArray Int Int)+          -- At this moment the array is empty+          printArray arr++          -- During this cycle the array extended 3 times+          for [0..5] $ \i ->+             writeArray arr i i+          printArray arr++          -- During this cycle the array extended one more time+          for [-5 .. -1] $ \i ->+             writeArray arr i i+          printArray arr++          -- Operation that explicitly resizes the array+          resizeDynamicArray arr (3,15)+          printArray arr++          -- This array will not grow automatically because it is created using `newArray`,+          -- but it can be resized explicitly using `resizeDynamicArray`+          arr <- newArray (0,-1) 99 :: IO (DynamicIOArray Int Int)+          resizeDynamicArray arr (0,0)+          printArray arr+          writeArray arr 1 1  -- this operation raises error+++-- Print dynamic array bounds and contents+printArray arr = do+          bounds   <- getBounds arr+          contents <- getElems  arr+          putStrLn (show bounds++" : "++show contents)++for list action = mapM_ action list

@@ -0,0 +1,26 @@+-- This example demonstrates using of IOArray and IOUArray+import Data.ArrayBZ.IO++main = do+          -- This section demonstrates using of IOArray+          test_IOArray        >>= print++          -- This section demonstrates using of IOUArray+          test_IOUArray       >>= print+++-- Using IOArray+test_IOArray = do+          array <- newListArray (1,10) [1..10] :: IO (IOArray Int Double)+          elements <- getElems array+          return (sum elements)++-- Using IOUArray+test_IOUArray = do+          array <- newListArray (1,10) [1..10] :: IO (IOUArray Int Double)+          elements <- getElems array+          return (sum elements)++-- Helper operation+a |> b = b a+

@@ -0,0 +1,27 @@+-- This example demonstrates using of STArray and STUArray+import Control.Monad.ST+import Data.ArrayBZ.ST++main = do+          -- This section demonstrates using of STArray+          runST test_STArray  |>  print++          -- This section demonstrates using of STUArray+          runST test_STUArray  |>  print+++-- Using STArray+test_STArray = do+          array <- newListArray (1,10) [1..10] :: ST s (STArray s Int Double)+          elements <- getElems array+          return (sum elements)++-- Using STUArray+test_STUArray = do+          array <- newListArray (1,10) [1..10] :: ST s (STUArray s Int Double)+          elements <- getElems array+          return (sum elements)++-- Helper operation+a |> b = b a+

@@ -0,0 +1,14 @@+-- This example demonstrates using of StorableArray+import Data.ArrayBZ.Storable++main = do+          -- This section demonstrates using of StorableArray+          test_StorableArray        >>= print+++-- Using StorableArray+test_StorableArray = do+          array <- newListArray (1,10) [1..10] :: IO (StorableArray Int Double)+          elements <- getElems array+          return (sum elements)+

@@ -0,0 +1,36 @@+-- This example demonstrates using of UArray, IOUArray and STUArray+import Control.Monad.ST+import Data.ArrayBZ.Unboxed++main = do+          -- This section demonstrates using of UArray+          test_UArray          |>  print++          -- This section demonstrates using of IOUArray+          test_IOUArray        >>= print++          -- This section demonstrates using of STUArray+          runST test_STUArray  |>  print+++-- Using UArray+test_UArray =+          let array = listArray (1,10) [1..10] :: UArray Int Double+              elements = elems array+          in (sum elements)++-- Using IOUArray+test_IOUArray = do+          array <- newListArray (1,10) [1..10] :: IO (IOUArray Int Double)+          elements <- getElems array+          return (sum elements)++-- Using STUArray+test_STUArray = do+          array <- newListArray (1,10) [1..10] :: ST s (STUArray s Int Double)+          elements <- getElems array+          return (sum elements)++-- Helper operation+a |> b = b a+

@@ -0,0 +1,81 @@+-- This module demonstrates using of syntax sugar when manipulating+--   references, arrays and hash tables, including implementation+--   of monad-independent algorithms with references+import Control.Monad.ST+import Data.SyntaxSugar+import Data.Ref+import Data.ArrayBZ.IO+import Data.HashTable as Hash++main = do+          -- This section demonstrates running of monad-independent+          -- algorithm that use boxed references in IO and ST monads+          test_Ref 5            >>= print+          runST (test_Ref 6)    |>  print++          -- This section demonstrates running of monad-independent+          -- algorithm that use unboxed references in IO and ST monads+          test_URef 7           >>= print+          runST (test_URef 8)   |>  print++          -- Using syntax sugar with arrays+          test_Array            >>= print++          -- Using syntax sugar with hash tables+          test_Hash             >>= print+++-- Monad-independent computation that uses boxed reference+test_Ref init = do+          x <- ref (0::Int)+          x =: init+          x += 10+          x -= 2+          x .= (*2)+          val x++-- Monad-independent computation that uses unboxed reference+test_URef init = do+          x <- uref (0::Int)+          x =: init+          x += 10+          x -= 2+          x .= (*2)+          val x++-- Using syntax sugar with arrays+test_Array = do+          let i = 0::Int++          arr <- newArray (0,9) 0 :: IO (IOArray Int Double)+          (arr,i) =: 1+          (arr,i) += 10+          (arr,i) -= 2+          (arr,i) .= (*2)+          x <- val (arr,i)++          arr2 <- newArray ((0,0), (9,9)) 0 :: IO (IOArray (Int,Int) Double)+          (arr2,i,i) =: 1+          (arr2,i,i) += 10+          (arr2,i,i) -= 2+          (arr2,i,i) .= (*2)+          y <- val (arr2,i,i)++          return (x,y)+++-- Using syntax sugar with hash tables+test_Hash = do+          let key = "test"+          hash <- Hash.new (==) hashString+          (hash,key) =: 1+          (hash,key) += 10+          (hash,key) -= 2+          (hash,key) .= (*2)+          val (hash,key)+++-- Helper operations+a |> b = b a+for list action = mapM_ action list+

@@ -0,0 +1,29 @@+-- This program demonstrates using of fast unboxed references in IO and ST monads+import Control.Monad.ST+import Data.Ref+import Data.Ref.LazyST ()++main = do+          -- IOURef is fast unboxed reference in IO monad+          test_IOURef 1         >>= print++          -- STURef is fast unboxed reference in ST monad+          runST (test_STURef 2) |>  print+++-- Using 'IOURef Int'+test_IOURef init = do+          x <- newIOURef (init::Int)+          x0 <- readIOURef x+          writeIOURef x (x0+10)+          readIOURef x++-- Using 'STURef Int'+test_STURef init = do+          x <- newSTURef (init::Int)+          x0 <- readSTURef x+          writeSTURef x (x0+10)+          readSTURef x++-- Helper operation+a |> b = b a

@@ -0,0 +1,37 @@+-- This program demonstrates implementation of monad-independent algorithms+-- using Ref and URef classes+import Control.Monad.ST+import Data.Ref++main = do+          -- This section demonstrates running of monad-independent algrorithm+          -- `test_Ref` in IO and ST monads+          test_Ref 3         >>= print+          runST (test_Ref 4) |>  print++          -- This section demonstrates running of monad-independent algrorithm+          -- `test_URef` in IO and ST monads+          test_URef 5         >>= print+          runST (test_URef 6) |>  print+++-- Using class 'Ref'+test_Ref init = do+          x <- newRef (init::Int)   -- `newRef` operation will create+                                    --    * IORef in IO monad+                                    --    * STRef in ST monad+          x0 <- readRef x           -- `readRef` and `writeRef` operations+          writeRef x (x0+10)        --   works with references of both types+          readRef x++-- Using class 'URef'+test_URef init = do+          x <- newURef (init::Int)  -- `newURef` operation will create+                                    --    * IOURef in IO monad+                                    --    * STURef in ST monad+          x0 <- readURef x          -- `readURef` and `writeURef` operations+          writeURef x (x0+10)       --   works with references of both types+          readURef x++-- Helper operation+a |> b = b a

@@ -0,0 +1,105 @@+{-# LANGUAGE UnboxedTuples, MagicHash #-}+{- |+   Module     : GHC.ArrBZ+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC++Vectors of boxed values++-}++module GHC.ArrBZ where++import GHC.Base++import Control.Monad.STorIO++-- ---------------------------------------------------------------------------+-- | Immutable and mutable vectors of boxed values++data  Vec   a  =   Vec (Array# a)+data MVec s a  =  MVec (MutableArray# s a)++-- | Alloc the mutable vector+allocBoxed :: (STorIO m s, Integral elems) => elems -> a -> m (MVec s a)+-- | Mutable->immutable vector on-place conversion+unsafeFreezeBoxed :: (STorIO m s) => MVec s a -> m (Vec a)+-- | Immutable->mutable vector on-place conversion+unsafeThawBoxed :: (STorIO m s) => Vec a -> m (MVec s a)+-- | Mutable->immutable vector conversion which takes a copy of contents+freezeBoxed :: (STorIO m s) => MVec s a -> Int -> a -> m (Vec a)+-- | Immutable->mutable vector conversion which takes a copy of contents+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 #) } )++{-# INLINE unsafeFreezeBoxed #-}+unsafeFreezeBoxed (MVec mvec) = mLift ( \s ->+  case unsafeFreezeArray# mvec s of { (# s, vec #) ->+  (# s, Vec vec #) } )++{-# INLINE unsafeThawBoxed #-}+unsafeThawBoxed (Vec arr#) = mLift ( \s ->+  case unsafeThawArray# arr# s of { (# s, marr# #) ->+  (# s, MVec marr# #) } )++freezeBoxed (MVec marr#) (I# n#) init = mLift ( \s1# ->+    case newArray# n# init                s1#  of { (# s2#, tmparr# #) ->++    let copy i# s01# | i# ==# n# =        s01#+                     | otherwise =+            case readArray#  marr#   i#   s01# of { (# s02#, e #) ->+            case writeArray# tmparr# i# e s02# of { s03# ->+            copy (i# +# 1#)               s03# }} in++    case copy 0#                          s2#  of { s3# ->+    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# #) ->++    let copy i# s01# | i# ==# n# =      s01#+                     | otherwise =+            case indexArray# vec#  i#        of { (# e #) ->+            case writeArray# mvec# i# e s01# of { s02# ->+            copy (i# +# 1#)             s02# }} in++    case copy 0#                        s2#  of { s3# ->+    (# s3#, MVec mvec# #) }} )++-- Implementation helper function that converts any integral value to the Int#+{-# INLINE fromI# #-}+fromI# :: (Integral n) => n -> Int#+fromI# n = n#   where I# n# = fromIntegral n++-- ---------------------------------------------------------------------------+-- Read/write/index vector elements++-- | Read the value from mutable vector at given `index`+readBoxed    :: (STorIO m s, Integral index) => MVec s value -> index -> m value+-- | Write the value to mutable vector at given `index`+writeBoxed   :: (STorIO m s, Integral index) => MVec s value -> index -> value -> m ()+-- | Read the value from immutable vector at given `index`+indexBoxed   :: (Integral index) => Vec value -> index -> value+++{-# INLINE readBoxed #-}+readBoxed (MVec vec) index  =  mLift (readArray# vec (fromI# index))++{-# INLINE writeBoxed #-}+writeBoxed (MVec vec) index value  =  mLift ( \s ->+    case writeArray# vec (fromI# index) value s of { s ->+    (# s, () #) } )++{-# INLINE indexBoxed #-}+indexBoxed (Vec vec) index  =+    case indexArray# vec (fromI# index) of { (# s #) -> s }+

@@ -0,0 +1,185 @@+{-# LANGUAGE FunctionalDependencies, FlexibleInstances, UnliftedFFITypes,+  CPP, KindSignatures, MagicHash, UnboxedTuples, ForeignFunctionInterface,+  MultiParamTypeClasses #-}+{- |+   Module     : GHC.Unboxed+   Copyright  : Copyright (C) 2006 Bulat Ziganshin+   License    : BSD3++   Maintainer : Bulat Ziganshin <Bulat.Ziganshin@gmail.com>+   Stability  : experimental+   Portability: GHC++Unboxed values (simple datatypes that can be stored in ByteArrays,+  i.e. raw memory buffers allocated inside the Haskell heap)++Based on the idea of Oleg Kiselyov+  (see http://www.haskell.org/pipermail/haskell-cafe/2004-July/006400.html)+-}++module GHC.Unboxed where++import GHC.ST           ( ST(..), runST )+import GHC.IOBase       ( IO(..) )+import GHC.Base+import GHC.Word         ( Word(..) )+import GHC.Ptr          ( Ptr(..), FunPtr(..) )+import GHC.Float        ( Float(..), Double(..) )+import GHC.Stable       ( StablePtr(..) )+import GHC.Int          ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )+import GHC.Word         ( Word8(..), Word16(..), Word32(..), Word64(..) )+import Control.Monad.ST.Lazy    ( strictToLazyST )+import qualified Control.Monad.ST.Lazy as Lazy (ST)+import Foreign.Storable++-- ---------------------------------------------------------------------------+-- | That's all we need to unify ST and IO operations!+class (Monad m) => STorIO m s | m->s where+    mLift :: (State# s -> (# State# s, a #)) -> m a++instance STorIO (ST s) s where+    {-# INLINE mLift #-}+    mLift = ST++instance STorIO (Lazy.ST s) s where+    {-# INLINE mLift #-}+    mLift = strictToLazyST . ST++instance STorIO IO RealWorld where+    {-# INLINE mLift #-}+    mLift = IO++-- | Type functions which converts universal ST or IO types to IO-specific ones+type IOSpecific  (a :: * -> *)           = a RealWorld+type IOSpecific2 (a :: * -> * -> *)       = a RealWorld+type IOSpecific3 (a :: * -> * -> * -> *)   = a RealWorld++-- ---------------------------------------------------------------------------+-- | Immutable and mutable byte vectors++data  UVec   a  =   UVec ByteArray#+data MUVec s a  =  MUVec (MutableByteArray# s)++-- | Alloc the mutable byte vector+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 #) } )++-- | 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# #) } )++-- | Immutable->mutable byte vector on-place conversion+{-# INLINE unsafeThawUnboxed #-}+unsafeThawUnboxed :: (STorIO m s) => UVec a -> m (MUVec s a)+unsafeThawUnboxed (UVec arr#) = mLift ( \s ->+    (# s, MUVec (unsafeCoerce# arr#) #) )++-- | Mutable->immutable byte vector conversion which takes a copy of contents+freezeUnboxed :: (STorIO m s) => MUVec s a -> Int -> m (UVec a)+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# #) ->+    (# s3#, UVec arr# #) }}} )++-- | Immutable->mutable byte vector conversion which takes a copy of contents+thawUnboxed :: (STorIO m s) => UVec a -> Int -> m (MUVec s a)+thawUnboxed (UVec arr#) (I# size) = mLift (  \s1# ->+    case newByteArray# size                   s1# of { (# s2#, marr# #) ->+    case unsafeCoerce# memcpy marr# arr# size s2# of { (# s3#, () #) ->+    (# s3#, MUVec marr# #) }} )++-- | Recast immutable unboxed vector+castUnboxed :: UVec a    -> UVec b+castUnboxed   (UVec vec) =  UVec vec++-- | Recast mutable unboxed vector+castMUnboxed :: MUVec s a   -> MUVec s b+castMUnboxed   (MUVec mvec) =  MUVec mvec++-- Implementation helper function that converts any integral value to the Int#+{-# INLINE fromI# #-}+fromI# :: (Integral n) => n -> Int#+fromI# n = n#   where I# n# = fromIntegral n++-- Implementation helper function that copies data between byte vectors+foreign import ccall unsafe "memcpy"+    memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()++-- ---------------------------------------------------------------------------+-- | Unboxed is like Storable, but values are stored in byte vectors (i.e. inside the Haskell heap)++class Unboxed value where+    -- | Read the value from mutable byte vector at given `index`+    readUnboxed    :: (STorIO m s, Integral index) => MUVec s value -> index -> m value+    -- | Write the value to mutable byte vector at given `index`+    writeUnboxed   :: (STorIO m s, Integral index) => MUVec s value -> index -> value -> m ()+    -- | Read the value from immutable byte vector at given `index`+    indexUnboxed   :: (Integral index) => UVec value -> index -> value+    -- | How many bytes required to represent values of this type+    sizeOfUnboxed  :: value -> Int++-- Universal defition for Enum types having <= 256 variants+instance Unboxed Bool where+{+    {-# INLINE readUnboxed #-};+    readUnboxed (MUVec arr) index  =  mLift ( \s ->+        case readInt8Array# arr (fromI# index) s of { (# s, value# #) ->+        (# s, tagToEnum# value# #) } );++    {-# INLINE writeUnboxed #-};+    writeUnboxed (MUVec arr) index value  =  mLift ( \s ->+        case writeInt8Array# arr (fromI# index) (getTag value) s of { s ->+        (# s, () #) } );++    {-# INLINE indexUnboxed #-};+    indexUnboxed (UVec arr) index  =  tagToEnum# (indexInt8Array# arr (fromI# index));++    {-# INLINE sizeOfUnboxed #-};+    sizeOfUnboxed _ = 1;+}++-- Universal defition for Storable types+#define InstanceUnboxed(type, cast, read, write, at)                  \+instance Unboxed type where                                           \+{                                                                     \+    {-# INLINE readUnboxed #-};                                       \+    readUnboxed (MUVec arr) index  =  mLift ( \s ->                   \+        case read arr (fromI# index) s of { (# s, value# #) ->        \+        (# s, cast value# #) } );                                     \+                                                                      \+    {-# INLINE writeUnboxed #-};                                      \+    writeUnboxed (MUVec arr) index (cast value#)  =  mLift ( \s ->    \+        case write arr (fromI# index) value# s of { s ->              \+        (# s, () #) } );                                              \+                                                                      \+    {-# INLINE indexUnboxed #-};                                      \+    indexUnboxed (UVec arr) index  =  cast (at arr (fromI# index));   \+                                                                      \+    {-# INLINE sizeOfUnboxed #-};                                     \+    sizeOfUnboxed = sizeOf;                                           \+}                                                                     \++InstanceUnboxed( Char,       C#,     readWideCharArray#, writeWideCharArray#, indexWideCharArray#)+InstanceUnboxed( Int,        I#,     readIntArray#,      writeIntArray#,      indexIntArray#)+InstanceUnboxed( Int8,       I8#,    readInt8Array#,     writeInt8Array#,     indexInt8Array#)+InstanceUnboxed( Int16,      I16#,   readInt16Array#,    writeInt16Array#,    indexInt16Array#)+InstanceUnboxed( Int32,      I32#,   readInt32Array#,    writeInt32Array#,    indexInt32Array#)+InstanceUnboxed( Int64,      I64#,   readInt64Array#,    writeInt64Array#,    indexInt64Array#)+InstanceUnboxed( Word,       W#,     readWordArray#,     writeWordArray#,     indexWordArray#)+InstanceUnboxed( Word8,      W8#,    readWord8Array#,    writeWord8Array#,    indexWord8Array#)+InstanceUnboxed( Word16,     W16#,   readWord16Array#,   writeWord16Array#,   indexWord16Array#)+InstanceUnboxed( Word32,     W32#,   readWord32Array#,   writeWord32Array#,   indexWord32Array#)+InstanceUnboxed( Word64,     W64#,   readWord64Array#,   writeWord64Array#,   indexWord64Array#)+InstanceUnboxed( Float,      F#,     readFloatArray#,    writeFloatArray#,    indexFloatArray#)+InstanceUnboxed( Double,     D#,     readDoubleArray#,   writeDoubleArray#,   indexDoubleArray#)+InstanceUnboxed( (Ptr a),    Ptr,    readAddrArray#,     writeAddrArray#,     indexAddrArray#)+InstanceUnboxed( (FunPtr a), FunPtr, readAddrArray#,     writeAddrArray#,     indexAddrArray#)+InstanceUnboxed( (StablePtr a), StablePtr, readStablePtrArray#, writeStablePtrArray#, indexStablePtrArray#)+

@@ -0,0 +1,70 @@+/* ----------------------------------------------------------------------------+ * Macros to help make Typeable instances.+ *+ * INSTANCE_TYPEABLEn(tc,tcname,"tc") defines+ *+ *      instance Typeable/n/ tc+ *      instance Typeable a => Typeable/n-1/ (tc a)+ *      instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)+ *      ...+ *      instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)+ * -------------------------------------------------------------------------- */++#ifndef TYPEABLE_H+#define TYPEABLE_H++#define INSTANCE_TYPEABLE0(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }++#ifdef __GLASGOW_HASKELL__++/* For GHC, the extra instances follow from general instance declarations+ * defined in Data.Typeable. */++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }++#elif defined(__HUGS__) && defined(__HUGS_VERSION__) && (__HUGS_VERSION__>=2005)++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable1 (tycon a) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \+  typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable2 (tycon a) where { \+  typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \+  typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \+  typeOf = typeOfDefault }++#else++#define INSTANCE_TYPEABLE1(tycon,tcname,str)+#define INSTANCE_TYPEABLE2(tycon,tcname,str)+#define INSTANCE_TYPEABLE3(tycon,tcname,str)++#endif /* !__GLASGOW_HASKELL__ */++#endif

@@ -0,0 +1,28 @@+Copyright (c) The University of Glasgow 2001+          (c) Bulat Ziganshin 2006++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the authro nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND 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 AUTHORS OR 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.

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks