Remove non-locale stuff (of base), and rename package to "old-locale" old-locale_2007-05-24
authorIan Lynagh <igloo@earth.li>
Sat, 19 May 2007 13:25:33 +0000 (13:25 +0000)
committerIan Lynagh <igloo@earth.li>
Sat, 19 May 2007 13:25:33 +0000 (13:25 +0000)
194 files changed:
Control/Applicative.hs [deleted file]
Control/Arrow.hs [deleted file]
Control/Concurrent.hs [deleted file]
Control/Concurrent/Chan.hs [deleted file]
Control/Concurrent/MVar.hs [deleted file]
Control/Concurrent/QSem.hs [deleted file]
Control/Concurrent/QSemN.hs [deleted file]
Control/Concurrent/SampleVar.hs [deleted file]
Control/Exception.hs [deleted file]
Control/Monad.hs [deleted file]
Control/Monad/Fix.hs [deleted file]
Control/Monad/Instances.hs [deleted file]
Control/Monad/ST.hs [deleted file]
Control/Monad/ST/Lazy.hs [deleted file]
Control/Monad/ST/Strict.hs [deleted file]
Data/Array.hs [deleted file]
Data/Array/Base.hs [deleted file]
Data/Array/Diff.hs [deleted file]
Data/Array/IArray.hs [deleted file]
Data/Array/IO.hs [deleted file]
Data/Array/IO/Internals.hs [deleted file]
Data/Array/MArray.hs [deleted file]
Data/Array/ST.hs [deleted file]
Data/Array/Storable.hs [deleted file]
Data/Array/Unboxed.hs [deleted file]
Data/Bits.hs [deleted file]
Data/Bool.hs [deleted file]
Data/ByteString.hs [deleted file]
Data/ByteString/Base.hs [deleted file]
Data/ByteString/Char8.hs [deleted file]
Data/ByteString/Fusion.hs [deleted file]
Data/ByteString/Lazy.hs [deleted file]
Data/ByteString/Lazy/Char8.hs [deleted file]
Data/Char.hs [deleted file]
Data/Complex.hs [deleted file]
Data/Dynamic.hs [deleted file]
Data/Dynamic.hs-boot [deleted file]
Data/Either.hs [deleted file]
Data/Eq.hs [deleted file]
Data/Fixed.hs [deleted file]
Data/Foldable.hs [deleted file]
Data/Function.hs [deleted file]
Data/Generics.hs [deleted file]
Data/Generics/Aliases.hs [deleted file]
Data/Generics/Basics.hs [deleted file]
Data/Generics/Instances.hs [deleted file]
Data/Generics/Schemes.hs [deleted file]
Data/Generics/Text.hs [deleted file]
Data/Generics/Twins.hs [deleted file]
Data/Graph.hs [deleted file]
Data/HashTable.hs [deleted file]
Data/IORef.hs [deleted file]
Data/Int.hs [deleted file]
Data/IntMap.hs [deleted file]
Data/IntSet.hs [deleted file]
Data/Ix.hs [deleted file]
Data/List.hs [deleted file]
Data/Map.hs [deleted file]
Data/Maybe.hs [deleted file]
Data/Monoid.hs [deleted file]
Data/Ord.hs [deleted file]
Data/PackedString.hs [deleted file]
Data/Ratio.hs [deleted file]
Data/STRef.hs [deleted file]
Data/STRef/Lazy.hs [deleted file]
Data/STRef/Strict.hs [deleted file]
Data/Sequence.hs [deleted file]
Data/Set.hs [deleted file]
Data/String.hs [deleted file]
Data/Traversable.hs [deleted file]
Data/Tree.hs [deleted file]
Data/Tuple.hs [deleted file]
Data/Typeable.hs [deleted file]
Data/Typeable.hs-boot [deleted file]
Data/Unique.hs [deleted file]
Data/Version.hs [deleted file]
Data/Word.hs [deleted file]
Debug/Trace.hs [deleted file]
Foreign.hs [deleted file]
Foreign/C.hs [deleted file]
Foreign/C/Error.hs [deleted file]
Foreign/C/String.hs [deleted file]
Foreign/C/Types.hs [deleted file]
Foreign/Concurrent.hs [deleted file]
Foreign/ForeignPtr.hs [deleted file]
Foreign/Marshal.hs [deleted file]
Foreign/Marshal/Alloc.hs [deleted file]
Foreign/Marshal/Array.hs [deleted file]
Foreign/Marshal/Error.hs [deleted file]
Foreign/Marshal/Pool.hs [deleted file]
Foreign/Marshal/Utils.hs [deleted file]
Foreign/Ptr.hs [deleted file]
Foreign/StablePtr.hs [deleted file]
Foreign/Storable.hs [deleted file]
Foreign/Storable.hs-boot [deleted file]
GHC/Arr.lhs [deleted file]
GHC/Base.lhs [deleted file]
GHC/Conc.lhs [deleted file]
GHC/ConsoleHandler.hs [deleted file]
GHC/Dotnet.hs [deleted file]
GHC/Enum.lhs [deleted file]
GHC/Err.lhs [deleted file]
GHC/Err.lhs-boot [deleted file]
GHC/Exception.lhs [deleted file]
GHC/Exts.hs [deleted file]
GHC/Float.lhs [deleted file]
GHC/ForeignPtr.hs [deleted file]
GHC/Handle.hs [deleted file]
GHC/IO.hs [deleted file]
GHC/IOBase.lhs [deleted file]
GHC/Int.hs [deleted file]
GHC/List.lhs [deleted file]
GHC/Num.lhs [deleted file]
GHC/PArr.hs [deleted file]
GHC/Pack.lhs [deleted file]
GHC/Ptr.lhs [deleted file]
GHC/Read.lhs [deleted file]
GHC/Real.lhs [deleted file]
GHC/ST.lhs [deleted file]
GHC/STRef.lhs [deleted file]
GHC/Show.lhs [deleted file]
GHC/Stable.lhs [deleted file]
GHC/Storable.lhs [deleted file]
GHC/TopHandler.lhs [deleted file]
GHC/TopHandler.lhs-boot [deleted file]
GHC/Unicode.hs [deleted file]
GHC/Unicode.hs-boot [deleted file]
GHC/Weak.lhs [deleted file]
GHC/Word.hs [deleted file]
LICENSE
Makefile [deleted file]
Makefile.nhc98 [deleted file]
NHC/Makefile [deleted file]
NHC/PosixTypes.hsc [deleted file]
NHC/SizedTypes.hs [deleted file]
Numeric.hs [deleted file]
Prelude.hs [deleted file]
Setup.hs
System/CPUTime.hsc [deleted file]
System/Cmd.hs [deleted file]
System/Console/GetOpt.hs [deleted file]
System/Environment.hs [deleted file]
System/Exit.hs [deleted file]
System/IO.hs [deleted file]
System/IO/Error.hs [deleted file]
System/IO/Unsafe.hs [deleted file]
System/Info.hs [deleted file]
System/Mem.hs [deleted file]
System/Mem/StableName.hs [deleted file]
System/Mem/Weak.hs [deleted file]
System/Posix/Internals.hs [deleted file]
System/Posix/Signals.hs [deleted file]
System/Posix/Types.hs [deleted file]
System/Process.hs [deleted file]
System/Process/Internals.hs [deleted file]
System/Timeout.hs [deleted file]
Text/ParserCombinators/ReadP.hs [deleted file]
Text/ParserCombinators/ReadPrec.hs [deleted file]
Text/Printf.hs [deleted file]
Text/Read.hs [deleted file]
Text/Read/Lex.hs [deleted file]
Text/Show.hs [deleted file]
Text/Show/Functions.hs [deleted file]
Unsafe/Coerce.hs [deleted file]
aclocal.m4 [deleted file]
base.cabal [deleted file]
cbits/Makefile [deleted file]
cbits/PrelIOUtils.c [deleted file]
cbits/WCsubst.c [deleted file]
cbits/Win32Utils.c [deleted file]
cbits/consUtils.c [deleted file]
cbits/dirUtils.c [deleted file]
cbits/execvpe.c [deleted file]
cbits/fpstring.c [deleted file]
cbits/inputReady.c [deleted file]
cbits/lockFile.c [deleted file]
cbits/longlong.c [deleted file]
cbits/runProcess.c [deleted file]
cbits/selectUtils.c [deleted file]
cbits/ubconfc [deleted file]
configure.ac [deleted file]
include/CTypes.h [deleted file]
include/HsBase.h [deleted file]
include/Makefile [deleted file]
include/Typeable.h [deleted file]
include/WCsubst.h [deleted file]
include/consUtils.h [deleted file]
include/dirUtils.h [deleted file]
include/fpstring.h [deleted file]
include/lockFile.h [deleted file]
include/runProcess.h [deleted file]
old-locale.cabal [new file with mode: 0644]
package.conf.in [deleted file]
prologue.txt

diff --git a/Control/Applicative.hs b/Control/Applicative.hs
deleted file mode 100644 (file)
index c22c55d..0000000
+++ /dev/null
@@ -1,220 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Applicative
--- Copyright   :  Conor McBride and Ross Paterson 2005
--- License     :  BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  :  ross@soi.city.ac.uk
--- Stability   :  experimental
--- Portability :  portable
---
--- This module describes a structure intermediate between a functor and
--- a monad: it provides pure expressions and sequencing, but no binding.
--- (Technically, a strong lax monoidal functor.)  For more details, see
--- /Applicative Programming with Effects/,
--- by Conor McBride and Ross Paterson, online at
--- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
---
--- This interface was introduced for parsers by Niklas R&#xF6;jemo, because
--- it admits more sharing than the monadic interface.  The names here are
--- mostly based on recent parsing work by Doaitse Swierstra.
---
--- This class is also useful with instances of the
--- 'Data.Traversable.Traversable' class.
-
-module Control.Applicative (
-       -- * Applicative functors
-       Applicative(..),
-       -- * Alternatives
-       Alternative(..),
-       -- * Instances
-       Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
-       -- * Utility functions
-       (<$>), (<$), (*>), (<*), (<**>),
-       liftA, liftA2, liftA3,
-       optional, some, many
-       ) where
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-
-import Control.Arrow
-       (Arrow(arr, (>>>), (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
-import Control.Monad (liftM, ap, MonadPlus(..))
-import Control.Monad.Instances ()
-import Data.Monoid (Monoid(..))
-
-infixl 3 <|>
-infixl 4 <$>, <$
-infixl 4 <*>, <*, *>, <**>
-
--- | A functor with application.
---
--- Instances should satisfy the following laws:
---
--- [/identity/]
---     @'pure' 'id' '<*>' v = v@
---
--- [/composition/]
---     @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@
---
--- [/homomorphism/]
---     @'pure' f '<*>' 'pure' x = 'pure' (f x)@
---
--- [/interchange/]
---     @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
---
--- The 'Functor' instance should satisfy
---
--- @
---     'fmap' f x = 'pure' f '<*>' x
--- @
---
--- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.
-
-class Functor f => Applicative f where
-       -- | Lift a value.
-       pure :: a -> f a
-
-        -- | Sequential application.
-       (<*>) :: f (a -> b) -> f a -> f b
-
--- | A monoid on applicative functors.
-class Applicative f => Alternative f where
-       -- | The identity of '<|>'
-       empty :: f a
-       -- | An associative binary operation
-       (<|>) :: f a -> f a -> f a
-
--- instances for Prelude types
-
-instance Applicative Maybe where
-       pure = return
-       (<*>) = ap
-
-instance Alternative Maybe where
-       empty = Nothing
-       Nothing <|> p = p
-       Just x <|> _ = Just x
-
-instance Applicative [] where
-       pure = return
-       (<*>) = ap
-
-instance Alternative [] where
-       empty = []
-       (<|>) = (++)
-
-instance Applicative IO where
-       pure = return
-       (<*>) = ap
-
-instance Applicative ((->) a) where
-       pure = const
-       (<*>) f g x = f x (g x)
-
-instance Monoid a => Applicative ((,) a) where
-       pure x = (mempty, x)
-       (u, f) <*> (v, x) = (u `mappend` v, f x)
-
--- new instances
-
-newtype Const a b = Const { getConst :: a }
-
-instance Functor (Const m) where
-       fmap _ (Const v) = Const v
-
-instance Monoid m => Applicative (Const m) where
-       pure _ = Const mempty
-       Const f <*> Const v = Const (f `mappend` v)
-
-newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
-
-instance Monad m => Functor (WrappedMonad m) where
-       fmap f (WrapMonad v) = WrapMonad (liftM f v)
-
-instance Monad m => Applicative (WrappedMonad m) where
-       pure = WrapMonad . return
-       WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
-
-instance MonadPlus m => Alternative (WrappedMonad m) where
-       empty = WrapMonad mzero
-       WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
-
-newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
-
-instance Arrow a => Functor (WrappedArrow a b) where
-       fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
-
-instance Arrow a => Applicative (WrappedArrow a b) where
-       pure x = WrapArrow (arr (const x))
-       WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
-
-instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
-       empty = WrapArrow zeroArrow
-       WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
-
--- | Lists, but with an 'Applicative' functor based on zipping, so that
---
--- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
---
-newtype ZipList a = ZipList { getZipList :: [a] }
-
-instance Functor ZipList where
-       fmap f (ZipList xs) = ZipList (map f xs)
-
-instance Applicative ZipList where
-       pure x = ZipList (repeat x)
-       ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
-
--- extra functions
-
--- | A synonym for 'fmap'.
-(<$>) :: Functor f => (a -> b) -> f a -> f b
-f <$> a = fmap f a
-
--- | Replace the value.
-(<$) :: Functor f => a -> f b -> f a
-(<$) = (<$>) . const
--- | Sequence actions, discarding the value of the first argument.
-(*>) :: Applicative f => f a -> f b -> f b
-(*>) = liftA2 (const id)
--- | Sequence actions, discarding the value of the second argument.
-(<*) :: Applicative f => f a -> f b -> f a
-(<*) = liftA2 const
--- | A variant of '<*>' with the arguments reversed.
-(<**>) :: Applicative f => f a -> f (a -> b) -> f b
-(<**>) = liftA2 (flip ($))
-
--- | Lift a function to actions.
--- This function may be used as a value for `fmap` in a `Functor` instance.
-liftA :: Applicative f => (a -> b) -> f a -> f b
-liftA f a = pure f <*> a
-
--- | Lift a binary function to actions.
-liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
-liftA2 f a b = f <$> a <*> b
-
--- | Lift a ternary function to actions.
-liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
-liftA3 f a b c = f <$> a <*> b <*> c
-
--- | One or none.
-optional :: Alternative f => f a -> f (Maybe a)
-optional v = Just <$> v <|> pure Nothing
-
--- | One or more.
-some :: Alternative f => f a -> f [a]
-some v = some_v
-  where many_v = some_v <|> pure []
-       some_v = (:) <$> v <*> many_v
-
--- | Zero or more.
-many :: Alternative f => f a -> f [a]
-many v = many_v
-  where many_v = some_v <|> pure []
-       some_v = (:) <$> v <*> many_v
diff --git a/Control/Arrow.hs b/Control/Arrow.hs
deleted file mode 100644 (file)
index 2710be6..0000000
+++ /dev/null
@@ -1,281 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Arrow
--- Copyright   :  (c) Ross Paterson 2002
--- License     :  BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  :  ross@soi.city.ac.uk
--- Stability   :  experimental
--- Portability :  portable
---
--- Basic arrow definitions, based on
---     /Generalising Monads to Arrows/, by John Hughes,
---     /Science of Computer Programming/ 37, pp67-111, May 2000.
--- plus a couple of definitions ('returnA' and 'loop') from
---     /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,
---     Firenze, Italy, pp229-240.
--- See these papers for the equations these combinators are expected to
--- satisfy.  These papers and more information on arrows can be found at
--- <http://www.haskell.org/arrows/>.
-
-module Control.Arrow (
-               -- * Arrows
-               Arrow(..), Kleisli(..),
-               -- ** Derived combinators
-               returnA,
-               (^>>), (>>^),
-               -- ** Right-to-left variants
-               (<<<), (<<^), (^<<),
-               -- * Monoid operations
-               ArrowZero(..), ArrowPlus(..),
-               -- * Conditionals
-               ArrowChoice(..),
-               -- * Arrow application
-               ArrowApply(..), ArrowMonad(..), leftApp,
-               -- * Feedback
-               ArrowLoop(..)
-       ) where
-
-import Prelude
-
-import Control.Monad
-import Control.Monad.Fix
-
-infixr 5 <+>
-infixr 3 ***
-infixr 3 &&&
-infixr 2 +++
-infixr 2 |||
-infixr 1 >>>, ^>>, >>^
-infixr 1 <<<, ^<<, <<^
-
--- | The basic arrow class.
---   Any instance must define either 'arr' or 'pure' (which are synonyms),
---   as well as '>>>' and 'first'.  The other combinators have sensible
---   default definitions, which may be overridden for efficiency.
-
-class Arrow a where
-
-       -- | Lift a function to an arrow: you must define either this
-       --   or 'pure'.
-       arr :: (b -> c) -> a b c
-       arr = pure
-
-       -- | A synonym for 'arr': you must define one or other of them.
-       pure :: (b -> c) -> a b c
-       pure = arr
-
-       -- | Left-to-right composition of arrows.
-       (>>>) :: a b c -> a c d -> a b d
-
-       -- | Send the first component of the input through the argument
-       --   arrow, and copy the rest unchanged to the output.
-       first :: a b c -> a (b,d) (c,d)
-
-       -- | A mirror image of 'first'.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       second :: a b c -> a (d,b) (d,c)
-       second f = arr swap >>> first f >>> arr swap
-                       where   swap ~(x,y) = (y,x)
-
-       -- | Split the input between the two argument arrows and combine
-       --   their output.  Note that this is in general not a functor.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       (***) :: a b c -> a b' c' -> a (b,b') (c,c')
-       f *** g = first f >>> second g
-
-       -- | Fanout: send the input to both argument arrows and combine
-       --   their output.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       (&&&) :: a b c -> a b c' -> a b (c,c')
-       f &&& g = arr (\b -> (b,b)) >>> f *** g
-
-{-# RULES
-"compose/arr"  forall f g .
-               arr f >>> arr g = arr (f >>> g)
-"first/arr"    forall f .
-               first (arr f) = arr (first f)
-"second/arr"   forall f .
-               second (arr f) = arr (second f)
-"product/arr"  forall f g .
-               arr f *** arr g = arr (f *** g)
-"fanout/arr"   forall f g .
-               arr f &&& arr g = arr (f &&& g)
-"compose/first"        forall f g .
-               first f >>> first g = first (f >>> g)
-"compose/second" forall f g .
-               second f >>> second g = second (f >>> g)
- #-}
-
--- Ordinary functions are arrows.
-
-instance Arrow (->) where
-       arr f = f
-       f >>> g = g . f
-       first f = f *** id
-       second f = id *** f
---     (f *** g) ~(x,y) = (f x, g y)
---     sorry, although the above defn is fully H'98, nhc98 can't parse it.
-       (***) f g ~(x,y) = (f x, g y)
-
--- | Kleisli arrows of a monad.
-
-newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
-
-instance Monad m => Arrow (Kleisli m) where
-       arr f = Kleisli (return . f)
-       Kleisli f >>> Kleisli g = Kleisli (\b -> f b >>= g)
-       first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))
-       second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))
-
--- | The identity arrow, which plays the role of 'return' in arrow notation.
-
-returnA :: Arrow a => a b b
-returnA = arr id
-
--- | Precomposition with a pure function.
-(^>>) :: Arrow a => (b -> c) -> a c d -> a b d
-f ^>> a = arr f >>> a
-
--- | Postcomposition with a pure function.
-(>>^) :: Arrow a => a b c -> (c -> d) -> a b d
-a >>^ f = a >>> arr f
-
--- | Right-to-left composition, for a better fit with arrow notation.
-(<<<) :: Arrow a => a c d -> a b c -> a b d
-f <<< g = g >>> f
-
--- | Precomposition with a pure function (right-to-left variant).
-(<<^) :: Arrow a => a c d -> (b -> c) -> a b d
-a <<^ f = a <<< arr f
-
--- | Postcomposition with a pure function (right-to-left variant).
-(^<<) :: Arrow a => (c -> d) -> a b c -> a b d
-f ^<< a = arr f <<< a
-
-class Arrow a => ArrowZero a where
-       zeroArrow :: a b c
-
-instance MonadPlus m => ArrowZero (Kleisli m) where
-       zeroArrow = Kleisli (\x -> mzero)
-
-class ArrowZero a => ArrowPlus a where
-       (<+>) :: a b c -> a b c -> a b c
-
-instance MonadPlus m => ArrowPlus (Kleisli m) where
-       Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)
-
--- | Choice, for arrows that support it.  This class underlies the
---   @if@ and @case@ constructs in arrow notation.
---   Any instance must define 'left'.  The other combinators have sensible
---   default definitions, which may be overridden for efficiency.
-
-class Arrow a => ArrowChoice a where
-
-       -- | Feed marked inputs through the argument arrow, passing the
-       --   rest through unchanged to the output.
-       left :: a b c -> a (Either b d) (Either c d)
-
-       -- | A mirror image of 'left'.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       right :: a b c -> a (Either d b) (Either d c)
-       right f = arr mirror >>> left f >>> arr mirror
-                       where   mirror (Left x) = Right x
-                               mirror (Right y) = Left y
-
-       -- | Split the input between the two argument arrows, retagging
-       --   and merging their outputs.
-       --   Note that this is in general not a functor.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
-       f +++ g = left f >>> right g
-
-       -- | Fanin: Split the input between the two argument arrows and
-       --   merge their outputs.
-       --
-       --   The default definition may be overridden with a more efficient
-       --   version if desired.
-       (|||) :: a b d -> a c d -> a (Either b c) d
-       f ||| g = f +++ g >>> arr untag
-                       where   untag (Left x) = x
-                               untag (Right y) = y
-
-{-# RULES
-"left/arr"     forall f .
-               left (arr f) = arr (left f)
-"right/arr"    forall f .
-               right (arr f) = arr (right f)
-"sum/arr"      forall f g .
-               arr f +++ arr g = arr (f +++ g)
-"fanin/arr"    forall f g .
-               arr f ||| arr g = arr (f ||| g)
-"compose/left" forall f g .
-               left f >>> left g = left (f >>> g)
-"compose/right"        forall f g .
-               right f >>> right g = right (f >>> g)
- #-}
-
-instance ArrowChoice (->) where
-       left f = f +++ id
-       right f = id +++ f
-       f +++ g = (Left . f) ||| (Right . g)
-       (|||) = either
-
-instance Monad m => ArrowChoice (Kleisli m) where
-       left f = f +++ arr id
-       right f = arr id +++ f
-       f +++ g = (f >>> arr Left) ||| (g >>> arr Right)
-       Kleisli f ||| Kleisli g = Kleisli (either f g)
-
--- | Some arrows allow application of arrow inputs to other inputs.
-
-class Arrow a => ArrowApply a where
-       app :: a (a b c, b) c
-
-instance ArrowApply (->) where
-       app (f,x) = f x
-
-instance Monad m => ArrowApply (Kleisli m) where
-       app = Kleisli (\(Kleisli f, x) -> f x)
-
--- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise
---   to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad.
-
-newtype ArrowApply a => ArrowMonad a b = ArrowMonad (a () b)
-
-instance ArrowApply a => Monad (ArrowMonad a) where
-       return x = ArrowMonad (arr (\z -> x))
-       ArrowMonad m >>= f = ArrowMonad (m >>>
-                       arr (\x -> let ArrowMonad h = f x in (h, ())) >>>
-                       app)
-
--- | Any instance of 'ArrowApply' can be made into an instance of
---   'ArrowChoice' by defining 'left' = 'leftApp'.
-
-leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d)
-leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||
-                (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app
-
--- | The 'loop' operator expresses computations in which an output value is
---   fed back as input, even though the computation occurs only once.
---   It underlies the @rec@ value recursion construct in arrow notation.
-
-class Arrow a => ArrowLoop a where
-       loop :: a (b,d) (c,d) -> a b c
-
-instance ArrowLoop (->) where
-       loop f b = let (c,d) = f (b,d) in c
-
-instance MonadFix m => ArrowLoop (Kleisli m) where
-       loop (Kleisli f) = Kleisli (liftM fst . mfix . f')
-               where   f' x y = f (x, snd y)
diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
deleted file mode 100644 (file)
index 45d2029..0000000
+++ /dev/null
@@ -1,546 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- A common interface to a collection of useful concurrency
--- abstractions.
---
------------------------------------------------------------------------------
-
-module Control.Concurrent (
-       -- * Concurrent Haskell
-
-       -- $conc_intro
-
-       -- * Basic concurrency operations
-
-        ThreadId,
-#ifdef __GLASGOW_HASKELL__
-       myThreadId,
-#endif
-
-       forkIO,
-#ifdef __GLASGOW_HASKELL__
-       killThread,
-       throwTo,
-#endif
-
-       -- * Scheduling
-
-       -- $conc_scheduling     
-       yield,                  -- :: IO ()
-
-       -- ** Blocking
-       
-       -- $blocking
-
-#ifdef __GLASGOW_HASKELL__
-       -- ** Waiting
-       threadDelay,            -- :: Int -> IO ()
-       threadWaitRead,         -- :: Int -> IO ()
-       threadWaitWrite,        -- :: Int -> IO ()
-#endif
-
-       -- * Communication abstractions
-
-       module Control.Concurrent.MVar,
-       module Control.Concurrent.Chan,
-       module Control.Concurrent.QSem,
-       module Control.Concurrent.QSemN,
-       module Control.Concurrent.SampleVar,
-
-       -- * Merging of streams
-#ifndef __HUGS__
-       mergeIO,                -- :: [a]   -> [a] -> IO [a]
-       nmergeIO,               -- :: [[a]] -> IO [a]
-#endif
-       -- $merge
-
-#ifdef __GLASGOW_HASKELL__
-       -- * Bound Threads
-       -- $boundthreads
-       rtsSupportsBoundThreads,
-       forkOS,
-       isCurrentThreadBound,
-       runInBoundThread,
-       runInUnboundThread
-#endif
-
-       -- * GHC's implementation of concurrency
-
-       -- |This section describes features specific to GHC's
-       -- implementation of Concurrent Haskell.
-       
-       -- ** Haskell threads and Operating System threads
-
-       -- $osthreads
-
-       -- ** Terminating the program
-
-       -- $termination
-
-       -- ** Pre-emption
-
-       -- $preemption
-    ) where
-
-import Prelude
-
-import Control.Exception as Exception
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Conc                ( ThreadId(..), myThreadId, killThread, yield,
-                         threadDelay, threadWaitRead, threadWaitWrite,
-                         forkIO, childHandler )
-import GHC.TopHandler   ( reportStackOverflow, reportError )
-import GHC.IOBase      ( IO(..) )
-import GHC.IOBase      ( unsafeInterleaveIO )
-import GHC.IOBase      ( newIORef, readIORef, writeIORef )
-import GHC.Base
-
-import Foreign.StablePtr
-import Foreign.C.Types  ( CInt )
-import Control.Monad    ( when )
-#endif
-
-#ifdef __HUGS__
-import Hugs.ConcBase
-#endif
-
-import Control.Concurrent.MVar
-import Control.Concurrent.Chan
-import Control.Concurrent.QSem
-import Control.Concurrent.QSemN
-import Control.Concurrent.SampleVar
-
-#ifdef __HUGS__
-type ThreadId = ()
-#endif
-
-{- $conc_intro
-
-The concurrency extension for Haskell is described in the paper
-/Concurrent Haskell/
-<http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.
-
-Concurrency is \"lightweight\", which means that both thread creation
-and context switching overheads are extremely low.  Scheduling of
-Haskell threads is done internally in the Haskell runtime system, and
-doesn't make use of any operating system-supplied thread packages.
-
-However, if you want to interact with a foreign library that expects your
-program to use the operating system-supplied thread package, you can do so
-by using 'forkOS' instead of 'forkIO'.
-
-Haskell threads can communicate via 'MVar's, a kind of synchronised
-mutable variable (see "Control.Concurrent.MVar").  Several common
-concurrency abstractions can be built from 'MVar's, and these are
-provided by the "Control.Concurrent" library.
-In GHC, threads may also communicate via exceptions.
--}
-
-{- $conc_scheduling
-
-    Scheduling may be either pre-emptive or co-operative,
-    depending on the implementation of Concurrent Haskell (see below
-    for information related to specific compilers).  In a co-operative
-    system, context switches only occur when you use one of the
-    primitives defined in this module.  This means that programs such
-    as:
-
-
->   main = forkIO (write 'a') >> write 'b'
->     where write c = putChar c >> write c
-
-    will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
-    instead of some random interleaving of @a@s and @b@s.  In
-    practice, cooperative multitasking is sufficient for writing
-    simple graphical user interfaces.  
--}
-
-{- $blocking
-Different Haskell implementations have different characteristics with
-regard to which operations block /all/ threads.
-
-Using GHC without the @-threaded@ option, all foreign calls will block
-all other Haskell threads in the system, although I\/O operations will
-not.  With the @-threaded@ option, only foreign calls with the @unsafe@
-attribute will block all other threads.
-
-Using Hugs, all I\/O operations and foreign calls will block all other
-Haskell threads.
--}
-
-#ifndef __HUGS__
-max_buff_size :: Int
-max_buff_size = 1
-
-mergeIO :: [a] -> [a] -> IO [a]
-nmergeIO :: [[a]] -> IO [a]
-
--- $merge
--- The 'mergeIO' and 'nmergeIO' functions fork one thread for each
--- input list that concurrently evaluates that list; the results are
--- merged into a single output list.  
---
--- Note: Hugs does not provide these functions, since they require
--- preemptive multitasking.
-
-mergeIO ls rs
- = newEmptyMVar                       >>= \ tail_node ->
-   newMVar tail_node          >>= \ tail_list ->
-   newQSem max_buff_size       >>= \ e ->
-   newMVar 2                   >>= \ branches_running ->
-   let
-    buff = (tail_list,e)
-   in
-    forkIO (suckIO branches_running buff ls) >>
-    forkIO (suckIO branches_running buff rs) >>
-    takeMVar tail_node >>= \ val ->
-    signalQSem e       >>
-    return val
-
-type Buffer a 
- = (MVar (MVar [a]), QSem)
-
-suckIO :: MVar Int -> Buffer a -> [a] -> IO ()
-
-suckIO branches_running buff@(tail_list,e) vs
- = case vs of
-       [] -> takeMVar branches_running >>= \ val ->
-             if val == 1 then
-                takeMVar tail_list     >>= \ node ->
-                putMVar node []        >>
-                putMVar tail_list node
-             else      
-                putMVar branches_running (val-1)
-       (x:xs) ->
-               waitQSem e                       >>
-               takeMVar tail_list               >>= \ node ->
-               newEmptyMVar                     >>= \ next_node ->
-               unsafeInterleaveIO (
-                       takeMVar next_node  >>= \ y ->
-                       signalQSem e        >>
-                       return y)                >>= \ next_node_val ->
-               putMVar node (x:next_node_val)   >>
-               putMVar tail_list next_node      >>
-               suckIO branches_running buff xs
-
-nmergeIO lss
- = let
-    len = length lss
-   in
-    newEmptyMVar         >>= \ tail_node ->
-    newMVar tail_node    >>= \ tail_list ->
-    newQSem max_buff_size >>= \ e ->
-    newMVar len                  >>= \ branches_running ->
-    let
-     buff = (tail_list,e)
-    in
-    mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >>
-    takeMVar tail_node >>= \ val ->
-    signalQSem e       >>
-    return val
-  where
-    mapIO f xs = sequence (map f xs)
-#endif /* __HUGS__ */
-
-#ifdef __GLASGOW_HASKELL__
--- ---------------------------------------------------------------------------
--- Bound Threads
-
-{- $boundthreads
-   #boundthreads#
-
-Support for multiple operating system threads and bound threads as described
-below is currently only available in the GHC runtime system if you use the
-/-threaded/ option when linking.
-
-Other Haskell systems do not currently support multiple operating system threads.
-
-A bound thread is a haskell thread that is /bound/ to an operating system
-thread. While the bound thread is still scheduled by the Haskell run-time
-system, the operating system thread takes care of all the foreign calls made
-by the bound thread.
-
-To a foreign library, the bound thread will look exactly like an ordinary
-operating system thread created using OS functions like @pthread_create@
-or @CreateThread@.
-
-Bound threads can be created using the 'forkOS' function below. All foreign
-exported functions are run in a bound thread (bound to the OS thread that
-called the function). Also, the @main@ action of every Haskell program is
-run in a bound thread.
-
-Why do we need this? Because if a foreign library is called from a thread
-created using 'forkIO', it won't have access to any /thread-local state/ - 
-state variables that have specific values for each OS thread
-(see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some
-libraries (OpenGL, for example) will not work from a thread created using
-'forkIO'. They work fine in threads created using 'forkOS' or when called
-from @main@ or from a @foreign export@.
--}
-
--- | 'True' if bound threads are supported.
--- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'
--- will always return 'False' and both 'forkOS' and 'runInBoundThread' will
--- fail.
-foreign import ccall rtsSupportsBoundThreads :: Bool
-
-
-{- |
-Like 'forkIO', this sparks off a new thread to run the 'IO' computation passed as the
-first argument, and returns the 'ThreadId' of the newly created
-thread.
-
-However, @forkOS@ uses operating system-supplied multithreading support to create
-a new operating system thread. The new thread is /bound/, which means that
-all foreign calls made by the 'IO' computation are guaranteed to be executed
-in this new operating system thread; also, the operating system thread is not
-used for any other foreign calls.
-
-This means that you can use all kinds of foreign libraries from this thread 
-(even those that rely on thread-local state), without the limitations of 'forkIO'.
-
-Just to clarify, 'forkOS' is /only/ necessary if you need to associate
-a Haskell thread with a particular OS thread.  It is not necessary if
-you only need to make non-blocking foreign calls (see
-"Control.Concurrent#osthreads").  Neither is it necessary if you want
-to run threads in parallel on a multiprocessor: threads created with
-'forkIO' will be shared out amongst the running CPUs (using GHC,
-@-threaded@, and the @+RTS -N@ runtime option).
-
--}
-forkOS :: IO () -> IO ThreadId
-
-foreign export ccall forkOS_entry
-    :: StablePtr (IO ()) -> IO ()
-
-foreign import ccall "forkOS_entry" forkOS_entry_reimported
-    :: StablePtr (IO ()) -> IO ()
-
-forkOS_entry stableAction = do
-       action <- deRefStablePtr stableAction
-       action
-
-foreign import ccall forkOS_createThread
-    :: StablePtr (IO ()) -> IO CInt
-
-failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
-                       ++"(use ghc -threaded when linking)"
-    
-forkOS action 
-    | rtsSupportsBoundThreads = do
-       mv <- newEmptyMVar
-       let action_plus = Exception.catch action childHandler
-       entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
-       err <- forkOS_createThread entry
-       when (err /= 0) $ fail "Cannot create OS thread."
-       tid <- takeMVar mv
-       freeStablePtr entry
-       return tid
-    | otherwise = failNonThreaded
-
--- | Returns 'True' if the calling thread is /bound/, that is, if it is
--- safe to use foreign libraries that rely on thread-local state from the
--- calling thread.
-isCurrentThreadBound :: IO Bool
-isCurrentThreadBound = IO $ \ s# -> 
-    case isCurrentThreadBound# s# of
-        (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
-
-
-{- | 
-Run the 'IO' computation passed as the first argument. If the calling thread
-is not /bound/, a bound thread is created temporarily. @runInBoundThread@
-doesn't finish until the 'IO' computation finishes.
-
-You can wrap a series of foreign function calls that rely on thread-local state
-with @runInBoundThread@ so that you can use them without knowing whether the
-current thread is /bound/.
--}
-runInBoundThread :: IO a -> IO a
-
-runInBoundThread action
-    | rtsSupportsBoundThreads = do
-       bound <- isCurrentThreadBound
-       if bound
-           then action
-           else do
-               ref <- newIORef undefined
-               let action_plus = Exception.try action >>= writeIORef ref
-               resultOrException <- 
-                   bracket (newStablePtr action_plus)
-                           freeStablePtr
-                           (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref)
-               case resultOrException of
-                   Left exception -> Exception.throw exception
-                   Right result -> return result
-    | otherwise = failNonThreaded
-
-{- | 
-Run the 'IO' computation passed as the first argument. If the calling thread
-is /bound/, an unbound thread is created temporarily using 'forkIO'.
-@runInBoundThread@ doesn't finish until the 'IO' computation finishes.
-
-Use this function /only/ in the rare case that you have actually observed a
-performance loss due to the use of bound threads. A program that
-doesn't need it's main thread to be bound and makes /heavy/ use of concurrency
-(e.g. a web server), might want to wrap it's @main@ action in
-@runInUnboundThread@.
--}
-runInUnboundThread :: IO a -> IO a
-
-runInUnboundThread action = do
-    bound <- isCurrentThreadBound
-    if bound
-        then do
-            mv <- newEmptyMVar
-            forkIO (Exception.try action >>= putMVar mv)
-            takeMVar mv >>= \either -> case either of
-                Left exception -> Exception.throw exception
-                Right result -> return result
-        else action
-       
-#endif /* __GLASGOW_HASKELL__ */
-
--- ---------------------------------------------------------------------------
--- More docs
-
-{- $osthreads
-
-      #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and
-      are managed entirely by the GHC runtime.  Typically Haskell
-      threads are an order of magnitude or two more efficient (in
-      terms of both time and space) than operating system threads.
-
-      The downside of having lightweight threads is that only one can
-      run at a time, so if one thread blocks in a foreign call, for
-      example, the other threads cannot continue.  The GHC runtime
-      works around this by making use of full OS threads where
-      necessary.  When the program is built with the @-threaded@
-      option (to link against the multithreaded version of the
-      runtime), a thread making a @safe@ foreign call will not block
-      the other threads in the system; another OS thread will take
-      over running Haskell threads until the original call returns.
-      The runtime maintains a pool of these /worker/ threads so that
-      multiple Haskell threads can be involved in external calls
-      simultaneously.
-
-      The "System.IO" library manages multiplexing in its own way.  On
-      Windows systems it uses @safe@ foreign calls to ensure that
-      threads doing I\/O operations don't block the whole runtime,
-      whereas on Unix systems all the currently blocked I\/O reqwests
-      are managed by a single thread (the /IO manager thread/) using
-      @select@.
-
-      The runtime will run a Haskell thread using any of the available
-      worker OS threads.  If you need control over which particular OS
-      thread is used to run a given Haskell thread, perhaps because
-      you need to call a foreign library that uses OS-thread-local
-      state, then you need bound threads (see "Control.Concurrent#boundthreads").
-
-      If you don't use the @-threaded@ option, then the runtime does
-      not make use of multiple OS threads.  Foreign calls will block
-      all other running Haskell threads until the call returns.  The
-      "System.IO" library still does multiplexing, so there can be multiple
-      threads doing I\/O, and this is handled internally by the runtime using
-      @select@.
--}
-
-{- $termination
-
-      In a standalone GHC program, only the main thread is
-      required to terminate in order for the process to terminate.
-      Thus all other forked threads will simply terminate at the same
-      time as the main thread (the terminology for this kind of
-      behaviour is \"daemonic threads\").
-
-      If you want the program to wait for child threads to
-      finish before exiting, you need to program this yourself.  A
-      simple mechanism is to have each child thread write to an
-      'MVar' when it completes, and have the main
-      thread wait on all the 'MVar's before
-      exiting:
-
->   myForkIO :: IO () -> IO (MVar ())
->   myForkIO io = do
->     mvar <- newEmptyMVar
->     forkIO (io `finally` putMVar mvar ())
->     return mvar
-
-      Note that we use 'finally' from the
-      "Control.Exception" module to make sure that the
-      'MVar' is written to even if the thread dies or
-      is killed for some reason.
-
-      A better method is to keep a global list of all child
-      threads which we should wait for at the end of the program:
-
->    children :: MVar [MVar ()]
->    children = unsafePerformIO (newMVar [])
->    
->    waitForChildren :: IO ()
->    waitForChildren = do
->      cs <- takeMVar children
->      case cs of
->        []   -> return ()
->        m:ms -> do
->          putMVar children ms
->          takeMVar m
->          waitForChildren
->    
->    forkChild :: IO () -> IO ()
->    forkChild io = do
->       mvar <- newEmptyMVar
->       childs <- takeMVar children
->       putMVar children (mvar:childs)
->       forkIO (io `finally` putMVar mvar ())
->
->     main =
->      later waitForChildren $
->      ...
-
-      The main thread principle also applies to calls to Haskell from
-      outside, using @foreign export@.  When the @foreign export@ed
-      function is invoked, it starts a new main thread, and it returns
-      when this main thread terminates.  If the call causes new
-      threads to be forked, they may remain in the system after the
-      @foreign export@ed function has returned.
--}
-
-{- $preemption
-
-      GHC implements pre-emptive multitasking: the execution of
-      threads are interleaved in a random fashion.  More specifically,
-      a thread may be pre-empted whenever it allocates some memory,
-      which unfortunately means that tight loops which do no
-      allocation tend to lock out other threads (this only seems to
-      happen with pathological benchmark-style code, however).
-
-      The rescheduling timer runs on a 20ms granularity by
-      default, but this may be altered using the
-      @-i\<n\>@ RTS option.  After a rescheduling
-      \"tick\" the running thread is pre-empted as soon as
-      possible.
-
-      One final note: the
-      @aaaa@ @bbbb@ example may not
-      work too well on GHC (see Scheduling, above), due
-      to the locking on a 'System.IO.Handle'.  Only one thread
-      may hold the lock on a 'System.IO.Handle' at any one
-      time, so if a reschedule happens while a thread is holding the
-      lock, the other thread won't be able to run.  The upshot is that
-      the switch from @aaaa@ to
-      @bbbbb@ happens infrequently.  It can be
-      improved by lowering the reschedule tick period.  We also have a
-      patch that causes a reschedule whenever a thread waiting on a
-      lock is woken up, but haven't found it to be useful for anything
-      other than this example :-)
--}
diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs
deleted file mode 100644 (file)
index 1fca981..0000000
+++ /dev/null
@@ -1,132 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.Chan
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- Unbounded channels.
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.Chan
-  ( 
-         -- * The 'Chan' type
-       Chan,                   -- abstract
-
-         -- * Operations
-       newChan,                -- :: IO (Chan a)
-       writeChan,              -- :: Chan a -> a -> IO ()
-       readChan,               -- :: Chan a -> IO a
-       dupChan,                -- :: Chan a -> IO (Chan a)
-       unGetChan,              -- :: Chan a -> a -> IO ()
-       isEmptyChan,            -- :: Chan a -> IO Bool
-
-         -- * Stream interface
-       getChanContents,        -- :: Chan a -> IO [a]
-       writeList2Chan,         -- :: Chan a -> [a] -> IO ()
-   ) where
-
-import Prelude
-
-import System.IO.Unsafe                ( unsafeInterleaveIO )
-import Control.Concurrent.MVar
-import Data.Typeable
-
-#include "Typeable.h"
-
--- A channel is represented by two @MVar@s keeping track of the two ends
--- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
--- are used to handle consumers trying to read from an empty channel.
-
--- |'Chan' is an abstract type representing an unbounded FIFO channel.
-data Chan a
- = Chan (MVar (Stream a))
-        (MVar (Stream a))
-
-INSTANCE_TYPEABLE1(Chan,chanTc,"Chan")
-
-type Stream a = MVar (ChItem a)
-
-data ChItem a = ChItem a (Stream a)
-
--- See the Concurrent Haskell paper for a diagram explaining the
--- how the different channel operations proceed.
-
--- @newChan@ sets up the read and write end of a channel by initialising
--- these two @MVar@s with an empty @MVar@.
-
--- |Build and returns a new instance of 'Chan'.
-newChan :: IO (Chan a)
-newChan = do
-   hole  <- newEmptyMVar
-   read  <- newMVar hole
-   write <- newMVar hole
-   return (Chan read write)
-
--- To put an element on a channel, a new hole at the write end is created.
--- What was previously the empty @MVar@ at the back of the channel is then
--- filled in with a new stream element holding the entered value and the
--- new hole.
-
--- |Write a value to a 'Chan'.
-writeChan :: Chan a -> a -> IO ()
-writeChan (Chan _read write) val = do
-  new_hole <- newEmptyMVar
-  modifyMVar_ write $ \old_hole -> do
-    putMVar old_hole (ChItem val new_hole)
-    return new_hole
-
--- |Read the next value from the 'Chan'.
-readChan :: Chan a -> IO a
-readChan (Chan read _write) = do
-  modifyMVar read $ \read_end -> do
-    (ChItem val new_read_end) <- readMVar read_end
-       -- Use readMVar here, not takeMVar,
-       -- else dupChan doesn't work
-    return (new_read_end, val)
-
--- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
--- either channel from then on will be available from both.  Hence this creates
--- a kind of broadcast channel, where data written by anyone is seen by
--- everyone else.
-dupChan :: Chan a -> IO (Chan a)
-dupChan (Chan _read write) = do
-   hole     <- readMVar write
-   new_read <- newMVar hole
-   return (Chan new_read write)
-
--- |Put a data item back onto a channel, where it will be the next item read.
-unGetChan :: Chan a -> a -> IO ()
-unGetChan (Chan read _write) val = do
-   new_read_end <- newEmptyMVar
-   modifyMVar_ read $ \read_end -> do
-     putMVar new_read_end (ChItem val read_end)
-     return new_read_end
-
--- |Returns 'True' if the supplied 'Chan' is empty.
-isEmptyChan :: Chan a -> IO Bool
-isEmptyChan (Chan read write) = do
-   withMVar read $ \r -> do
-     w <- readMVar write
-     let eq = r == w
-     eq `seq` return eq
-
--- Operators for interfacing with functional streams.
-
--- |Return a lazy list representing the contents of the supplied
--- 'Chan', much like 'System.IO.hGetContents'.
-getChanContents :: Chan a -> IO [a]
-getChanContents ch
-  = unsafeInterleaveIO (do
-       x  <- readChan ch
-       xs <- getChanContents ch
-       return (x:xs)
-    )
-
--- |Write an entire list of items to a 'Chan'.
-writeList2Chan :: Chan a -> [a] -> IO ()
-writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
deleted file mode 100644 (file)
index 7213cf1..0000000
+++ /dev/null
@@ -1,114 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.MVar
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- Synchronising variables
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.MVar
-       ( 
-         -- * @MVar@s
-         MVar          -- abstract
-       , newEmptyMVar  -- :: IO (MVar a)
-       , newMVar       -- :: a -> IO (MVar a)
-       , takeMVar      -- :: MVar a -> IO a
-       , putMVar       -- :: MVar a -> a -> IO ()
-       , readMVar      -- :: MVar a -> IO a
-       , swapMVar      -- :: MVar a -> a -> IO a
-       , tryTakeMVar   -- :: MVar a -> IO (Maybe a)
-       , tryPutMVar    -- :: MVar a -> a -> IO Bool
-       , isEmptyMVar   -- :: MVar a -> IO Bool
-       , withMVar      -- :: MVar a -> (a -> IO b) -> IO b
-       , modifyMVar_   -- :: MVar a -> (a -> IO a) -> IO ()
-       , modifyMVar    -- :: MVar a -> (a -> IO (a,b)) -> IO b
-#ifndef __HUGS__
-       , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
-#endif
-    ) where
-
-#ifdef __HUGS__
-import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
-                 tryTakeMVar, tryPutMVar, isEmptyMVar,
-               )
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Conc        ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
-                 tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
-               )
-#endif
-
-import Prelude
-import Control.Exception as Exception
-
-{-|
-  This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
-  from the 'MVar', puts it back, and also returns it.
--}
-readMVar :: MVar a -> IO a
-readMVar m =
-  block $ do
-    a <- takeMVar m
-    putMVar m a
-    return a
-
--- |Swap the contents of an 'MVar' for a new value.
-swapMVar :: MVar a -> a -> IO a
-swapMVar mvar new =
-  block $ do
-    old <- takeMVar mvar
-    putMVar mvar new
-    return old
-
-{-|
-  'withMVar' is a safe wrapper for operating on the contents of an
-  'MVar'.  This operation is exception-safe: it will replace the
-  original contents of the 'MVar' if an exception is raised (see
-  "Control.Exception").
--}
-{-# INLINE withMVar #-}
--- inlining has been reported to have dramatic effects; see
--- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
-withMVar :: MVar a -> (a -> IO b) -> IO b
-withMVar m io = 
-  block $ do
-    a <- takeMVar m
-    b <- Exception.catch (unblock (io a))
-           (\e -> do putMVar m a; throw e)
-    putMVar m a
-    return b
-
-{-|
-  A safe wrapper for modifying the contents of an 'MVar'.  Like 'withMVar', 
-  'modifyMVar' will replace the original contents of the 'MVar' if an
-  exception is raised during the operation.
--}
-{-# INLINE modifyMVar_ #-}
-modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
-modifyMVar_ m io = 
-  block $ do
-    a  <- takeMVar m
-    a' <- Exception.catch (unblock (io a))
-           (\e -> do putMVar m a; throw e)
-    putMVar m a'
-
-{-|
-  A slight variation on 'modifyMVar_' that allows a value to be
-  returned (@b@) in addition to the modified value of the 'MVar'.
--}
-{-# INLINE modifyMVar #-}
-modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
-modifyMVar m io = 
-  block $ do
-    a      <- takeMVar m
-    (a',b) <- Exception.catch (unblock (io a))
-               (\e -> do putMVar m a; throw e)
-    putMVar m a'
-    return b
diff --git a/Control/Concurrent/QSem.hs b/Control/Concurrent/QSem.hs
deleted file mode 100644 (file)
index 5a512d8..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.QSem
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- Simple quantity semaphores.
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.QSem
-       ( -- * Simple Quantity Semaphores
-         QSem,         -- abstract
-         newQSem,      -- :: Int  -> IO QSem
-         waitQSem,     -- :: QSem -> IO ()
-         signalQSem    -- :: QSem -> IO ()
-       ) where
-
-import Prelude
-import Control.Concurrent.MVar
-import Data.Typeable
-
-#include "Typeable.h"
-
--- General semaphores are also implemented readily in terms of shared
--- @MVar@s, only have to catch the case when the semaphore is tried
--- waited on when it is empty (==0). Implement this in the same way as
--- shared variables are implemented - maintaining a list of @MVar@s
--- representing threads currently waiting. The counter is a shared
--- variable, ensuring the mutual exclusion on its access.
-
--- |A 'QSem' is a simple quantity semaphore, in which the available
--- \"quantity\" is always dealt with in units of one.
-newtype QSem = QSem (MVar (Int, [MVar ()]))
-
-INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")
-
--- |Build a new 'QSem'
-newQSem :: Int -> IO QSem
-newQSem init = do
-   sem <- newMVar (init,[])
-   return (QSem sem)
-
--- |Wait for a unit to become available
-waitQSem :: QSem -> IO ()
-waitQSem (QSem sem) = do
-   (avail,blocked) <- takeMVar sem  -- gain ex. access
-   if avail > 0 then
-     putMVar sem (avail-1,[])
-    else do
-     block <- newEmptyMVar
-      {-
-       Stuff the reader at the back of the queue,
-       so as to preserve waiting order. A signalling
-       process then only have to pick the MVar at the
-       front of the blocked list.
-
-       The version of waitQSem given in the paper could
-       lead to starvation.
-      -}
-     putMVar sem (0, blocked++[block])
-     takeMVar block
-
--- |Signal that a unit of the 'QSem' is available
-signalQSem :: QSem -> IO ()
-signalQSem (QSem sem) = do
-   (avail,blocked) <- takeMVar sem
-   case blocked of
-     [] -> putMVar sem (avail+1,[])
-
-     (block:blocked') -> do
-          putMVar sem (0,blocked')
-          putMVar block ()
diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs
deleted file mode 100644 (file)
index 56c5e50..0000000
+++ /dev/null
@@ -1,70 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.QSemN
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- Quantity semaphores in which each thread may wait for an arbitrary
--- \"amount\".
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.QSemN
-       (  -- * General Quantity Semaphores
-         QSemN,        -- abstract
-         newQSemN,     -- :: Int   -> IO QSemN
-         waitQSemN,    -- :: QSemN -> Int -> IO ()
-         signalQSemN   -- :: QSemN -> Int -> IO ()
-      ) where
-
-import Prelude
-
-import Control.Concurrent.MVar
-import Data.Typeable
-
-#include "Typeable.h"
-
--- |A 'QSemN' is a quantity semaphore, in which the available
--- \"quantity\" may be signalled or waited for in arbitrary amounts.
-newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())]))
-
-INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN")
-
--- |Build a new 'QSemN' with a supplied initial quantity.
-newQSemN :: Int -> IO QSemN 
-newQSemN init = do
-   sem <- newMVar (init,[])
-   return (QSemN sem)
-
--- |Wait for the specified quantity to become available
-waitQSemN :: QSemN -> Int -> IO ()
-waitQSemN (QSemN sem) sz = do
-  (avail,blocked) <- takeMVar sem   -- gain ex. access
-  if (avail - sz) >= 0 then
-       -- discharging 'sz' still leaves the semaphore
-       -- in an 'unblocked' state.
-     putMVar sem (avail-sz,blocked)
-   else do
-     block <- newEmptyMVar
-     putMVar sem (avail, blocked++[(sz,block)])
-     takeMVar block
-
--- |Signal that a given quantity is now available from the 'QSemN'.
-signalQSemN :: QSemN -> Int  -> IO ()
-signalQSemN (QSemN sem) n = do
-   (avail,blocked)   <- takeMVar sem
-   (avail',blocked') <- free (avail+n) blocked
-   putMVar sem (avail',blocked')
- where
-   free avail []    = return (avail,[])
-   free avail ((req,block):blocked)
-     | avail >= req = do
-       putMVar block ()
-       free (avail-req) blocked
-     | otherwise    = do
-       (avail',blocked') <- free avail blocked
-        return (avail',(req,block):blocked')
diff --git a/Control/Concurrent/SampleVar.hs b/Control/Concurrent/SampleVar.hs
deleted file mode 100644 (file)
index 4d88a19..0000000
+++ /dev/null
@@ -1,117 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.SampleVar
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (concurrency)
---
--- Sample variables
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.SampleVar
-       (
-        -- * Sample Variables
-         SampleVar,         -- :: type _ =
-        newEmptySampleVar, -- :: IO (SampleVar a)
-         newSampleVar,      -- :: a -> IO (SampleVar a)
-        emptySampleVar,    -- :: SampleVar a -> IO ()
-        readSampleVar,     -- :: SampleVar a -> IO a
-        writeSampleVar,    -- :: SampleVar a -> a -> IO ()
-        isEmptySampleVar,  -- :: SampleVar a -> IO Bool
-
-       ) where
-
-import Prelude
-
-import Control.Concurrent.MVar
-
--- |
--- Sample variables are slightly different from a normal 'MVar':
--- 
---  * Reading an empty 'SampleVar' causes the reader to block.
---    (same as 'takeMVar' on empty 'MVar')
--- 
---  * Reading a filled 'SampleVar' empties it and returns value.
---    (same as 'takeMVar')
--- 
---  * Writing to an empty 'SampleVar' fills it with a value, and
---    potentially, wakes up a blocked reader (same as for 'putMVar' on
---    empty 'MVar').
---
---  * Writing to a filled 'SampleVar' overwrites the current value.
---    (different from 'putMVar' on full 'MVar'.)
-
-type SampleVar a
- = MVar (Int,          -- 1  == full
-                       -- 0  == empty
-                       -- <0 no of readers blocked
-          MVar a)
-
--- |Build a new, empty, 'SampleVar'
-newEmptySampleVar :: IO (SampleVar a)
-newEmptySampleVar = do
-   v <- newEmptyMVar
-   newMVar (0,v)
-
--- |Build a 'SampleVar' with an initial value.
-newSampleVar :: a -> IO (SampleVar a)
-newSampleVar a = do
-   v <- newEmptyMVar
-   putMVar v a
-   newMVar (1,v)
-
--- |If the SampleVar is full, leave it empty.  Otherwise, do nothing.
-emptySampleVar :: SampleVar a -> IO ()
-emptySampleVar v = do
-   (readers, var) <- takeMVar v
-   if readers > 0 then do
-     takeMVar var
-     putMVar v (0,var)
-    else
-     putMVar v (readers,var)
-
--- |Wait for a value to become available, then take it and return.
-readSampleVar :: SampleVar a -> IO a
-readSampleVar svar = do
---
--- filled => make empty and grab sample
--- not filled => try to grab value, empty when read val.
---
-   (readers,val) <- takeMVar svar
-   putMVar svar (readers-1,val)
-   takeMVar val
-
--- |Write a value into the 'SampleVar', overwriting any previous value that
--- was there.
-writeSampleVar :: SampleVar a -> a -> IO ()
-writeSampleVar svar v = do
---
--- filled => overwrite
--- not filled => fill, write val
---
-   (readers,val) <- takeMVar svar
-   case readers of
-     1 -> 
-       swapMVar val v >> 
-       putMVar svar (1,val)
-     _ -> 
-       putMVar val v >> 
-       putMVar svar (min 1 (readers+1), val)
-
--- | Returns 'True' if the 'SampleVar' is currently empty.
---
--- Note that this function is only useful if you know that no other
--- threads can be modifying the state of the 'SampleVar', because
--- otherwise the state of the 'SampleVar' may have changed by the time
--- you see the result of 'isEmptySampleVar'.
---
-isEmptySampleVar :: SampleVar a -> IO Bool
-isEmptySampleVar svar = do
-   (readers,val) <- readMVar svar
-   return (readers == 0)
-
diff --git a/Control/Exception.hs b/Control/Exception.hs
deleted file mode 100644 (file)
index e52f674..0000000
+++ /dev/null
@@ -1,592 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Exception
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (extended exceptions)
---
--- This module provides support for raising and catching both built-in
--- and user-defined exceptions.
---
--- In addition to exceptions thrown by 'IO' operations, exceptions may
--- be thrown by pure code (imprecise exceptions) or by external events
--- (asynchronous exceptions), but may only be caught in the 'IO' monad.
--- For more details, see:
---
---  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
---    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
---    in /PLDI'99/.
---
---  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
---    Jones, Andy Moran and John Reppy, in /PLDI'01/.
---
------------------------------------------------------------------------------
-
-module Control.Exception (
-
-       -- * The Exception type
-       Exception(..),          -- instance Eq, Ord, Show, Typeable
-       IOException,            -- instance Eq, Ord, Show, Typeable
-       ArithException(..),     -- instance Eq, Ord, Show, Typeable
-       ArrayException(..),     -- instance Eq, Ord, Show, Typeable
-       AsyncException(..),     -- instance Eq, Ord, Show, Typeable
-
-       -- * Throwing exceptions
-       throwIO,        -- :: Exception -> IO a
-       throw,          -- :: Exception -> a
-       ioError,        -- :: IOError -> IO a
-#ifdef __GLASGOW_HASKELL__
-       throwTo,        -- :: ThreadId -> Exception -> a
-#endif
-
-       -- * Catching Exceptions
-
-       -- |There are several functions for catching and examining
-       -- exceptions; all of them may only be used from within the
-       -- 'IO' monad.
-
-       -- ** The @catch@ functions
-       catch,     -- :: IO a -> (Exception -> IO a) -> IO a
-       catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
-
-       -- ** The @handle@ functions
-       handle,    -- :: (Exception -> IO a) -> IO a -> IO a
-       handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
-
-       -- ** The @try@ functions
-       try,       -- :: IO a -> IO (Either Exception a)
-       tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
-
-       -- ** The @evaluate@ function
-       evaluate,  -- :: a -> IO a
-
-       -- ** The @mapException@ function
-       mapException,           -- :: (Exception -> Exception) -> a -> a
-
-       -- ** Exception predicates
-       
-       -- $preds
-
-       ioErrors,               -- :: Exception -> Maybe IOError
-       arithExceptions,        -- :: Exception -> Maybe ArithException
-       errorCalls,             -- :: Exception -> Maybe String
-       dynExceptions,          -- :: Exception -> Maybe Dynamic
-       assertions,             -- :: Exception -> Maybe String
-       asyncExceptions,        -- :: Exception -> Maybe AsyncException
-       userErrors,             -- :: Exception -> Maybe String
-
-       -- * Dynamic exceptions
-
-       -- $dynamic
-       throwDyn,       -- :: Typeable ex => ex -> b
-#ifdef __GLASGOW_HASKELL__
-       throwDynTo,     -- :: Typeable ex => ThreadId -> ex -> b
-#endif
-       catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
-       
-       -- * Asynchronous Exceptions
-
-       -- $async
-
-       -- ** Asynchronous exception control
-
-       -- |The following two functions allow a thread to control delivery of
-       -- asynchronous exceptions during a critical region.
-
-        block,          -- :: IO a -> IO a
-        unblock,        -- :: IO a -> IO a
-
-       -- *** Applying @block@ to an exception handler
-
-       -- $block_handler
-
-       -- *** Interruptible operations
-
-       -- $interruptible
-
-       -- * Assertions
-
-       assert,         -- :: Bool -> a -> a
-
-       -- * Utilities
-
-       bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
-       bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
-       bracketOnError,
-
-       finally,        -- :: IO a -> IO b -> IO a
-       
-#ifdef __GLASGOW_HASKELL__
-       setUncaughtExceptionHandler,      -- :: (Exception -> IO ()) -> IO ()
-       getUncaughtExceptionHandler       -- :: IO (Exception -> IO ())
-#endif
-  ) where
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Base                ( assert )
-import GHC.Exception   as ExceptionBase hiding (catch)
-import GHC.Conc                ( throwTo, ThreadId )
-import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
-import Foreign.C.String ( CString, withCString )
-import System.IO       ( stdout, hFlush )
-#endif
-
-#ifdef __HUGS__
-import Hugs.Exception  as ExceptionBase
-#endif
-
-import Prelude                 hiding ( catch )
-import System.IO.Error hiding ( catch, try )
-import System.IO.Unsafe (unsafePerformIO)
-import Data.Dynamic
-
-#ifdef __NHC__
-import System.IO.Error (catch, ioError)
-import IO              (bracket)
-import DIOError                -- defn of IOError type
-
--- minimum needed for nhc98 to pretend it has Exceptions
-type Exception  = IOError
-type IOException = IOError
-data ArithException
-data ArrayException
-data AsyncException
-
-throwIO         :: Exception -> IO a
-throwIO   = ioError
-throw   :: Exception -> a
-throw     = unsafePerformIO . throwIO
-
-evaluate :: a -> IO a
-evaluate x = x `seq` return x
-
-ioErrors       :: Exception -> Maybe IOError
-ioErrors e       = Just e
-arithExceptions :: Exception -> Maybe ArithException
-arithExceptions  = const Nothing
-errorCalls     :: Exception -> Maybe String
-errorCalls       = const Nothing
-dynExceptions  :: Exception -> Maybe Dynamic
-dynExceptions    = const Nothing
-assertions     :: Exception -> Maybe String
-assertions       = const Nothing
-asyncExceptions :: Exception -> Maybe AsyncException
-asyncExceptions  = const Nothing
-userErrors     :: Exception -> Maybe String
-userErrors (UserError _ s) = Just s
-userErrors  _              = Nothing
-
-block   :: IO a -> IO a
-block    = id
-unblock :: IO a -> IO a
-unblock  = id
-
-assert :: Bool -> a -> a
-assert True  x = x
-assert False _ = throw (UserError "" "Assertion failed")
-#endif
-
------------------------------------------------------------------------------
--- Catching exceptions
-
--- |This is the simplest of the exception-catching functions.  It
--- takes a single argument, runs it, and if an exception is raised
--- the \"handler\" is executed, with the value of the exception passed as an
--- argument.  Otherwise, the result is returned as normal.  For example:
---
--- >   catch (openFile f ReadMode) 
--- >       (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e))
---
--- For catching exceptions in pure (non-'IO') expressions, see the
--- function 'evaluate'.
---
--- Note that due to Haskell\'s unspecified evaluation order, an
--- expression may return one of several possible exceptions: consider
--- the expression @error \"urk\" + 1 \`div\` 0@.  Does
--- 'catch' execute the handler passing
--- @ErrorCall \"urk\"@, or @ArithError DivideByZero@?
---
--- The answer is \"either\": 'catch' makes a
--- non-deterministic choice about which exception to catch.  If you
--- call it again, you might get a different exception back.  This is
--- ok, because 'catch' is an 'IO' computation.
---
--- Note that 'catch' catches all types of exceptions, and is generally
--- used for \"cleaning up\" before passing on the exception using
--- 'throwIO'.  It is not good practice to discard the exception and
--- continue, without first checking the type of the exception (it
--- might be a 'ThreadKilled', for example).  In this case it is usually better
--- to use 'catchJust' and select the kinds of exceptions to catch.
---
--- Also note that the "Prelude" also exports a function called
--- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
--- except that the "Prelude" version only catches the IO and user
--- families of exceptions (as required by Haskell 98).  
---
--- We recommend either hiding the "Prelude" version of 'Prelude.catch'
--- when importing "Control.Exception": 
---
--- > import Prelude hiding (catch)
---
--- or importing "Control.Exception" qualified, to avoid name-clashes:
---
--- > import qualified Control.Exception as C
---
--- and then using @C.catch@
---
-#ifndef __NHC__
-catch          :: IO a                 -- ^ The computation to run
-       -> (Exception -> IO a)  -- ^ Handler to invoke if an exception is raised
-       -> IO a                 
-catch =  ExceptionBase.catchException
-#endif
--- | The function 'catchJust' is like 'catch', but it takes an extra
--- argument which is an /exception predicate/, a function which
--- selects which type of exceptions we\'re interested in.  There are
--- some predefined exception predicates for useful subsets of
--- exceptions: 'ioErrors', 'arithExceptions', and so on.  For example,
--- to catch just calls to the 'error' function, we could use
---
--- >   result <- catchJust errorCalls thing_to_try handler
---
--- Any other exceptions which are not matched by the predicate
--- are re-raised, and may be caught by an enclosing
--- 'catch' or 'catchJust'.
-catchJust
-       :: (Exception -> Maybe b) -- ^ Predicate to select exceptions
-       -> IO a                   -- ^ Computation to run
-       -> (b -> IO a)            -- ^ Handler
-       -> IO a
-catchJust p a handler = catch a handler'
-  where handler' e = case p e of 
-                       Nothing -> throw e
-                       Just b  -> handler b
-
--- | A version of 'catch' with the arguments swapped around; useful in
--- situations where the code for the handler is shorter.  For example:
---
--- >   do handle (\e -> exitWith (ExitFailure 1)) $
--- >     ...
-handle    :: (Exception -> IO a) -> IO a -> IO a
-handle     =  flip catch
-
--- | A version of 'catchJust' with the arguments swapped around (see
--- 'handle').
-handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
-handleJust p =  flip (catchJust p)
-
------------------------------------------------------------------------------
--- 'mapException'
-
--- | This function maps one exception into another as proposed in the
--- paper \"A semantics for imprecise exceptions\".
-
--- Notice that the usage of 'unsafePerformIO' is safe here.
-
-mapException :: (Exception -> Exception) -> a -> a
-mapException f v = unsafePerformIO (catch (evaluate v)
-                                          (\x -> throw (f x)))
-
------------------------------------------------------------------------------
--- 'try' and variations.
-
--- | Similar to 'catch', but returns an 'Either' result which is
--- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an
--- exception was raised and its value is @e@.
---
--- >  try a = catch (Right `liftM` a) (return . Left)
---
--- Note: as with 'catch', it is only polite to use this variant if you intend
--- to re-throw the exception after performing whatever cleanup is needed.
--- Otherwise, 'tryJust' is generally considered to be better.
---
--- Also note that "System.IO.Error" also exports a function called
--- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
--- except that it catches only the IO and user families of exceptions
--- (as required by the Haskell 98 @IO@ module).
-
-try :: IO a -> IO (Either Exception a)
-try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
-
--- | A variant of 'try' that takes an exception predicate to select
--- which exceptions are caught (c.f. 'catchJust').  If the exception
--- does not match the predicate, it is re-thrown.
-tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
-tryJust p a = do
-  r <- try a
-  case r of
-       Right v -> return (Right v)
-       Left  e -> case p e of
-                       Nothing -> throw e
-                       Just b  -> return (Left b)
-
------------------------------------------------------------------------------
--- Dynamic exceptions
-
--- $dynamic
---  #DynamicExceptions# Because the 'Exception' datatype is not extensible, there is an
--- interface for throwing and catching exceptions of type 'Dynamic'
--- (see "Data.Dynamic") which allows exception values of any type in
--- the 'Typeable' class to be thrown and caught.
-
--- | Raise any value as an exception, provided it is in the
--- 'Typeable' class.
-throwDyn :: Typeable exception => exception -> b
-#ifdef __NHC__
-throwDyn exception = throw (UserError "" "dynamic exception")
-#else
-throwDyn exception = throw (DynException (toDyn exception))
-#endif
-
-#ifdef __GLASGOW_HASKELL__
--- | A variant of 'throwDyn' that throws the dynamic exception to an
--- arbitrary thread (GHC only: c.f. 'throwTo').
-throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
-throwDynTo t exception = throwTo t (DynException (toDyn exception))
-#endif /* __GLASGOW_HASKELL__ */
-
--- | Catch dynamic exceptions of the required type.  All other
--- exceptions are re-thrown, including dynamic exceptions of the wrong
--- type.
---
--- When using dynamic exceptions it is advisable to define a new
--- datatype to use for your exception type, to avoid possible clashes
--- with dynamic exceptions used in other libraries.
---
-catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
-#ifdef __NHC__
-catchDyn m k = m       -- can't catch dyn exceptions in nhc98
-#else
-catchDyn m k = catchException m handle
-  where handle ex = case ex of
-                          (DynException dyn) ->
-                               case fromDynamic dyn of
-                                   Just exception  -> k exception
-                                   Nothing -> throw ex
-                          _ -> throw ex
-#endif
-
------------------------------------------------------------------------------
--- Exception Predicates
-
--- $preds
--- These pre-defined predicates may be used as the first argument to
--- 'catchJust', 'tryJust', or 'handleJust' to select certain common
--- classes of exceptions.
-#ifndef __NHC__
-ioErrors               :: Exception -> Maybe IOError
-arithExceptions        :: Exception -> Maybe ArithException
-errorCalls             :: Exception -> Maybe String
-assertions             :: Exception -> Maybe String
-dynExceptions          :: Exception -> Maybe Dynamic
-asyncExceptions        :: Exception -> Maybe AsyncException
-userErrors             :: Exception -> Maybe String
-
-ioErrors (IOException e) = Just e
-ioErrors _ = Nothing
-
-arithExceptions (ArithException e) = Just e
-arithExceptions _ = Nothing
-
-errorCalls (ErrorCall e) = Just e
-errorCalls _ = Nothing
-
-assertions (AssertionFailed e) = Just e
-assertions _ = Nothing
-
-dynExceptions (DynException e) = Just e
-dynExceptions _ = Nothing
-
-asyncExceptions (AsyncException e) = Just e
-asyncExceptions _ = Nothing
-
-userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
-userErrors _ = Nothing
-#endif
------------------------------------------------------------------------------
--- Some Useful Functions
-
--- | When you want to acquire a resource, do some work with it, and
--- then release the resource, it is a good idea to use 'bracket',
--- because 'bracket' will install the necessary exception handler to
--- release the resource in the event that an exception is raised
--- during the computation.  If an exception is raised, then 'bracket' will 
--- re-raise the exception (after performing the release).
---
--- A common example is opening a file:
---
--- > bracket
--- >   (openFile "filename" ReadMode)
--- >   (hClose)
--- >   (\handle -> do { ... })
---
--- The arguments to 'bracket' are in this order so that we can partially apply 
--- it, e.g.:
---
--- > withFile name mode = bracket (openFile name mode) hClose
---
-#ifndef __NHC__
-bracket 
-       :: IO a         -- ^ computation to run first (\"acquire resource\")
-       -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
-       -> (a -> IO c)  -- ^ computation to run in-between
-       -> IO c         -- returns the value from the in-between computation
-bracket before after thing =
-  block (do
-    a <- before 
-    r <- catch 
-          (unblock (thing a))
-          (\e -> do { after a; throw e })
-    after a
-    return r
- )
-#endif
-
--- | A specialised variant of 'bracket' with just a computation to run
--- afterward.
--- 
-finally :: IO a                -- ^ computation to run first
-       -> IO b         -- ^ computation to run afterward (even if an exception 
-                       -- was raised)
-       -> IO a         -- returns the value from the first computation
-a `finally` sequel =
-  block (do
-    r <- catch 
-            (unblock a)
-            (\e -> do { sequel; throw e })
-    sequel
-    return r
-  )
-
--- | A variant of 'bracket' where the return value from the first computation
--- is not required.
-bracket_ :: IO a -> IO b -> IO c -> IO c
-bracket_ before after thing = bracket before (const after) (const thing)
-
--- | Like bracket, but only performs the final action if there was an 
--- exception raised by the in-between computation.
-bracketOnError
-       :: IO a         -- ^ computation to run first (\"acquire resource\")
-       -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
-       -> (a -> IO c)  -- ^ computation to run in-between
-       -> IO c         -- returns the value from the in-between computation
-bracketOnError before after thing =
-  block (do
-    a <- before 
-    catch 
-       (unblock (thing a))
-       (\e -> do { after a; throw e })
- )
-
--- -----------------------------------------------------------------------------
--- Asynchronous exceptions
-
-{- $async
-
- #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to
-external influences, and can be raised at any point during execution.
-'StackOverflow' and 'HeapOverflow' are two examples of
-system-generated asynchronous exceptions.
-
-The primary source of asynchronous exceptions, however, is
-'throwTo':
-
->  throwTo :: ThreadId -> Exception -> IO ()
-
-'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one
-running thread to raise an arbitrary exception in another thread.  The
-exception is therefore asynchronous with respect to the target thread,
-which could be doing anything at the time it receives the exception.
-Great care should be taken with asynchronous exceptions; it is all too
-easy to introduce race conditions by the over zealous use of
-'throwTo'.
--}
-
-{- $block_handler
-There\'s an implied 'block' around every exception handler in a call
-to one of the 'catch' family of functions.  This is because that is
-what you want most of the time - it eliminates a common race condition
-in starting an exception handler, because there may be no exception
-handler on the stack to handle another exception if one arrives
-immediately.  If asynchronous exceptions are blocked on entering the
-handler, though, we have time to install a new exception handler
-before being interrupted.  If this weren\'t the default, one would have
-to write something like
-
->      block (
->           catch (unblock (...))
->                      (\e -> handler)
->      )
-
-If you need to unblock asynchronous exceptions again in the exception
-handler, just use 'unblock' as normal.
-
-Note that 'try' and friends /do not/ have a similar default, because
-there is no exception handler in this case.  If you want to use 'try'
-in an asynchronous-exception-safe way, you will need to use
-'block'.
--}
-
-{- $interruptible
-
-Some operations are /interruptible/, which means that they can receive
-asynchronous exceptions even in the scope of a 'block'.  Any function
-which may itself block is defined as interruptible; this includes
-'Control.Concurrent.MVar.takeMVar'
-(but not 'Control.Concurrent.MVar.tryTakeMVar'),
-and most operations which perform
-some I\/O with the outside world.  The reason for having
-interruptible operations is so that we can write things like
-
->      block (
->         a <- takeMVar m
->         catch (unblock (...))
->               (\e -> ...)
->      )
-
-if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
-then this particular
-combination could lead to deadlock, because the thread itself would be
-blocked in a state where it can\'t receive any asynchronous exceptions.
-With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be
-safe in the knowledge that the thread can receive exceptions right up
-until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds.
-Similar arguments apply for other interruptible operations like
-'System.IO.openFile'.
--}
-
-#if !(__GLASGOW_HASKELL__ || __NHC__)
-assert :: Bool -> a -> a
-assert True x = x
-assert False _ = throw (AssertionFailed "")
-#endif
-
-
-#ifdef __GLASGOW_HASKELL__
-{-# NOINLINE uncaughtExceptionHandler #-}
-uncaughtExceptionHandler :: IORef (Exception -> IO ())
-uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
-   where
-      defaultHandler :: Exception -> IO ()
-      defaultHandler ex = do
-         (hFlush stdout) `catchException` (\ _ -> return ())
-         let msg = case ex of
-               Deadlock    -> "no threads to run:  infinite loop or deadlock?"
-               ErrorCall s -> s
-               other       -> showsPrec 0 other "\n"
-         withCString "%s" $ \cfmt ->
-          withCString msg $ \cmsg ->
-            errorBelch cfmt cmsg
-
-foreign import ccall unsafe "RtsMessages.h errorBelch"
-   errorBelch :: CString -> CString -> IO ()
-
-setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO ()
-setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
-
-getUncaughtExceptionHandler :: IO (Exception -> IO ())
-getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
-#endif
diff --git a/Control/Monad.hs b/Control/Monad.hs
deleted file mode 100644 (file)
index 3080f5f..0000000
+++ /dev/null
@@ -1,334 +0,0 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- The 'Functor', 'Monad' and 'MonadPlus' classes,
--- with some useful operations on monads.
-
-module Control.Monad
-    (
-    -- * Functor and monad classes
-
-      Functor(fmap)
-    , Monad((>>=), (>>), return, fail)
-
-    , MonadPlus (   -- class context: Monad
-         mzero     -- :: (MonadPlus m) => m a
-       , mplus     -- :: (MonadPlus m) => m a -> m a -> m a
-       )
-    -- * Functions
-
-    -- ** Naming conventions
-    -- $naming
-
-    -- ** Basic functions from the "Prelude"
-
-    , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]
-    , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()
-    , forM          -- :: (Monad m) => [a] -> (a -> m b) -> m [b]
-    , forM_         -- :: (Monad m) => [a] -> (a -> m b) -> m ()
-    , sequence      -- :: (Monad m) => [m a] -> m [a]
-    , sequence_     -- :: (Monad m) => [m a] -> m ()
-    , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b
-    , (>=>)         -- :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c)
-    , (<=<)         -- :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)
-    , forever       -- :: (Monad m) => m a -> m ()
-
-    -- ** Generalisations of list functions
-
-    , join          -- :: (Monad m) => m (m a) -> m a
-    , msum          -- :: (MonadPlus m) => [m a] -> m a
-    , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
-    , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
-    , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
-    , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-    , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a 
-    , foldM_        -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
-    , replicateM    -- :: (Monad m) => Int -> m a -> m [a]
-    , replicateM_   -- :: (Monad m) => Int -> m a -> m ()
-
-    -- ** Conditional execution of monadic expressions
-
-    , guard         -- :: (MonadPlus m) => Bool -> m ()
-    , when          -- :: (Monad m) => Bool -> m () -> m ()
-    , unless        -- :: (Monad m) => Bool -> m () -> m ()
-
-    -- ** Monadic lifting operators
-
-    , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)
-    , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
-    , liftM3        -- :: ...
-    , liftM4        -- :: ...
-    , liftM5        -- :: ...
-
-    , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b
-
-    ) where
-
-import Data.Maybe
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.List
-import GHC.Base
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-infixr 1 =<<
-
--- -----------------------------------------------------------------------------
--- Prelude monad functions
-
--- | Same as '>>=', but with the arguments interchanged.
-{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
-(=<<)           :: Monad m => (a -> m b) -> m a -> m b
-f =<< x                = x >>= f
-
--- | Evaluate each action in the sequence from left to right,
--- and collect the results.
-sequence       :: Monad m => [m a] -> m [a] 
-{-# INLINE sequence #-}
-sequence ms = foldr k (return []) ms
-           where
-             k m m' = do { x <- m; xs <- m'; return (x:xs) }
-
--- | Evaluate each action in the sequence from left to right,
--- and ignore the results.
-sequence_        :: Monad m => [m a] -> m () 
-{-# INLINE sequence_ #-}
-sequence_ ms     =  foldr (>>) (return ()) ms
-
--- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.
-mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
-{-# INLINE mapM #-}
-mapM f as       =  sequence (map f as)
-
--- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@.
-mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
-{-# INLINE mapM_ #-}
-mapM_ f as      =  sequence_ (map f as)
-
-#endif  /* __GLASGOW_HASKELL__ */
-
--- -----------------------------------------------------------------------------
--- The MonadPlus class definition
-
--- | Monads that also support choice and failure.
-class Monad m => MonadPlus m where
-   -- | the identity of 'mplus'.  It should also satisfy the equations
-   --
-   -- > mzero >>= f  =  mzero
-   -- > v >> mzero   =  mzero
-   --
-   -- (but the instance for 'System.IO.IO' defined in "Control.Monad.Error"
-   -- does not satisfy the second one).
-   mzero :: m a        
-   -- | an associative operation
-   mplus :: m a -> m a -> m a
-
-instance MonadPlus [] where
-   mzero = []
-   mplus = (++)
-
-instance MonadPlus Maybe where
-   mzero = Nothing
-
-   Nothing `mplus` ys  = ys
-   xs      `mplus` _ys = xs
-
--- -----------------------------------------------------------------------------
--- Functions mandated by the Prelude
-
--- | @'guard' b@ is @'return' ()@ if @b@ is 'True',
--- and 'mzero' if @b@ is 'False'.
-guard           :: (MonadPlus m) => Bool -> m ()
-guard True      =  return ()
-guard False     =  mzero
-
--- | This generalizes the list-based 'filter' function.
-
-filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
-filterM _ []     =  return []
-filterM p (x:xs) =  do
-   flg <- p x
-   ys  <- filterM p xs
-   return (if flg then x:ys else ys)
-
--- | 'forM' is 'mapM' with its arguments flipped
-forM            :: Monad m => [a] -> (a -> m b) -> m [b]
-{-# INLINE forM #-}
-forM            = flip mapM
-
--- | 'forM_' is 'mapM_' with its arguments flipped
-forM_           :: Monad m => [a] -> (a -> m b) -> m ()
-{-# INLINE forM_ #-}
-forM_           = flip mapM_
-
--- | This generalizes the list-based 'concat' function.
-
-msum        :: MonadPlus m => [m a] -> m a
-{-# INLINE msum #-}
-msum        =  foldr mplus mzero
-
-infixr 1 <=<, >=>
-
--- | Left-to-right Kleisli composition of monads.
-(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
-f >=> g     = \x -> f x >>= g
-
--- | Right-to-left Kleisli composition of monads. '(>=>)', with the arguments flipped
-(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
-(<=<)       = flip (>=>)
-
--- | @'forever' act@ repeats the action infinitely.
-forever     :: (Monad m) => m a -> m ()
-forever a   = a >> forever a
-
--- -----------------------------------------------------------------------------
--- Other monad functions
-
--- | The 'join' function is the conventional monad join operator. It is used to
--- remove one level of monadic structure, projecting its bound argument into the
--- outer level.
-join              :: (Monad m) => m (m a) -> m a
-join x            =  x >>= id
-
--- | The 'mapAndUnzipM' function maps its first argument over a list, returning
--- the result as a pair of lists. This function is mainly used with complicated
--- data structures or a state-transforming monad.
-mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
-mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip
-
--- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.
-zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
-zipWithM f xs ys  =  sequence (zipWith f xs ys)
-
--- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
-zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
-
-{- | The 'foldM' function is analogous to 'foldl', except that its result is
-encapsulated in a monad. Note that 'foldM' works from left-to-right over
-the list arguments. This could be an issue where '(>>)' and the `folded
-function' are not commutative.
-
-
->      foldM f a1 [x1, x2, ..., xm ]
-
-==  
-
->      do
->        a2 <- f a1 x1
->        a3 <- f a2 x2
->        ...
->        f am xm
-
-If right-to-left evaluation is required, the input list should be reversed.
--}
-
-foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
-foldM _ a []      =  return a
-foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs
-
--- | Like 'foldM', but discards the result.
-foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
-foldM_ f a xs     = foldM f a xs >> return ()
-
--- | @'replicateM' n act@ performs the action @n@ times,
--- gathering the results.
-replicateM        :: (Monad m) => Int -> m a -> m [a]
-replicateM n x    = sequence (replicate n x)
-
--- | Like 'replicateM', but discards the result.
-replicateM_       :: (Monad m) => Int -> m a -> m ()
-replicateM_ n x   = sequence_ (replicate n x)
-
-{- | Conditional execution of monadic expressions. For example, 
-
->      when debug (putStr "Debugging\n")
-
-will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',
-and otherwise do nothing.
--}
-
-when              :: (Monad m) => Bool -> m () -> m ()
-when p s          =  if p then s else return ()
-
--- | The reverse of 'when'.
-
-unless            :: (Monad m) => Bool -> m () -> m ()
-unless p s        =  if p then return () else s
-
--- | Promote a function to a monad.
-liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
-liftM f m1              = do { x1 <- m1; return (f x1) }
-
--- | Promote a function to a monad, scanning the monadic arguments from
--- left to right.  For example,
---
--- >   liftM2 (+) [0,1] [0,2] = [0,2,1,3]
--- >   liftM2 (+) (Just 1) Nothing = Nothing
---
-liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
-liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
-
--- | Promote a function to a monad, scanning the monadic arguments from
--- left to right (cf. 'liftM2').
-liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
-liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
-
--- | Promote a function to a monad, scanning the monadic arguments from
--- left to right (cf. 'liftM2').
-liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
-liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
-
--- | Promote a function to a monad, scanning the monadic arguments from
--- left to right (cf. 'liftM2').
-liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
-liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
-
-{- | In many situations, the 'liftM' operations can be replaced by uses of
-'ap', which promotes function application. 
-
->      return f `ap` x1 `ap` ... `ap` xn
-
-is equivalent to 
-
->      liftMn f x1 x2 ... xn
-
--}
-
-ap                :: (Monad m) => m (a -> b) -> m a -> m b
-ap                =  liftM2 id
-
-
-{- $naming
-
-The functions in this library use the following naming conventions: 
-
-* A postfix \'@M@\' always stands for a function in the Kleisli category:
-  The monad type constructor @m@ is added to function results
-  (modulo currying) and nowhere else.  So, for example, 
-
->  filter  ::              (a ->   Bool) -> [a] ->   [a]
->  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
-
-* A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.
-  Thus, for example: 
-
->  sequence  :: Monad m => [m a] -> m [a] 
->  sequence_ :: Monad m => [m a] -> m () 
-
-* A prefix \'@m@\' generalizes an existing function to a monadic form.
-  Thus, for example: 
-
->  sum  :: Num a       => [a]   -> a
->  msum :: MonadPlus m => [m a] -> m a
-
--}
diff --git a/Control/Monad/Fix.hs b/Control/Monad/Fix.hs
deleted file mode 100644 (file)
index ea481d8..0000000
+++ /dev/null
@@ -1,73 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Fix
--- Copyright   :  (c) Andy Gill 2001,
---               (c) Oregon Graduate Institute of Science and Technology, 2002
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- Monadic fixpoints.
---
--- For a detailed discussion, see Levent Erkok's thesis,
--- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
---
------------------------------------------------------------------------------
-
-module Control.Monad.Fix (
-       MonadFix(
-          mfix -- :: (a -> m a) -> m a
-         ),
-       fix     -- :: (a -> a) -> a
-  ) where
-
-import Prelude
-import System.IO
-import Control.Monad.Instances ()
-import Data.Function (fix)
-
--- | Monads having fixed points with a \'knot-tying\' semantics.
--- Instances of 'MonadFix' should satisfy the following laws:
---
--- [/purity/]
---     @'mfix' ('return' . h)  =  'return' ('fix' h)@
---
--- [/left shrinking/ (or /tightening/)]
---     @'mfix' (\\x -> a >>= \\y -> f x y)  =  a >>= \\y -> 'mfix' (\\x -> f x y)@
---
--- [/sliding/]
---     @'mfix' ('Control.Monad.liftM' h . f)  =  'Control.Monad.liftM' h ('mfix' (f . h))@,
---     for strict @h@.
---
--- [/nesting/]
---     @'mfix' (\\x -> 'mfix' (\\y -> f x y))  =  'mfix' (\\x -> f x x)@
---
--- This class is used in the translation of the recursive @do@ notation
--- supported by GHC and Hugs.
-class (Monad m) => MonadFix m where
-       -- | The fixed point of a monadic computation.
-       -- @'mfix' f@ executes the action @f@ only once, with the eventual
-       -- output fed back as the input.  Hence @f@ should not be strict,
-       -- for then @'mfix' f@ would diverge.
-       mfix :: (a -> m a) -> m a
-
--- Instances of MonadFix for Prelude monads
-
--- Maybe:
-instance MonadFix Maybe where
-    mfix f = let a = f (unJust a) in a
-             where unJust (Just x) = x
-
--- List:
-instance MonadFix [] where
-    mfix f = case fix (f . head) of
-               []    -> []
-               (x:_) -> x : mfix (tail . f)
-
--- IO:
-instance MonadFix IO where
-    mfix = fixIO 
-
-instance MonadFix ((->) r) where
-    mfix f = \ r -> let a = f a r in a
diff --git a/Control/Monad/Instances.hs b/Control/Monad/Instances.hs
deleted file mode 100644 (file)
index f53fac2..0000000
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# OPTIONS_NHC98 -prelude #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Instances
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- 'Functor' and 'Monad' instances for @(->) r@ and
--- 'Functor' instances for @(,) a@ and @'Either' a@.
-
-module Control.Monad.Instances (Functor(..),Monad(..)) where
-
-import Prelude
-
-instance Functor ((->) r) where
-       fmap = (.)
-
-instance Monad ((->) r) where
-       return = const
-       f >>= k = \ r -> k (f r) r
-
-instance Functor ((,) a) where
-       fmap f (x,y) = (x, f y)
-
-instance Functor (Either a) where
-       fmap _ (Left x) = Left x
-       fmap f (Right y) = Right (f y)
diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs
deleted file mode 100644 (file)
index d736eb6..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.ST
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (requires universal quantification for runST)
---
--- This library provides support for /strict/ state threads, as
--- described in the PLDI \'94 paper by John Launchbury and Simon Peyton
--- Jones /Lazy Functional State Threads/.
---
------------------------------------------------------------------------------
-
-module Control.Monad.ST
-  (
-       -- * The 'ST' Monad
-       ST,             -- abstract, instance of Functor, Monad, Typeable.
-       runST,          -- :: (forall s. ST s a) -> a
-       fixST,          -- :: (a -> ST s a) -> ST s a
-
-       -- * Converting 'ST' to 'IO'
-       RealWorld,              -- abstract
-       stToIO,                 -- :: ST RealWorld a -> IO a
-
-       -- * Unsafe operations
-       unsafeInterleaveST,     -- :: ST s a -> ST s a
-       unsafeIOToST,           -- :: IO a -> ST s a
-       unsafeSTToIO            -- :: ST s a -> IO a
-      ) where
-
-import Prelude
-
-import Control.Monad.Fix
-
-#include "Typeable.h"
-
-#ifdef __HUGS__
-import Data.Typeable
-import Hugs.ST
-import qualified Hugs.LazyST as LazyST
-
-INSTANCE_TYPEABLE2(ST,sTTc,"ST")
-INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
-
-fixST :: (a -> ST s a) -> ST s a
-fixST f = LazyST.lazyToStrictST (LazyST.fixST (LazyST.strictToLazyST . f))
-
-unsafeInterleaveST :: ST s a -> ST s a
-unsafeInterleaveST =
-    LazyST.lazyToStrictST . LazyST.unsafeInterleaveST . LazyST.strictToLazyST
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.ST          ( ST, runST, fixST, unsafeInterleaveST )
-import GHC.Base                ( RealWorld )
-import GHC.IOBase      ( stToIO, unsafeIOToST, unsafeSTToIO )
-#endif
-
-instance MonadFix (ST s) where
-       mfix = fixST
-
diff --git a/Control/Monad/ST/Lazy.hs b/Control/Monad/ST/Lazy.hs
deleted file mode 100644 (file)
index 5bf1265..0000000
+++ /dev/null
@@ -1,152 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.ST.Lazy
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  non-portable (requires universal quantification for runST)
---
--- This module presents an identical interface to "Control.Monad.ST",
--- except that the monad delays evaluation of state operations until
--- a value depending on them is required.
---
------------------------------------------------------------------------------
-
-module Control.Monad.ST.Lazy (
-       -- * The 'ST' monad
-       ST,
-       runST,
-       fixST,
-
-       -- * Converting between strict and lazy 'ST'
-       strictToLazyST, lazyToStrictST,
-
-       -- * Converting 'ST' To 'IO'
-       RealWorld,
-       stToIO,
-
-       -- * Unsafe operations
-       unsafeInterleaveST,
-       unsafeIOToST
-    ) where
-
-import Prelude
-
-import Control.Monad.Fix
-
-import Control.Monad.ST (RealWorld)
-import qualified Control.Monad.ST as ST
-
-#ifdef __GLASGOW_HASKELL__
-import qualified GHC.ST
-import GHC.Base
-import Control.Monad
-#endif
-
-#ifdef __HUGS__
-import Hugs.LazyST
-#endif
-
-#ifdef __GLASGOW_HASKELL__
--- | The lazy state-transformer monad.
--- A computation of type @'ST' s a@ transforms an internal state indexed
--- by @s@, and returns a value of type @a@.
--- The @s@ parameter is either
---
--- * an unstantiated type variable (inside invocations of 'runST'), or
---
--- * 'RealWorld' (inside invocations of 'stToIO').
---
--- It serves to keep the internal states of different invocations of
--- 'runST' separate from each other and from invocations of 'stToIO'.
---
--- The '>>=' and '>>' operations are not strict in the state.  For example,
---
--- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@
-newtype ST s a = ST (State s -> (a, State s))
-data State s = S# (State# s)
-
-instance Functor (ST s) where
-    fmap f m = ST $ \ s ->
-      let 
-       ST m_a = m
-       (r,new_s) = m_a s
-      in
-      (f r,new_s)
-
-instance Monad (ST s) where
-
-        return a = ST $ \ s -> (a,s)
-        m >> k   =  m >>= \ _ -> k
-       fail s   = error s
-
-        (ST m) >>= k
-         = ST $ \ s ->
-           let
-             (r,new_s) = m s
-             ST k_a = k r
-           in
-           k_a new_s
-
-{-# NOINLINE runST #-}
--- | Return the value computed by a state transformer computation.
--- The @forall@ ensures that the internal state used by the 'ST'
--- computation is inaccessible to the rest of the program.
-runST :: (forall s. ST s a) -> a
-runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
-
--- | Allow the result of a state transformer computation to be used (lazily)
--- inside the computation.
--- Note that if @f@ is strict, @'fixST' f = _|_@.
-fixST :: (a -> ST s a) -> ST s a
-fixST m = ST (\ s -> 
-               let 
-                  ST m_r = m r
-                  (r,s') = m_r s
-               in
-                  (r,s'))
-#endif
-
-instance MonadFix (ST s) where
-       mfix = fixST
-
--- ---------------------------------------------------------------------------
--- Strict <--> Lazy
-
-#ifdef __GLASGOW_HASKELL__
-{-|
-Convert a strict 'ST' computation into a lazy one.  The strict state
-thread passed to 'strictToLazyST' is not performed until the result of
-the lazy state thread it returns is demanded.
--}
-strictToLazyST :: ST.ST s a -> ST s a
-strictToLazyST m = ST $ \s ->
-        let 
-          pr = case s of { S# s# -> GHC.ST.liftST m s# }
-          r  = case pr of { GHC.ST.STret _ v -> v }
-          s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }
-       in
-       (r, s')
-
-{-| 
-Convert a lazy 'ST' computation into a strict one.
--}
-lazyToStrictST :: ST s a -> ST.ST s a
-lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
-        case (m (S# s)) of (a, S# s') -> (# s', a #)
-
-unsafeInterleaveST :: ST s a -> ST s a
-unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
-#endif
-
-unsafeIOToST :: IO a -> ST s a
-unsafeIOToST = strictToLazyST . ST.unsafeIOToST
-
--- | A monad transformer embedding lazy state transformers in the 'IO'
--- monad.  The 'RealWorld' parameter indicates that the internal state
--- used by the 'ST' computation is a special one supplied by the 'IO'
--- monad, and thus distinct from those used by invocations of 'runST'.
-stToIO :: ST RealWorld a -> IO a
-stToIO = ST.stToIO . lazyToStrictST
diff --git a/Control/Monad/ST/Strict.hs b/Control/Monad/ST/Strict.hs
deleted file mode 100644 (file)
index c492766..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.ST.Strict
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  non-portable (requires universal quantification for runST)
---
--- The strict ST monad (re-export of "Control.Monad.ST")
---
------------------------------------------------------------------------------
-
-module Control.Monad.ST.Strict (
-       module Control.Monad.ST
-  ) where
-
-import Prelude
-import Control.Monad.ST
diff --git a/Data/Array.hs b/Data/Array.hs
deleted file mode 100644 (file)
index 09c4f65..0000000
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array 
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- Basic non-strict arrays.
---
--- /Note:/ The "Data.Array.IArray" module provides more general interface
--- to immutable arrays: it defines operations with the same names as
--- those defined below, but with more general types, and also defines
--- 'Array' instances of the relevant classes.  To use that more general
--- interface, import "Data.Array.IArray" but not "Data.Array".
------------------------------------------------------------------------------
-
-module  Data.Array 
-
-    ( 
-    -- * Immutable non-strict arrays
-    -- $intro
-      module Data.Ix           -- export all of Ix 
-    , Array                    -- Array type is abstract
-
-    -- * Array construction
-    , array        -- :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
-    , listArray     -- :: (Ix a) => (a,a) -> [b] -> Array a b
-    , accumArray    -- :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
-    -- * Accessing arrays
-    , (!)           -- :: (Ix a) => Array a b -> a -> b
-    , bounds        -- :: (Ix a) => Array a b -> (a,a)
-    , indices       -- :: (Ix a) => Array a b -> [a]
-    , elems         -- :: (Ix a) => Array a b -> [b]
-    , assocs        -- :: (Ix a) => Array a b -> [(a,b)]
-    -- * Incremental array updates
-    , (//)          -- :: (Ix a) => Array a b -> [(a,b)] -> Array a b
-    , accum         -- :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
-    -- * Derived arrays
-    , ixmap         -- :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a b
-
-    -- Array instances:
-    --
-    --   Ix a => Functor (Array a)
-    --   (Ix a, Eq b)  => Eq   (Array a b)
-    --   (Ix a, Ord b) => Ord  (Array a b)
-    --   (Ix a, Show a, Show b) => Show (Array a b)
-    --   (Ix a, Read a, Read b) => Read (Array a b)
-    -- 
-
-    -- Implementation checked wrt. Haskell 98 lib report, 1/99.
-
-    ) where
-
-import Data.Ix
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Arr                 -- Most of the hard work is done here
-import Data.Generics.Basics     -- To provide a Data instance
-import Data.Generics.Instances  -- To provide a Data instance
-import GHC.Err ( error )        -- Needed for Data instance
-#endif
-
-#ifdef __HUGS__
-import Hugs.Array
-#endif
-
-#ifdef __NHC__
-import Array           -- Haskell'98 arrays
-#endif
-
-import Data.Typeable
-
-{- $intro
-Haskell provides indexable /arrays/, which may be thought of as functions
-whose domains are isomorphic to contiguous subsets of the integers.
-Functions restricted in this way can be implemented efficiently;
-in particular, a programmer may reasonably expect rapid access to
-the components.  To ensure the possibility of such an implementation,
-arrays are treated as data, not as general functions.
-
-Since most array functions involve the class 'Ix', this module is exported
-from "Data.Array" so that modules need not import both "Data.Array" and
-"Data.Ix".
--}
diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
deleted file mode 100644 (file)
index d007bf4..0000000
+++ /dev/null
@@ -1,1686 +0,0 @@
-{-# OPTIONS_GHC -fno-bang-patterns #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.Base
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (MPTCs, uses Control.Monad.ST)
---
--- Basis for IArray and MArray.  Not intended for external consumption;
--- use IArray or MArray instead.
---
------------------------------------------------------------------------------
-
--- #hide
-module Data.Array.Base where
-
-import Prelude
-
-import Control.Monad.ST.Lazy ( strictToLazyST )
-import qualified Control.Monad.ST.Lazy as Lazy (ST)
-import Data.Ix         ( Ix, range, index, rangeSize )
-import Data.Int
-import Data.Word
-import Foreign.C.Types
-import Foreign.Ptr
-import Foreign.StablePtr
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Arr         ( STArray, unsafeIndex )
-import qualified GHC.Arr as Arr
-import qualified GHC.Arr as ArrST
-import GHC.ST          ( ST(..), runST )
-import GHC.Base
-import GHC.Word                ( Word(..) )
-import GHC.Ptr         ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )
-import GHC.Float       ( Float(..), Double(..) )
-import GHC.Stable      ( StablePtr(..) )
-import GHC.Int         ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
-import GHC.Word                ( Word8(..), Word16(..), Word32(..), Word64(..) )
-import GHC.IOBase       ( IO(..) )
-#endif
-
-#ifdef __HUGS__
-import Data.Bits
-import Foreign.Storable
-import qualified Hugs.Array as Arr
-import qualified Hugs.ST as ArrST
-import Hugs.Array ( unsafeIndex )
-import Hugs.ST ( STArray, ST(..), runST )
-import Hugs.ByteArray
-#endif
-
-import Data.Typeable
-#include "Typeable.h"
-
-#include "MachDeps.h"
-
------------------------------------------------------------------------------
--- Class of immutable arrays
-
-{- | 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 IArray a e where
-    -- | Extracts the bounds of an immutable array
-    bounds           :: Ix i => a i e -> (i,i)
-    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
-
-    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 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 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
-
-{-# 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 :: (IArray a e, 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)]
-
------------------------------------------------------------------------------
--- Normal polymorphic arrays
-
-instance IArray Arr.Array e where
-    {-# INLINE bounds #-}
-    bounds = Arr.bounds
-    {-# INLINE unsafeArray #-}
-    unsafeArray      = Arr.unsafeArray
-    {-# INLINE unsafeAt #-}
-    unsafeAt         = Arr.unsafeAt
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace    = Arr.unsafeReplace
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum      = Arr.unsafeAccum
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray = Arr.unsafeAccumArray
-
------------------------------------------------------------------------------
--- Flat unboxed arrays
-
--- | Arrays with unboxed elements.  Instances of 'IArray' are provided
--- for 'UArray' with certain element types ('Int', 'Float', 'Char',
--- etc.; see the 'UArray' class for a full list).
---
--- A 'UArray' will generally be more efficient (in terms of both time
--- and space) than the equivalent 'Data.Array.Array' with the same
--- element type.  However, 'UArray' is strict in its elements - so
--- don\'t use 'UArray' if you require the non-strictness that
--- 'Data.Array.Array' provides.
---
--- Because the @IArray@ interface provides operations overloaded on
--- the type of the array, it should be possible to just change the
--- array type being used by a program from say @Array@ to @UArray@ to
--- get the benefits of unboxed arrays (don\'t forget to import
--- "Data.Array.Unboxed" instead of "Data.Array").
---
-#ifdef __GLASGOW_HASKELL__
-data UArray i e = UArray !i !i ByteArray#
-#endif
-#ifdef __HUGS__
-data UArray i e = UArray !i !i !ByteArray
-#endif
-
-INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
-
-{-# INLINE unsafeArrayUArray #-}
-unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
-                  => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
-unsafeArrayUArray (l,u) ies default_elem = do
-    marr <- newArray (l,u) default_elem
-    sequence_ [unsafeWrite marr i e | (i, e) <- ies]
-    unsafeFreezeSTUArray marr
-
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE unsafeFreezeSTUArray #-}
-unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
-unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
-    case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
-    (# s2#, UArray l u arr# #) }
-#endif
-
-#ifdef __HUGS__
-unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
-unsafeFreezeSTUArray (STUArray l u marr) = do
-    arr <- unsafeFreezeMutableByteArray marr
-    return (UArray l u arr)
-#endif
-
-{-# INLINE unsafeReplaceUArray #-}
-unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
-                    => UArray i e -> [(Int, e)] -> ST s (UArray i e)
-unsafeReplaceUArray arr ies = do
-    marr <- thawSTUArray arr
-    sequence_ [unsafeWrite marr i e | (i, e) <- ies]
-    unsafeFreezeSTUArray marr
-
-{-# INLINE unsafeAccumUArray #-}
-unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
-                  => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
-unsafeAccumUArray f arr ies = do
-    marr <- thawSTUArray arr
-    sequence_ [do
-        old <- unsafeRead marr i
-        unsafeWrite marr i (f old new)
-        | (i, new) <- ies]
-    unsafeFreezeSTUArray marr
-
-{-# INLINE unsafeAccumArrayUArray #-}
-unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
-                       => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
-unsafeAccumArrayUArray f init (l,u) ies = do
-    marr <- newArray (l,u) init
-    sequence_ [do
-        old <- unsafeRead marr i
-        unsafeWrite marr i (f old new)
-        | (i, new) <- ies]
-    unsafeFreezeSTUArray marr
-
-{-# INLINE eqUArray #-}
-eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
-eqUArray arr1@(UArray l1 u1 _) arr2@(UArray 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 cmpUArray #-}
-cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
-cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
-
-{-# INLINE cmpIntUArray #-}
-cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
-cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray 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 "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
-
------------------------------------------------------------------------------
--- Showing IArrays
-
-{-# SPECIALISE 
-    showsIArray :: (IArray UArray e, Ix i, Show i, Show e) => 
-                  Int -> UArray 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)
-
------------------------------------------------------------------------------
--- Flat unboxed arrays: instances
-
-#ifdef __HUGS__
-unsafeAtBArray :: Storable e => UArray i e -> Int -> e
-unsafeAtBArray (UArray _ _ arr) = readByteArray arr
-#endif
-
-instance IArray UArray Bool where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) =
-        (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
-        `neWord#` int2Word# 0#
-#endif
-#ifdef __HUGS__
-    unsafeAt (UArray _ _ arr) i =
-       testBit (readByteArray arr (bOOL_INDEX i)::BitSet) (bOOL_SUBINDEX i)
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Char where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
-    {-# INLINE unsafeAt #-}
-#ifdef __GLASGOW_HASKELL__
-    unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Int where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Word where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray (Ptr a) where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
-    {-# INLINE unsafeAt #-}
-#ifdef __GLASGOW_HASKELL__
-    unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray (FunPtr a) where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Float where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Double where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray (StablePtr a) where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
--- bogus StablePtr value for initialising a UArray of StablePtr.
-#ifdef __GLASGOW_HASKELL__
-nullStablePtr = StablePtr (unsafeCoerce# 0#)
-#endif
-#ifdef __HUGS__
-nullStablePtr = castPtrToStablePtr nullPtr
-#endif
-
-instance IArray UArray Int8 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Int16 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Int32 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Int64 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Word8 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Word16 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Word32 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance IArray UArray Word64 where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
-#ifdef __GLASGOW_HASKELL__
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
-#endif
-#ifdef __HUGS__
-    unsafeAt = unsafeAtBArray
-#endif
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-
-instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where
-    (==) = eqUArray
-
-instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where
-    compare = cmpUArray
-
-instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where
-    showsPrec = showsIArray
-
------------------------------------------------------------------------------
--- Mutable arrays
-
-{-# NOINLINE arrEleBottom #-}
-arrEleBottom :: a
-arrEleBottom = error "MArray: undefined array element"
-
-{-| 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) => MArray a e m where
-
-    -- | Returns the bounds of the array
-    getBounds   :: Ix i => a i e -> m (i,i)
-
-    -- | 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 ()
-
-    {-# 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 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 readArray #-}
--- | Read an element from a mutable array
-readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
-readArray marr i = do
-  (l,u) <- getBounds marr
-  unsafeRead marr (index (l,u) i)
-
-{-# INLINE writeArray #-}
--- | Write an element in a mutable array
-writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
-writeArray marr i e = do
-  (l,u) <- getBounds marr
-  unsafeWrite marr (index (l,u) i) e
-
-{-# 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'
-
------------------------------------------------------------------------------
--- Polymorphic non-strict mutable arrays (ST monad)
-
-instance MArray (STArray s) e (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds arr = return $! ArrST.boundsSTArray arr
-    {-# INLINE newArray #-}
-    newArray    = ArrST.newSTArray
-    {-# INLINE unsafeRead #-}
-    unsafeRead  = ArrST.unsafeReadSTArray
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite = ArrST.unsafeWriteSTArray
-
-instance MArray (STArray s) e (Lazy.ST s) where
-    {-# INLINE getBounds #-}
-    getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
-    {-# 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)
-
-#ifdef __HUGS__
-INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
-#endif
-
------------------------------------------------------------------------------
--- Flat unboxed mutable arrays (ST monad)
-
--- | A mutable array with unboxed elements, that can be manipulated in
--- the 'ST' monad.  The type arguments are as follows:
---
---  * @s@: the state variable argument for the 'ST' type
---
---  * @i@: the index type of the array (should be an instance of @Ix@)
---
---  * @e@: the element type of the array.  Only certain element types
---    are supported.
---
--- An 'STUArray' will generally be more efficient (in terms of both time
--- and space) than the equivalent boxed version ('STArray') with the same
--- element type.  However, 'STUArray' is strict in its elements - so
--- don\'t use 'STUArray' if you require the non-strictness that
--- 'STArray' provides.
-#ifdef __GLASGOW_HASKELL__
-data STUArray s i a = STUArray !i !i (MutableByteArray# s)
-#endif
-#ifdef __HUGS__
-data STUArray s i a = STUArray !i !i !(MutableByteArray s)
-#endif
-
-INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
-
-#ifdef __GLASGOW_HASKELL__
-instance MArray (STUArray s) Bool (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray #-}
-    newArray (l,u) init = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
-        case bOOL_WORD_SCALE n#         of { n'# ->
-        let loop i# s3# | i# ==# n'# = s3#
-                        | otherwise  =
-                case writeWordArray# marr# i# e# s3# of { s4# ->
-                loop (i# +# 1#) s4# } in
-        case loop 0# s2#                of { s3# ->
-        (# s3#, STUArray l u marr# #) }}}}
-      where
-        W# e# = if init then maxBound else 0
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
-        (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
-        case bOOL_INDEX i#              of { j# ->
-        case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
-        case if e then old# `or#` bOOL_BIT i#
-             else old# `and#` bOOL_NOT_BIT i# of { e# ->
-        case writeWordArray# marr# j# e# s2# of { s3# ->
-        (# s3#, () #) }}}}
-
-instance MArray (STUArray s) Char (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, C# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
-        case writeWideCharArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Int (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, I# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
-        case writeIntArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Word (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, W# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
-        case writeWordArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) (Ptr a) (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, Ptr e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
-        case writeAddrArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) (FunPtr a) (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, FunPtr e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
-        case writeAddrArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Float (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, F# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
-        case writeFloatArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Double (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, D# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
-        case writeDoubleArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) (StablePtr a) (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2# , StablePtr e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
-        case writeStablePtrArray# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Int8 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# n# s1#       of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, I8# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
-        case writeInt8Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Int16 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, I16# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
-        case writeInt16Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Int32 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, I32# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
-        case writeInt32Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Int64 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> 
-        case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, I64# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
-        case writeInt64Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Word8 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# n# s1#       of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, W8# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
-        case writeWord8Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Word16 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, W16# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
-        case writeWord16Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Word32 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, W32# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
-        case writeWord32Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
-instance MArray (STUArray s) Word64 (ST s) where
-    {-# INLINE getBounds #-}
-    getBounds (STUArray l u _) = return (l,u)
-    {-# INLINE newArray_ #-}
-    newArray_ (l,u) = ST $ \s1# ->
-        case rangeSize (l,u)            of { I# n# ->
-        case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
-        (# s2#, STUArray l u marr# #) }}
-    {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
-        case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
-        (# s2#, W64# e# #) }
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
-        case writeWord64Array# marr# i# e# s1# of { s2# ->
-        (# s2#, () #) }
-
------------------------------------------------------------------------------
--- Translation between elements and bytes
-
-bOOL_SCALE, bOOL_WORD_SCALE,
-  wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
-bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
-  where I# last# = SIZEOF_HSWORD * 8 - 1
-bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
-  where I# last# = SIZEOF_HSWORD * 8 - 1
-wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
-dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
-fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
-
-bOOL_INDEX :: Int# -> Int#
-#if SIZEOF_HSWORD == 4
-bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
-#elif SIZEOF_HSWORD == 8
-bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
-#endif
-
-bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
-bOOL_BIT     n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
-  where W# mask# = SIZEOF_HSWORD * 8 - 1
-bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
-#endif /* __GLASGOW_HASKELL__ */
-
-#ifdef __HUGS__
-newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
-newMBArray_ = makeArray undefined
-  where
-    makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
-    makeArray dummy (l,u) = do
-       marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
-       return (STUArray l u marr)
-
-unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
-unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
-
-unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
-unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
-
-getBoundsMBArray (STUArray l u _) = return (l,u)
-
-instance MArray (STUArray s) Bool (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ (l,u) = do
-        marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
-        return (STUArray l u marr)
-    unsafeRead (STUArray _ _ marr) i = do
-       let ix = bOOL_INDEX i
-           bit = bOOL_SUBINDEX i
-       w <- readMutableByteArray marr ix
-       return (testBit (w::BitSet) bit)
-    unsafeWrite (STUArray _ _ marr) i e = do
-       let ix = bOOL_INDEX i
-           bit = bOOL_SUBINDEX i
-       w <- readMutableByteArray marr ix
-       writeMutableByteArray marr ix
-           (if e then setBit (w::BitSet) bit else clearBit w bit)
-
-instance MArray (STUArray s) Char (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Int (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Word (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) (Ptr a) (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) (FunPtr a) (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Float (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Double (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) (StablePtr a) (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Int8 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Int16 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Int32 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Int64 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Word8 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Word16 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Word32 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-instance MArray (STUArray s) Word64 (ST s) where
-    getBounds = getBoundsMBArray
-    newArray_ = newMBArray_
-    unsafeRead = unsafeReadMBArray
-    unsafeWrite = unsafeWriteMBArray
-
-type BitSet = Word8
-
-bitSetSize = bitSize (0::BitSet)
-
-bOOL_SCALE :: Int -> Int
-bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
-bOOL_INDEX :: Int -> Int
-bOOL_INDEX i = i `div` bitSetSize
-
-bOOL_SUBINDEX :: Int -> Int
-bOOL_SUBINDEX i = i `mod` bitSetSize
-#endif /* __HUGS__ */
-
------------------------------------------------------------------------------
--- 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)
-
-#ifdef __GLASGOW_HASKELL__
-freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
-freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
-    case sizeofMutableByteArray# marr#  of { n# ->
-    case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
-    case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
-    case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
-    case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
-    (# s4#, UArray l u arr# #) }}}}}
-
-foreign import ccall unsafe "memcpy"
-    memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
-           -> IO (Ptr a)
-
-{-# RULES
-"freeze/STArray"  freeze = ArrST.freezeSTArray
-"freeze/STUArray" freeze = freezeSTUArray
-    #-}
-#endif /* __GLASGOW_HASKELL__ */
-
--- 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
-
-{-# RULES
-"unsafeFreeze/STArray"  unsafeFreeze = ArrST.unsafeFreezeSTArray
-"unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
-    #-}
-
------------------------------------------------------------------------------
--- 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
-
-#ifdef __GLASGOW_HASKELL__
-thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
-thawSTUArray (UArray l u arr#) = ST $ \s1# ->
-    case sizeofByteArray# arr#          of { n# ->
-    case newByteArray# n# s1#           of { (# s2#, marr# #) ->
-    case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
-    case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
-    (# s3#, STUArray l u marr# #) }}}}
-
-foreign import ccall unsafe "memcpy"
-    memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
-           -> IO (Ptr a)
-
-{-# RULES
-"thaw/STArray"  thaw = ArrST.thawSTArray
-"thaw/STUArray" thaw = thawSTUArray
-    #-}
-#endif /* __GLASGOW_HASKELL__ */
-
-#ifdef __HUGS__
-thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
-thawSTUArray (UArray l u arr) = do
-    marr <- thawByteArray arr
-    return (STUArray l u marr)
-#endif
-
--- 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
-
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE unsafeThawSTUArray #-}
-unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
-unsafeThawSTUArray (UArray l u marr#) =
-    return (STUArray l u (unsafeCoerce# marr#))
-
-{-# RULES
-"unsafeThaw/STArray"    unsafeThaw = ArrST.unsafeThawSTArray
-"unsafeThaw/STUArray"   unsafeThaw = unsafeThawSTUArray
-    #-}
-#endif /* __GLASGOW_HASKELL__ */
-
--- | Casts an 'STUArray' with one element type into one with a
--- different element type.  All the elements of the resulting array
--- are undefined (unless you know what you\'re doing...).
-
-#ifdef __GLASGOW_HASKELL__
-castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
-castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
-#endif
-
-#ifdef __HUGS__
-castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
-castSTUArray (STUArray l u marr) = return (STUArray l u marr)
-#endif
diff --git a/Data/Array/Diff.hs b/Data/Array/Diff.hs
deleted file mode 100644 (file)
index 3e86f89..0000000
+++ /dev/null
@@ -1,423 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.Diff
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.IArray)
---
--- Functional arrays with constant-time update.
---
------------------------------------------------------------------------------
-
-module Data.Array.Diff (
-
-    -- * Diff array types
-
-    -- | Diff arrays have an immutable interface, but rely on internal
-    -- updates in place to provide fast functional update operator
-    -- '//'.
-    --
-    -- When the '//' operator is applied to a diff array, its contents
-    -- are physically updated in place. The old array silently changes
-    -- its representation without changing the visible behavior:
-    -- it stores a link to the new current array along with the
-    -- difference to be applied to get the old contents.
-    --
-    -- So if a diff array is used in a single-threaded style,
-    -- i.e. after '//' application the old version is no longer used,
-    -- @a'!'i@ takes O(1) time and @a '//' d@ takes O(@length d@).
-    -- Accessing elements of older versions gradually becomes slower.
-    --
-    -- Updating an array which is not current makes a physical copy.
-    -- The resulting array is unlinked from the old family. So you
-    -- can obtain a version which is guaranteed to be current and
-    -- thus have fast element access by @a '//' []@.
-
-    -- Possible improvement for the future (not implemented now):
-    -- make it possible to say "I will make an update now, but when
-    -- I later return to the old version, I want it to mutate back
-    -- instead of being copied".
-
-    IOToDiffArray, -- data IOToDiffArray
-                   --     (a :: * -> * -> *) -- internal mutable array
-                   --     (i :: *)           -- indices
-                   --     (e :: *)           -- elements
-
-    -- | Type synonyms for the two most important IO array types.
-
-    -- Two most important diff array types are fully polymorphic
-    -- lazy boxed DiffArray:
-    DiffArray,     -- = IOToDiffArray IOArray
-    -- ...and strict unboxed DiffUArray, working only for elements
-    -- of primitive types but more compact and usually faster:
-    DiffUArray,    -- = IOToDiffArray IOUArray
-
-    -- * Overloaded immutable array interface
-    
-    -- | Module "Data.Array.IArray" provides the interface of diff arrays.
-    -- They are instances of class 'IArray'.
-    module Data.Array.IArray,
-
-    -- * Low-level interface
-
-    -- | These are really internal functions, but you will need them
-    -- to make further 'IArray' instances of various diff array types
-    -- (for either more 'MArray' types or more unboxed element types).
-    newDiffArray, readDiffArray, replaceDiffArray
-    )
-    where
-
-------------------------------------------------------------------------
--- Imports.
-
-import Prelude
-
-import Data.Ix
-import Data.Array.Base
-import Data.Array.IArray
-import Data.Array.IO
-
-import Foreign.Ptr        ( Ptr, FunPtr )
-import Foreign.StablePtr  ( StablePtr )
-import Data.Int           ( Int8,  Int16,  Int32,  Int64 )
-import Data.Word          ( Word, Word8, Word16, Word32, Word64 )
-
-import System.IO.Unsafe          ( unsafePerformIO )
-import Control.Exception  ( evaluate )
-import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )
-
-------------------------------------------------------------------------
--- Diff array types.
-
--- | An arbitrary 'MArray' type living in the 'IO' monad can be converted
--- to a diff array.
-
-newtype IOToDiffArray a i e =
-    DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}
-
--- Internal representation: either a mutable array, or a link to
--- another diff array patched with a list of index+element pairs.
-data DiffArrayData a i e = Current (a i e)
-                         | Diff (IOToDiffArray a i e) [(Int, e)]
-
--- | Fully polymorphic lazy boxed diff array.
-type DiffArray  = IOToDiffArray IOArray
-
--- | Strict unboxed diff array, working only for elements
--- of primitive types but more compact and usually faster than 'DiffArray'.
-type DiffUArray = IOToDiffArray IOUArray
-
--- Having 'MArray a e IO' in instance context would require
--- -fallow-undecidable-instances, so each instance is separate here.
-
-------------------------------------------------------------------------
--- Showing DiffArrays
-
-instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
-  showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
-  showsPrec = showsIArray
-
-------------------------------------------------------------------------
--- Boring instances.
-
-instance IArray (IOToDiffArray IOArray) e where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray1` ies
-
-instance IArray (IOToDiffArray IOUArray) Char where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Int where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Word where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) (Ptr a) where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Float where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Double where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Int8 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Int16 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Int32 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Int64 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Word8 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Word16 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Word32 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-instance IArray (IOToDiffArray IOUArray) Word64 where
-    bounds        a      = unsafePerformIO $ boundsDiffArray a
-    unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
-    unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
-    unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
-
-
-
-------------------------------------------------------------------------
--- The important stuff.
-
-newDiffArray :: (MArray a e IO, Ix i)
-             => (i,i)
-             -> [(Int, e)]
-             -> IO (IOToDiffArray a i e)
-newDiffArray (l,u) ies = do
-    a <- newArray_ (l,u)
-    sequence_ [unsafeWrite a i e | (i, e) <- ies]
-    var <- newMVar (Current a)
-    return (DiffArray var)
-
-readDiffArray :: (MArray a e IO, Ix i)
-              => IOToDiffArray a i e
-              -> Int
-              -> IO e
-a `readDiffArray` i = do
-    d <- readMVar (varDiffArray a)
-    case d of
-        Current a'  -> unsafeRead a' i
-        Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)
-
-replaceDiffArray :: (MArray a e IO, Ix i)
-                => IOToDiffArray a i e
-                -> [(Int, e)]
-                -> IO (IOToDiffArray a i e)
-a `replaceDiffArray` ies = do
-    d <- takeMVar (varDiffArray a)
-    case d of
-        Current a' -> case ies of
-            [] -> do
-                -- We don't do the copy when there is nothing to change
-                -- and this is the current version. But see below.
-                putMVar (varDiffArray a) d
-                return a
-            _:_ -> do
-                diff <- sequence [do e <- unsafeRead a' i; return (i, e)
-                                  | (i, _) <- ies]
-                sequence_ [unsafeWrite a' i e | (i, e) <- ies]
-                var' <- newMVar (Current a')
-                putMVar (varDiffArray a) (Diff (DiffArray var') diff)
-                return (DiffArray var')
-        Diff _ _ -> do
-            -- We still do the copy when there is nothing to change
-            -- but this is not the current version. So you can use
-            -- 'a // []' to make sure that the resulting array has
-            -- fast element access.
-            putMVar (varDiffArray a) d
-            a' <- thawDiffArray a
-                -- thawDiffArray gives a fresh array which we can
-                -- safely mutate.
-            sequence_ [unsafeWrite a' i e | (i, e) <- ies]
-            var' <- newMVar (Current a')
-            return (DiffArray var')
-
--- The elements of the diff list might recursively reference the
--- array, so we must seq them before taking the MVar to avoid
--- deadlock.
-replaceDiffArray1 :: (MArray a e IO, Ix i)
-                => IOToDiffArray a i e
-                -> [(Int, e)]
-                -> IO (IOToDiffArray a i e)
-a `replaceDiffArray1` ies = do
-    mapM_ (evaluate . fst) ies
-    a `replaceDiffArray` ies
-
--- If the array contains unboxed elements, then the elements of the
--- diff list may also recursively reference the array from inside
--- replaceDiffArray, so we must seq them too.
-replaceDiffArray2 :: (MArray a e IO, Ix i)
-                => IOToDiffArray a i e
-                -> [(Int, e)]
-                -> IO (IOToDiffArray a i e)
-a `replaceDiffArray2` ies = do
-    mapM_ (\(a,b) -> do evaluate a; evaluate b) ies
-    a `replaceDiffArray` ies
-
-
-boundsDiffArray :: (MArray a e IO, Ix ix)
-                => IOToDiffArray a ix e
-                -> IO (ix,ix)
-boundsDiffArray a = do
-    d <- readMVar (varDiffArray a)
-    case d of
-        Current a' -> getBounds a'
-        Diff a' _  -> boundsDiffArray a'
-
-freezeDiffArray :: (MArray a e IO, Ix ix)
-                => a ix e
-                -> IO (IOToDiffArray a ix e)
-freezeDiffArray a = do
-  (l,u) <- getBounds a
-  a' <- newArray_ (l,u)
-  sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
-  var <- newMVar (Current a')
-  return (DiffArray var)
-
-{-# RULES
-"freeze/DiffArray" freeze = freezeDiffArray
-    #-}
-
--- unsafeFreezeDiffArray is really unsafe. Better don't use the old
--- array at all after freezing. The contents of the source array will
--- be changed when '//' is applied to the resulting array.
-
-unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
-                      => a ix e
-                      -> IO (IOToDiffArray a ix e)
-unsafeFreezeDiffArray a = do
-    var <- newMVar (Current a)
-    return (DiffArray var)
-
-{-# RULES
-"unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
-    #-}
-
-thawDiffArray :: (MArray a e IO, Ix ix)
-              => IOToDiffArray a ix e
-              -> IO (a ix e)
-thawDiffArray a = do
-    d <- readMVar (varDiffArray a)
-    case d of
-        Current a' -> do
-           (l,u) <- getBounds a'
-            a'' <- newArray_ (l,u)
-            sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
-            return a''
-        Diff a' ies -> do
-            a'' <- thawDiffArray a'
-            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
-            return a''
-
-{-# RULES
-"thaw/DiffArray" thaw = thawDiffArray
-    #-}
-
--- unsafeThawDiffArray is really unsafe. Better don't use the old
--- array at all after thawing. The contents of the resulting array
--- will be changed when '//' is applied to the source array.
-
-unsafeThawDiffArray :: (MArray a e IO, Ix ix)
-                    => IOToDiffArray a ix e
-                    -> IO (a ix e)
-unsafeThawDiffArray a = do
-    d <- readMVar (varDiffArray a)
-    case d of
-        Current a'  -> return a'
-        Diff a' ies -> do
-            a'' <- unsafeThawDiffArray a'
-            sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
-            return a''
-
-{-# RULES
-"unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
-    #-}
diff --git a/Data/Array/IArray.hs b/Data/Array/IArray.hs
deleted file mode 100644 (file)
index 2a88764..0000000
+++ /dev/null
@@ -1,51 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.IArray
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.Base)
---
--- 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.Array.Unboxed" and "Data.Array.Diff" modules.
---
------------------------------------------------------------------------------
-
-module Data.Array.IArray ( 
-    -- * Array classes
-    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 Prelude
-
-import Data.Ix
-import Data.Array (Array)
-import Data.Array.Base
diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs
deleted file mode 100644 (file)
index 1231683..0000000
+++ /dev/null
@@ -1,262 +0,0 @@
-{-# OPTIONS_GHC -#include "HsBase.h" #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.IO
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.MArray)
---
--- Mutable boxed and unboxed arrays in the IO monad.
---
------------------------------------------------------------------------------
-
-module Data.Array.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.Array.MArray,
-
-   -- * Doing I\/O with @IOUArray@s
-   hGetArray,          -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int
-   hPutArray,          -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()
- ) where
-
-import Prelude
-
-import Data.Array.Base
-import Data.Array.IO.Internals
-import Data.Array              ( Array )
-import Data.Array.MArray
-import Data.Int
-import Data.Word
-
-#ifdef __GLASGOW_HASKELL__
-import Foreign
-import Foreign.C
-
-import GHC.Arr
-import GHC.IOBase
-import GHC.Handle
-#else
-import Data.Char
-import System.IO
-import System.IO.Error
-#endif
-
-#ifdef __GLASGOW_HASKELL__
------------------------------------------------------------------------------
--- Freezing
-
-freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
-freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
-
-freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
-freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
-
-{-# RULES
-"freeze/IOArray"  freeze = freezeIOArray
-"freeze/IOUArray" freeze = freezeIOUArray
-    #-}
-
-{-# INLINE unsafeFreezeIOArray #-}
-unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
-unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
-
-{-# INLINE unsafeFreezeIOUArray #-}
-unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
-unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
-
-{-# RULES
-"unsafeFreeze/IOArray"  unsafeFreeze = unsafeFreezeIOArray
-"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
-    #-}
-
------------------------------------------------------------------------------
--- Thawing
-
-thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
-thawIOArray arr = stToIO $ do
-    marr <- thawSTArray arr
-    return (IOArray marr)
-
-thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
-thawIOUArray arr = stToIO $ do
-    marr <- thawSTUArray arr
-    return (IOUArray marr)
-
-{-# RULES
-"thaw/IOArray"  thaw = thawIOArray
-"thaw/IOUArray" thaw = thawIOUArray
-    #-}
-
-{-# INLINE unsafeThawIOArray #-}
-unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
-unsafeThawIOArray arr = stToIO $ do
-    marr <- unsafeThawSTArray arr
-    return (IOArray marr)
-
-{-# INLINE unsafeThawIOUArray #-}
-unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
-unsafeThawIOUArray arr = stToIO $ do
-    marr <- unsafeThawSTUArray arr
-    return (IOUArray marr)
-
-{-# RULES
-"unsafeThaw/IOArray"  unsafeThaw = unsafeThawIOArray
-"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
-    #-}
-
--- ---------------------------------------------------------------------------
--- 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 (IOUArray (STUArray l u 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 (fromIntegral r) (fromIntegral avail)
-                               writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-                               return avail
-                           else do 
-                               memcpy_ba_baoff ptr raw (fromIntegral 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 (IOUArray (STUArray l u 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 (fromIntegral 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 -> CInt -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_src_off"
-   memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> 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__ */
-hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
-hGetArray handle arr count = do
-       bds <- getBounds arr
-       if count < 0 || count > rangeSize bds
-          then illegalBufferSize handle "hGetArray" count
-          else 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 = do
-       bds <- getBounds arr
-       if count < 0 || count > rangeSize bds
-          then illegalBufferSize handle "hPutArray" count
-          else 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__ */
diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs
deleted file mode 100644 (file)
index fca542e..0000000
+++ /dev/null
@@ -1,322 +0,0 @@
-{-# OPTIONS_GHC -#include "HsBase.h" #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.IO.Internal
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.Base)
---
--- Mutable boxed and unboxed arrays in the IO monad.
---
------------------------------------------------------------------------------
-
--- #hide
-module Data.Array.IO.Internals (
-   IOArray(..),                -- instance of: Eq, Typeable
-   IOUArray(..),       -- instance of: Eq, Typeable
-   castIOUArray,       -- :: IOUArray ix a -> IO (IOUArray ix b)
- ) where
-
-import Prelude
-
-import Data.Array.MArray
-import Data.Int
-import Data.Word
-import Data.Typeable
-
-#ifdef __HUGS__
-import Hugs.IOArray
-#endif
-
-import Control.Monad.ST                ( RealWorld, stToIO )
-import Foreign.Ptr             ( Ptr, FunPtr )
-import Foreign.StablePtr       ( StablePtr )
-import Data.Array.Base
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.IOBase
-import GHC.Base
-#endif /* __GLASGOW_HASKELL__ */
-
-#include "Typeable.h"
-
-INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
-
------------------------------------------------------------------------------
--- | Instance declarations for 'IOArray's
-
-instance MArray IOArray e IO where
-#if defined(__HUGS__)
-    getBounds   = return . boundsIOArray
-#elif defined(__GLASGOW_HASKELL__)
-    {-# INLINE getBounds #-}
-    getBounds (IOArray marr) = stToIO $ getBounds marr
-#endif
-    newArray    = newIOArray
-    unsafeRead  = unsafeReadIOArray
-    unsafeWrite = unsafeWriteIOArray
-
------------------------------------------------------------------------------
--- Flat unboxed mutable arrays (IO monad)
-
--- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type
--- arguments are as follows:
---
---  * @i@: the index type of the array (should be an instance of 'Ix')
---
---  * @e@: the element type of the array.  Only certain element types
---    are supported: see "Data.Array.MArray" for a list of instances.
---
-newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
-
-INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")
-
-instance MArray IOUArray Bool IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Char IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Int IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Word IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray (Ptr a) IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray (FunPtr a) IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Float IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Double IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray (StablePtr a) IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Int8 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Int16 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Int32 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Int64 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Word8 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Word16 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Word32 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
-instance MArray IOUArray Word64 IO where
-    {-# INLINE getBounds #-}
-    getBounds (IOUArray arr) = stToIO $ getBounds arr
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOUArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOUArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
-
--- | Casts an 'IOUArray' with one element type into one with a
--- different element type.  All the elements of the resulting array
--- are undefined (unless you know what you\'re doing...).
-castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
-castIOUArray (IOUArray marr) = stToIO $ do
-    marr' <- castSTUArray marr
-    return (IOUArray marr')
-
diff --git a/Data/Array/MArray.hs b/Data/Array/MArray.hs
deleted file mode 100644 (file)
index 95fae97..0000000
+++ /dev/null
@@ -1,55 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.MArray
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.Base)
---
--- An overloaded interface to mutable arrays.  For array types which can be
--- used with this interface, see "Data.Array.IO", "Data.Array.ST", 
--- and "Data.Array.Storable".
---
------------------------------------------------------------------------------
-
-module Data.Array.MArray ( 
-    -- * Class of mutable array types
-    MArray,       -- :: (* -> * -> *) -> * -> (* -> *) -> 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
-    getBounds,    -- :: (MArray a e m, Ix i) => a i e -> m (i,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 Prelude
-
-import Data.Ix
-#ifdef __HADDOCK__
-import Data.Array.IArray
-#endif
-import Data.Array.Base
diff --git a/Data/Array/ST.hs b/Data/Array/ST.hs
deleted file mode 100644 (file)
index 828ae63..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.ST
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.MArray)
---
--- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad.
---
------------------------------------------------------------------------------
-
-module Data.Array.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.Array.MArray,
- ) where
-
-import Prelude
-
-import Data.Array.MArray
-import Data.Array.Base ( STUArray, castSTUArray, UArray, unsafeFreezeSTUArray )
-import Control.Monad.ST        ( ST, runST )
-
-#ifdef __HUGS__
-import Hugs.Array      ( Array )
-import Hugs.ST         ( STArray, unsafeFreezeSTArray )
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Arr         ( STArray, Array, unsafeFreezeSTArray )
-#endif
-
--- | 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 :: (Ix i)
-          => (forall s . ST s (STUArray s i e))
-          -> UArray i e
-runSTUArray st = runST (st >>= unsafeFreezeSTUArray)
-
-
--- INTERESTING... this is the type we'd like to give to runSTUArray:
---
--- runSTUArray :: (Ix i, IArray UArray e, 
---             forall s. MArray (STUArray s) e (ST s))
---        => (forall s . ST s (STUArray s i e))
---        -> UArray i e
---
--- Note the quantified constraint.  We dodged the problem by using
--- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but
--- this essentially constrains us to a single unsafeFreeze for all STUArrays
--- (in theory we might have a different one for certain element types).
diff --git a/Data/Array/Storable.hs b/Data/Array/Storable.hs
deleted file mode 100644 (file)
index a4aa7dd..0000000
+++ /dev/null
@@ -1,92 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.Storable
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.MArray)
---
--- 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.Array.IO.IOUArray' but slower.
--- Its advantage is that it's compatible with C.
---
------------------------------------------------------------------------------
-
-module Data.Array.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.Array.MArray" provides the interface of storable arrays.
-    -- They are instances of class 'MArray' (with the 'IO' monad).
-    module Data.Array.MArray,
-    
-    -- * Accessing the pointer to the array contents
-    withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a
-    
-    touchStorableArray, -- :: StorableArray i e -> IO ()
-
-    unsafeForeignPtrToStorableArray
-    )
-    where
-
-import Prelude
-
-import Data.Array.Base
-import Data.Array.MArray
-import Foreign hiding (newArray)
-
--- |The array type
-data StorableArray i e = StorableArray !i !i !(ForeignPtr e)
-
-instance Storable e => MArray StorableArray e IO where
-    getBounds (StorableArray l u _) = return (l,u)
-
-    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)
-
-    unsafeRead (StorableArray _ _ fp) i =
-        withForeignPtr fp $ \a -> peekElemOff a i
-
-    unsafeWrite (StorableArray _ _ fp) i e =
-        withForeignPtr fp $ \a -> pokeElemOff a i e
-
--- |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)
diff --git a/Data/Array/Unboxed.hs b/Data/Array/Unboxed.hs
deleted file mode 100644 (file)
index 2e24fad..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Array.Unboxed
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (uses Data.Array.IArray)
---
--- Unboxed immutable arrays.
---
------------------------------------------------------------------------------
-
-module Data.Array.Unboxed (
-   -- * Arrays with unboxed elements
-   UArray,
-
-   -- * The overloaded immutable array interface
-   module Data.Array.IArray,
- ) where
-
-import Prelude
-
-import Data.Array.IArray
-import Data.Array.Base
diff --git a/Data/Bits.hs b/Data/Bits.hs
deleted file mode 100644 (file)
index 88f707a..0000000
+++ /dev/null
@@ -1,342 +0,0 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Bits
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- This module defines bitwise operations for signed and unsigned
--- integers.  Instances of the class 'Bits' for the 'Int' and
--- 'Integer' types are available from this module, and instances for
--- explicitly sized integral types are available from the
--- "Data.Int" and "Data.Word" modules.
---
------------------------------------------------------------------------------
-
-module Data.Bits ( 
-  Bits(
-    (.&.), (.|.), xor, -- :: a -> a -> a
-    complement,        -- :: a -> a
-    shift,             -- :: a -> Int -> a
-    rotate,            -- :: a -> Int -> a
-    bit,               -- :: Int -> a
-    setBit,            -- :: a -> Int -> a
-    clearBit,          -- :: a -> Int -> a
-    complementBit,     -- :: a -> Int -> a
-    testBit,           -- :: a -> Int -> Bool
-    bitSize,           -- :: a -> Int
-    isSigned,          -- :: a -> Bool
-    shiftL, shiftR,    -- :: a -> Int -> a
-    rotateL, rotateR   -- :: a -> Int -> a
-  )
-
-  -- instance Bits Int
-  -- instance Bits Integer
- ) where
-
--- Defines the @Bits@ class containing bit-based operations.
--- See library document for details on the semantics of the
--- individual operations.
-
-#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
-#include "MachDeps.h"
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Num
-import GHC.Real
-import GHC.Base
-#endif
-
-#ifdef __HUGS__
-import Hugs.Bits
-#endif
-
-infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
-infixl 7 .&.
-infixl 6 `xor`
-infixl 5 .|.
-
-{-| 
-The 'Bits' class defines bitwise operations over integral types.
-
-* Bits are numbered from 0 with bit 0 being the least
-  significant bit.
-
-Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
-('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
-'bitSize' and 'isSigned'.
--}
-class Num a => Bits a where
-    -- | Bitwise \"and\"
-    (.&.) :: a -> a -> a
-
-    -- | Bitwise \"or\"
-    (.|.) :: a -> a -> a
-
-    -- | Bitwise \"xor\"
-    xor :: a -> a -> a
-
-    {-| Reverse all the bits in the argument -}
-    complement        :: a -> a
-
-    {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
-       or right by @-i@ bits otherwise.
-       Right shifts perform sign extension on signed number types;
-       i.e. they fill the top bits with 1 if the @x@ is negative
-       and with 0 otherwise.
-
-       An instance can define either this unified 'shift' or 'shiftL' and
-       'shiftR', depending on which is more convenient for the type in
-       question. -}
-    shift             :: a -> Int -> a
-
-    x `shift`   i | i<0  = x `shiftR` (-i)
-                  | i==0 = x
-                  | i>0  = x `shiftL` i
-
-    {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
-       or right by @-i@ bits otherwise.
-
-        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
-
-       An instance can define either this unified 'rotate' or 'rotateL' and
-       'rotateR', depending on which is more convenient for the type in
-       question. -}
-    rotate            :: a -> Int -> a
-
-    x `rotate`  i | i<0  = x `rotateR` (-i)
-                  | i==0 = x
-                  | i>0  = x `rotateL` i
-
-    {-
-    -- Rotation can be implemented in terms of two shifts, but care is
-    -- needed for negative values.  This suggested implementation assumes
-    -- 2's-complement arithmetic.  It is commented out because it would
-    -- require an extra context (Ord a) on the signature of 'rotate'.
-    x `rotate`  i | i<0 && isSigned x && x<0
-                         = let left = i+bitSize x in
-                           ((x `shift` i) .&. complement ((-1) `shift` left))
-                           .|. (x `shift` left)
-                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
-                  | i==0 = x
-                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
-    -}
-
-    -- | @bit i@ is a value with the @i@th bit set
-    bit               :: Int -> a
-
-    -- | @x \`setBit\` i@ is the same as @x .|. bit i@
-    setBit            :: a -> Int -> a
-
-    -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
-    clearBit          :: a -> Int -> a
-
-    -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
-    complementBit     :: a -> Int -> a
-
-    -- | Return 'True' if the @n@th bit of the argument is 1
-    testBit           :: a -> Int -> Bool
-
-    {-| Return the number of bits in the type of the argument.  The actual
-       value of the argument is ignored.  The function 'bitSize' is
-       undefined for types that do not have a fixed bitsize, like 'Integer'.
-       -}
-    bitSize           :: a -> Int
-
-    {-| Return 'True' if the argument is a signed type.  The actual
-        value of the argument is ignored -}
-    isSigned          :: a -> Bool
-
-    bit i               = 1 `shiftL` i
-    x `setBit` i        = x .|. bit i
-    x `clearBit` i      = x .&. complement (bit i)
-    x `complementBit` i = x `xor` bit i
-    x `testBit` i       = (x .&. bit i) /= 0
-
-    {-| Shift the argument left by the specified number of bits
-       (which must be non-negative).
-
-       An instance can define either this and 'shiftR' or the unified
-       'shift', depending on which is more convenient for the type in
-       question. -}
-    shiftL            :: a -> Int -> a
-    x `shiftL`  i = x `shift`  i
-
-    {-| Shift the first argument right by the specified number of bits
-       (which must be non-negative).
-       Right shifts perform sign extension on signed number types;
-       i.e. they fill the top bits with 1 if the @x@ is negative
-       and with 0 otherwise.
-
-       An instance can define either this and 'shiftL' or the unified
-       'shift', depending on which is more convenient for the type in
-       question. -}
-    shiftR            :: a -> Int -> a
-    x `shiftR`  i = x `shift`  (-i)
-
-    {-| Rotate the argument left by the specified number of bits
-       (which must be non-negative).
-
-       An instance can define either this and 'rotateR' or the unified
-       'rotate', depending on which is more convenient for the type in
-       question. -}
-    rotateL           :: a -> Int -> a
-    x `rotateL` i = x `rotate` i
-
-    {-| Rotate the argument right by the specified number of bits
-       (which must be non-negative).
-
-       An instance can define either this and 'rotateL' or the unified
-       'rotate', depending on which is more convenient for the type in
-       question. -}
-    rotateR           :: a -> Int -> a
-    x `rotateR` i = x `rotate` (-i)
-
-instance Bits Int where
-    {-# INLINE shift #-}
-
-#ifdef __GLASGOW_HASKELL__
-    (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
-    (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
-    (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
-    complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
-    (I# x#) `shift` (I# i#)
-        | i# >=# 0#        = I# (x# `iShiftL#` i#)
-        | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
-    (I# x#) `rotate` (I# i#) =
-        I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
-                       (x'# `uncheckedShiftRL#` (wsib -# i'#))))
-        where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
-       wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
-    bitSize  _             = WORD_SIZE_IN_BITS
-#else /* !__GLASGOW_HASKELL__ */
-
-#ifdef __HUGS__
-    (.&.)                  = primAndInt
-    (.|.)                  = primOrInt
-    xor                    = primXorInt
-    complement             = primComplementInt
-    shift                  = primShiftInt
-    bit                    = primBitInt
-    testBit                = primTestInt
-    bitSize _              = SIZEOF_HSINT*8
-#elif defined(__NHC__)
-    (.&.)                  = nhc_primIntAnd
-    (.|.)                  = nhc_primIntOr
-    xor                    = nhc_primIntXor
-    complement             = nhc_primIntCompl
-    shiftL                 = nhc_primIntLsh
-    shiftR                 = nhc_primIntRsh
-    bitSize _              = 32
-#endif /* __NHC__ */
-
-    x `rotate`  i
-       | i<0 && x<0       = let left = i+bitSize x in
-                             ((x `shift` i) .&. complement ((-1) `shift` left))
-                             .|. (x `shift` left)
-       | i<0              = (x `shift` i) .|. (x `shift` (i+bitSize x))
-       | i==0             = x
-       | i>0              = (x `shift` i) .|. (x `shift` (i-bitSize x))
-
-#endif /* !__GLASGOW_HASKELL__ */
-
-    isSigned _             = True
-
-#ifdef __NHC__
-foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
-foreign import ccall nhc_primIntOr  :: Int -> Int -> Int
-foreign import ccall nhc_primIntXor :: Int -> Int -> Int
-foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
-foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
-foreign import ccall nhc_primIntCompl :: Int -> Int
-#endif /* __NHC__ */
-
-instance Bits Integer where
-#ifdef __GLASGOW_HASKELL__
-   (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
-   x@(S# _) .&. y = toBig x .&. y
-   x .&. y@(S# _) = x .&. toBig y
-   (J# s1 d1) .&. (J# s2 d2) = 
-       case andInteger# s1 d1 s2 d2 of
-         (# s, d #) -> J# s d
-   
-   (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
-   x@(S# _) .|. y = toBig x .|. y
-   x .|. y@(S# _) = x .|. toBig y
-   (J# s1 d1) .|. (J# s2 d2) = 
-       case orInteger# s1 d1 s2 d2 of
-         (# s, d #) -> J# s d
-   
-   (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
-   x@(S# _) `xor` y = toBig x `xor` y
-   x `xor` y@(S# _) = x `xor` toBig y
-   (J# s1 d1) `xor` (J# s2 d2) =
-       case xorInteger# s1 d1 s2 d2 of
-         (# s, d #) -> J# s d
-   
-   complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
-   complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
-#else
-   -- reduce bitwise binary operations to special cases we can handle
-
-   x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
-            | otherwise  = x `posAnd` y
-   
-   x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
-            | otherwise  = x `posOr` y
-   
-   x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
-            | x<0        = complement (complement x `posXOr` y)
-            |        y<0 = complement (x `posXOr` complement y)
-            | otherwise  = x `posXOr` y
-
-   -- assuming infinite 2's-complement arithmetic
-   complement a = -1 - a
-#endif
-
-   shift x i | i >= 0    = x * 2^i
-            | otherwise = x `div` 2^(-i)
-
-   rotate x i = shift x i   -- since an Integer never wraps around
-
-   bitSize _  = error "Data.Bits.bitSize(Integer)"
-   isSigned _ = True
-
-#ifndef __GLASGOW_HASKELL__
--- Crude implementation of bitwise operations on Integers: convert them
--- to finite lists of Ints (least significant first), zip and convert
--- back again.
-
--- posAnd requires at least one argument non-negative
--- posOr and posXOr require both arguments non-negative
-
-posAnd, posOr, posXOr :: Integer -> Integer -> Integer
-posAnd x y   = fromInts $ zipWith (.&.) (toInts x) (toInts y)
-posOr x y    = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
-posXOr x y   = fromInts $ longZipWith xor (toInts x) (toInts y)
-
-longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
-longZipWith f xs [] = xs
-longZipWith f [] ys = ys
-longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
-
-toInts :: Integer -> [Int]
-toInts n
-    | n == 0 = []
-    | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
-  where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
-               | otherwise = fromInteger n
-
-fromInts :: [Int] -> Integer
-fromInts = foldr catInt 0
-    where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
-
-numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
-#endif /* !__GLASGOW_HASKELL__ */
diff --git a/Data/Bool.hs b/Data/Bool.hs
deleted file mode 100644 (file)
index 0e14538..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Bool
--- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- The 'Bool' type and related functions.
---
------------------------------------------------------------------------------
-
-module Data.Bool (
-   -- * Booleans
-   Bool(..),
-   -- ** Operations 
-   (&&),       -- :: Bool -> Bool -> Bool
-   (||),       -- :: Bool -> Bool -> Bool
-   not,                -- :: Bool -> Bool
-   otherwise,  -- :: Bool
-  ) where
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Base
-#endif
-
-#ifdef __NHC__
-import Prelude
-import Prelude
-  ( Bool(..)
-  , (&&)
-  , (||)
-  , not
-  , otherwise
-  )
-#endif
diff --git a/Data/ByteString.hs b/Data/ByteString.hs
deleted file mode 100644 (file)
index 8e9e919..0000000
+++ /dev/null
@@ -1,2020 +0,0 @@
-{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
--- |
--- Module      : Data.ByteString
--- Copyright   : (c) The University of Glasgow 2001,
---               (c) David Roundy 2003-2005,
---               (c) Simon Marlow 2005
---               (c) Don Stewart 2005-2006
---               (c) Bjorn Bringert 2006
---               Array fusion code:
---               (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller
---               (c) 2006      Manuel M T Chakravarty & Roman Leshchinskiy
---
--- License     : BSD-style
---
--- Maintainer  : dons@cse.unsw.edu.au
--- Stability   : experimental
--- Portability : portable
--- 
--- A time and space-efficient implementation of byte vectors using
--- packed Word8 arrays, suitable for high performance use, both in terms
--- of large data quantities, or high speed requirements. Byte vectors
--- are encoded as strict 'Word8' arrays of bytes, held in a 'ForeignPtr',
--- and can be passed between C and Haskell with little effort.
---
--- This module is intended to be imported @qualified@, to avoid name
--- clashes with "Prelude" functions.  eg.
---
--- > import qualified Data.ByteString as B
---
--- Original GHC implementation by Bryan O\'Sullivan.
--- Rewritten to use 'Data.Array.Unboxed.UArray' by Simon Marlow.
--- Rewritten to support slices and use 'ForeignPtr' by David Roundy.
--- Polished and extended by Don Stewart.
---
-
-module Data.ByteString (
-
-        -- * The @ByteString@ type
-        ByteString,             -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid
-
-        -- * Introducing and eliminating 'ByteString's
-        empty,                  -- :: ByteString
-        singleton,              -- :: Word8   -> ByteString
-        pack,                   -- :: [Word8] -> ByteString
-        unpack,                 -- :: ByteString -> [Word8]
-
-        -- * Basic interface
-        cons,                   -- :: Word8 -> ByteString -> ByteString
-        snoc,                   -- :: ByteString -> Word8 -> ByteString
-        append,                 -- :: ByteString -> ByteString -> ByteString
-        head,                   -- :: ByteString -> Word8
-        last,                   -- :: ByteString -> Word8
-        tail,                   -- :: ByteString -> ByteString
-        init,                   -- :: ByteString -> ByteString
-        null,                   -- :: ByteString -> Bool
-        length,                 -- :: ByteString -> Int
-
-        -- * Transformating ByteStrings
-        map,                    -- :: (Word8 -> Word8) -> ByteString -> ByteString
-        reverse,                -- :: ByteString -> ByteString
-        intersperse,            -- :: Word8 -> ByteString -> ByteString
-        transpose,              -- :: [ByteString] -> [ByteString]
-
-        -- * Reducing 'ByteString's (folds)
-        foldl,                  -- :: (a -> Word8 -> a) -> a -> ByteString -> a
-        foldl',                 -- :: (a -> Word8 -> a) -> a -> ByteString -> a
-        foldl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-        foldl1',                -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-
-        foldr,                  -- :: (Word8 -> a -> a) -> a -> ByteString -> a
-        foldr',                 -- :: (Word8 -> a -> a) -> a -> ByteString -> a
-        foldr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-        foldr1',                -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-
-        -- ** Special folds
-        concat,                 -- :: [ByteString] -> ByteString
-        concatMap,              -- :: (Word8 -> ByteString) -> ByteString -> ByteString
-        any,                    -- :: (Word8 -> Bool) -> ByteString -> Bool
-        all,                    -- :: (Word8 -> Bool) -> ByteString -> Bool
-        maximum,                -- :: ByteString -> Word8
-        minimum,                -- :: ByteString -> Word8
-
-        -- * Building ByteStrings
-        -- ** Scans
-        scanl,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
-        scanl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
-        scanr,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
-        scanr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
-
-        -- ** Accumulating maps
-        mapAccumL,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
-        mapAccumR,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
-        mapIndexed,             -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
-
-        -- ** Unfolding ByteStrings
-        replicate,              -- :: Int -> Word8 -> ByteString
-        unfoldr,                -- :: (a -> Maybe (Word8, a)) -> a -> ByteString
-        unfoldrN,               -- :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
-
-        -- * Substrings
-
-        -- ** Breaking strings
-        take,                   -- :: Int -> ByteString -> ByteString
-        drop,                   -- :: Int -> ByteString -> ByteString
-        splitAt,                -- :: Int -> ByteString -> (ByteString, ByteString)
-        takeWhile,              -- :: (Word8 -> Bool) -> ByteString -> ByteString
-        dropWhile,              -- :: (Word8 -> Bool) -> ByteString -> ByteString
-        span,                   -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-        spanEnd,                -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-        break,                  -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-        breakEnd,               -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-        group,                  -- :: ByteString -> [ByteString]
-        groupBy,                -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
-        inits,                  -- :: ByteString -> [ByteString]
-        tails,                  -- :: ByteString -> [ByteString]
-
-        -- ** Breaking into many substrings
-        split,                  -- :: Word8 -> ByteString -> [ByteString]
-        splitWith,              -- :: (Word8 -> Bool) -> ByteString -> [ByteString]
-
-        -- ** Joining strings
-        join,                   -- :: ByteString -> [ByteString] -> ByteString
-
-        -- * Predicates
-        isPrefixOf,             -- :: ByteString -> ByteString -> Bool
-        isSuffixOf,             -- :: ByteString -> ByteString -> Bool
-
-        -- ** Search for arbitrary substrings
-        isSubstringOf,          -- :: ByteString -> ByteString -> Bool
-        findSubstring,          -- :: ByteString -> ByteString -> Maybe Int
-        findSubstrings,         -- :: ByteString -> ByteString -> [Int]
-
-        -- * Searching ByteStrings
-
-        -- ** Searching by equality
-        -- | These functions use memchr(3) to efficiently search the ByteString
-        elem,                   -- :: Word8 -> ByteString -> Bool
-        notElem,                -- :: Word8 -> ByteString -> Bool
-
-        -- ** Searching with a predicate
-        find,                   -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8
-        filter,                 -- :: (Word8 -> Bool) -> ByteString -> ByteString
---      partition               -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-
-        -- * Indexing ByteStrings
-        index,                  -- :: ByteString -> Int -> Word8
-        elemIndex,              -- :: Word8 -> ByteString -> Maybe Int
-        elemIndices,            -- :: Word8 -> ByteString -> [Int]
-        elemIndexEnd,           -- :: Word8 -> ByteString -> Maybe Int
-        findIndex,              -- :: (Word8 -> Bool) -> ByteString -> Maybe Int
-        findIndices,            -- :: (Word8 -> Bool) -> ByteString -> [Int]
-        count,                  -- :: Word8 -> ByteString -> Int
-
-        -- * Zipping and unzipping ByteStrings
-        zip,                    -- :: ByteString -> ByteString -> [(Word8,Word8)]
-        zipWith,                -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]
-        unzip,                  -- :: [(Word8,Word8)] -> (ByteString,ByteString)
-
-        -- * Ordered ByteStrings
-        sort,                   -- :: ByteString -> ByteString
-
-        -- * Low level CString conversions
-
-        -- ** Packing CStrings and pointers
-        packCString,            -- :: CString -> ByteString
-        packCStringLen,         -- :: CString -> ByteString
-        packMallocCString,      -- :: CString -> ByteString
-
-        -- ** Using ByteStrings as CStrings
-        useAsCString,           -- :: ByteString -> (CString -> IO a) -> IO a
-        useAsCStringLen,        -- :: ByteString -> (CStringLen -> IO a) -> IO a
-
-        -- ** Copying ByteStrings
-        -- | These functions perform memcpy(3) operations
-        copy,                   -- :: ByteString -> ByteString
-        copyCString,            -- :: CString -> IO ByteString
-        copyCStringLen,         -- :: CStringLen -> IO ByteString
-
-        -- * I\/O with 'ByteString's
-
-        -- ** Standard input and output
-        getLine,                -- :: IO ByteString
-        getContents,            -- :: IO ByteString
-        putStr,                 -- :: ByteString -> IO ()
-        putStrLn,               -- :: ByteString -> IO ()
-        interact,               -- :: (ByteString -> ByteString) -> IO ()
-
-        -- ** Files
-        readFile,               -- :: FilePath -> IO ByteString
-        writeFile,              -- :: FilePath -> ByteString -> IO ()
-        appendFile,             -- :: FilePath -> ByteString -> IO ()
---      mmapFile,               -- :: FilePath -> IO ByteString
-
-        -- ** I\/O with Handles
-        hGetLine,               -- :: Handle -> IO ByteString
-        hGetContents,           -- :: Handle -> IO ByteString
-        hGet,                   -- :: Handle -> Int -> IO ByteString
-        hGetNonBlocking,        -- :: Handle -> Int -> IO ByteString
-        hPut,                   -- :: Handle -> ByteString -> IO ()
-        hPutStr,                -- :: Handle -> ByteString -> IO ()
-        hPutStrLn,              -- :: Handle -> ByteString -> IO ()
-
-#if defined(__GLASGOW_HASKELL__)
-        -- * Fusion utilities
-        unpackList, -- eek, otherwise it gets thrown away by the simplifier
-        lengthU, maximumU, minimumU
-#endif
-
-  ) where
-
-import qualified Prelude as P
-import Prelude hiding           (reverse,head,tail,last,init,null
-                                ,length,map,lines,foldl,foldr,unlines
-                                ,concat,any,take,drop,splitAt,takeWhile
-                                ,dropWhile,span,break,elem,filter,maximum
-                                ,minimum,all,concatMap,foldl1,foldr1
-                                ,scanl,scanl1,scanr,scanr1
-                                ,readFile,writeFile,appendFile,replicate
-                                ,getContents,getLine,putStr,putStrLn,interact
-                                ,zip,zipWith,unzip,notElem)
-
-import Data.ByteString.Base
-import Data.ByteString.Fusion
-
-import qualified Data.List as List
-
-import Data.Word                (Word8)
-import Data.Maybe               (listToMaybe)
-import Data.Array               (listArray)
-import qualified Data.Array as Array ((!))
-
--- Control.Exception.bracket not available in yhc or nhc
-import Control.Exception        (bracket, assert)
-import qualified Control.Exception as Exception
-import Control.Monad            (when)
-
-import Foreign.C.String         (CString, CStringLen)
-import Foreign.C.Types          (CSize)
-import Foreign.ForeignPtr
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable         (Storable(..))
-
--- hGetBuf and hPutBuf not available in yhc or nhc
-import System.IO                (stdin,stdout,hClose,hFileSize
-                                ,hGetBuf,hPutBuf,openBinaryFile
-                                ,Handle,IOMode(..))
-
-import Data.Monoid              (Monoid, mempty, mappend, mconcat)
-
-#if !defined(__GLASGOW_HASKELL__)
-import System.IO.Unsafe
-import qualified System.Environment
-import qualified System.IO      (hGetLine)
-#endif
-
-#if defined(__GLASGOW_HASKELL__)
-
-import System.IO                (hGetBufNonBlocking)
-import System.IO.Error          (isEOFError)
-
-import GHC.Handle
-import GHC.Prim                 (Word#, (+#), writeWord8OffAddr#)
-import GHC.Base                 (build)
-import GHC.Word hiding (Word8)
-import GHC.Ptr                  (Ptr(..))
-import GHC.ST                   (ST(..))
-import GHC.IOBase
-
-#endif
-
--- -----------------------------------------------------------------------------
---
--- Useful macros, until we have bang patterns
---
-
-#define STRICT1(f) f a | a `seq` False = undefined
-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
-
--- -----------------------------------------------------------------------------
-
-instance Eq  ByteString
-    where (==)    = eq
-
-instance Ord ByteString
-    where compare = compareBytes
-
-instance Monoid ByteString where
-    mempty  = empty
-    mappend = append
-    mconcat = concat
-
-{-
-instance Arbitrary PackedString where
-    arbitrary = P.pack `fmap` arbitrary
-    coarbitrary s = coarbitrary (P.unpack s)
--}
-
--- | /O(n)/ Equality on the 'ByteString' type.
-eq :: ByteString -> ByteString -> Bool
-eq a@(PS p s l) b@(PS p' s' l')
-    | l /= l'            = False    -- short cut on length
-    | p == p' && s == s' = True     -- short cut for the same string
-    | otherwise          = compareBytes a b == EQ
-{-# INLINE eq #-}
-
--- | /O(n)/ 'compareBytes' provides an 'Ordering' for 'ByteStrings' supporting slices. 
-compareBytes :: ByteString -> ByteString -> Ordering
-compareBytes (PS x1 s1 l1) (PS x2 s2 l2)
-    | l1 == 0  && l2 == 0               = EQ  -- short cut for empty strings
-    | x1 == x2 && s1 == s2 && l1 == l2  = EQ  -- short cut for the same string
-    | otherwise                         = inlinePerformIO $
-        withForeignPtr x1 $ \p1 ->
-        withForeignPtr x2 $ \p2 -> do
-            i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2)
-            return $! case i `compare` 0 of
-                        EQ  -> l1 `compare` l2
-                        x   -> x
-{-# INLINE compareBytes #-}
-
-{-
---
--- About 4x slower over 32M
---
-compareBytes :: ByteString -> ByteString -> Ordering
-compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) = inlinePerformIO $
-    withForeignPtr fp1 $ \p1 ->
-        withForeignPtr fp2 $ \p2 ->
-            cmp (p1 `plusPtr` off1)
-                (p2 `plusPtr` off2) 0 len1 len2
-
-cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering
-STRICT5(cmp)
-cmp p1 p2 n len1 len2
-      | n == len1 = if n == len2 then return EQ else return LT
-      | n == len2 = return GT
-      | otherwise = do
-          (a :: Word8) <- peekByteOff p1 n
-          (b :: Word8) <- peekByteOff p2 n
-          case a `compare` b of
-                EQ -> cmp p1 p2 (n+1) len1 len2
-                LT -> return LT
-                GT -> return GT
-{-# INLINE compareBytes #-}
--}
-
--- -----------------------------------------------------------------------------
--- Introducing and eliminating 'ByteString's
-
--- | /O(1)/ Convert a 'Word8' into a 'ByteString'
-singleton :: Word8 -> ByteString
-singleton c = unsafeCreate 1 $ \p -> poke p c
-{-# INLINE [1] singleton #-}
-
---
--- XXX The unsafePerformIO is critical!
---
--- Otherwise:
---
---  singleton 255 `compare` singleton 127
---
--- is compiled to:
---
---  case mallocByteString 2 of 
---      ForeignPtr f internals -> 
---           case writeWord8OffAddr# f 0 255 of _ -> 
---           case writeWord8OffAddr# f 0 127 of _ ->
---           case eqAddr# f f of 
---                  False -> case compare (GHC.Prim.plusAddr# f 0) 
---                                        (GHC.Prim.plusAddr# f 0)
---
---
-
--- | /O(n)/ Convert a '[Word8]' into a 'ByteString'. 
---
--- For applications with large numbers of string literals, pack can be a
--- bottleneck. In such cases, consider using packAddress (GHC only).
-pack :: [Word8] -> ByteString
-
-#if !defined(__GLASGOW_HASKELL__)
-
-pack str = unsafeCreate (P.length str) $ \p -> go p str
-    where
-        go _ []     = return ()
-        go p (x:xs) = poke p x >> go (p `plusPtr` 1) xs -- less space than pokeElemOff
-
-#else /* hack away */
-
-pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str)
-    where
-        go _ _ []        = return ()
-        go p i (W8# c:cs) = writeByte p i c >> go p (i +# 1#) cs
-
-        writeByte p i c = ST $ \s# ->
-            case writeWord8OffAddr# p i c s# of s2# -> (# s2#, () #)
-
-#endif
-
--- | /O(n)/ Converts a 'ByteString' to a '[Word8]'.
-unpack :: ByteString -> [Word8]
-
-#if !defined(__GLASGOW_HASKELL__)
-
-unpack (PS _  _ 0) = []
-unpack (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p ->
-        go (p `plusPtr` s) (l - 1) []
-    where
-        STRICT3(go)
-        go p 0 acc = peek p          >>= \e -> return (e : acc)
-        go p n acc = peekByteOff p n >>= \e -> go p (n-1) (e : acc)
-{-# INLINE unpack #-}
-
-#else
-
-unpack ps = build (unpackFoldr ps)
-{-# INLINE unpack #-}
-
---
--- critical this isn't strict in the acc
--- as it will break in the presence of list fusion. this is a known
--- issue with seq and build/foldr rewrite rules, which rely on lazy
--- demanding to avoid bottoms in the list.
---
-unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
-unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do
-    let loop q n    _   | q `seq` n `seq` False = undefined -- n.b.
-        loop _ (-1) acc = return acc
-        loop q n    acc = do
-           a <- peekByteOff q n
-           loop q (n-1) (a `f` acc)
-    loop (p `plusPtr` off) (len-1) ch
-{-# INLINE [0] unpackFoldr #-}
-
-unpackList :: ByteString -> [Word8]
-unpackList (PS fp off len) = withPtr fp $ \p -> do
-    let STRICT3(loop)
-        loop _ (-1) acc = return acc
-        loop q n acc = do
-           a <- peekByteOff q n
-           loop q (n-1) (a : acc)
-    loop (p `plusPtr` off) (len-1) []
-
-{-# RULES
-    "FPS unpack-list"  [1]  forall p  . unpackFoldr p (:) [] = unpackList p
- #-}
-
-#endif
-
--- ---------------------------------------------------------------------
--- Basic interface
-
--- | /O(1)/ Test whether a ByteString is empty.
-null :: ByteString -> Bool
-null (PS _ _ l) = assert (l >= 0) $ l <= 0
-{-# INLINE null #-}
-
--- ---------------------------------------------------------------------
--- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'.
-length :: ByteString -> Int
-length (PS _ _ l) = assert (l >= 0) $ l
-
---
--- length/loop fusion. When taking the length of any fuseable loop,
--- rewrite it as a foldl', and thus avoid allocating the result buffer
--- worth around 10% in speed testing.
---
-
-#if defined(__GLASGOW_HASKELL__)
-{-# INLINE [1] length #-}
-#endif
-
-lengthU :: ByteString -> Int
-lengthU = foldl' (const . (+1)) (0::Int)
-{-# INLINE lengthU #-}
-
-{-# RULES
-
--- v2 fusion
-"FPS length/loop" forall loop s .
-  length  (loopArr (loopWrapper loop s)) =
-  lengthU (loopArr (loopWrapper loop s))
-
-  #-}
-
-------------------------------------------------------------------------
-
--- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
--- complexity, as it requires a memcpy.
-cons :: Word8 -> ByteString -> ByteString
-cons c (PS x s l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
-        poke p c
-        memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
-{-# INLINE cons #-}
-
--- | /O(n)/ Append a byte to the end of a 'ByteString'
-snoc :: ByteString -> Word8 -> ByteString
-snoc (PS x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
-        memcpy p (f `plusPtr` s) (fromIntegral l)
-        poke (p `plusPtr` l) c
-{-# INLINE snoc #-}
-
--- todo fuse
-
--- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.
--- An exception will be thrown in the case of an empty ByteString.
-head :: ByteString -> Word8
-head (PS x s l)
-    | l <= 0    = errorEmptyList "head"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s
-{-# INLINE head #-}
-
--- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.
--- An exception will be thrown in the case of an empty ByteString.
-tail :: ByteString -> ByteString
-tail (PS p s l)
-    | l <= 0    = errorEmptyList "tail"
-    | otherwise = PS p (s+1) (l-1)
-{-# INLINE tail #-}
-
--- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty.
--- An exception will be thrown in the case of an empty ByteString.
-last :: ByteString -> Word8
-last ps@(PS x s l)
-    | null ps   = errorEmptyList "last"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1)
-{-# INLINE last #-}
-
--- | /O(1)/ Return all the elements of a 'ByteString' except the last one.
--- An exception will be thrown in the case of an empty ByteString.
-init :: ByteString -> ByteString
-init ps@(PS p s l)
-    | null ps   = errorEmptyList "init"
-    | otherwise = PS p s (l-1)
-{-# INLINE init #-}
-
--- | /O(n)/ Append two ByteStrings
-append :: ByteString -> ByteString -> ByteString
-append xs ys | null xs   = ys
-             | null ys   = xs
-             | otherwise = concat [xs,ys]
-{-# INLINE append #-}
-
--- ---------------------------------------------------------------------
--- Transformations
-
--- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each
--- element of @xs@. This function is subject to array fusion.
-map :: (Word8 -> Word8) -> ByteString -> ByteString
-#if defined(LOOPU_FUSION)
-map f = loopArr . loopU (mapEFL f) NoAcc
-#elif defined(LOOPUP_FUSION)
-map f = loopArr . loopUp (mapEFL f) NoAcc
-#elif defined(LOOPNOACC_FUSION)
-map f = loopArr . loopNoAcc (mapEFL f)
-#else
-map f = loopArr . loopMap f
-#endif
-{-# INLINE map #-}
-
-{-
--- | /O(n)/ Like 'map', but not fuseable. The benefit is that it is
--- slightly faster for one-shot cases.
-map' :: (Word8 -> Word8) -> ByteString -> ByteString
-map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->
-    create len $ map_ 0 (a `plusPtr` s)
-  where
-    map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
-    STRICT3(map_)
-    map_ n p1 p2
-       | n >= len = return ()
-       | otherwise = do
-            x <- peekByteOff p1 n
-            pokeByteOff p2 n (f x)
-            map_ (n+1) p1 p2
-{-# INLINE map' #-}
--}
-
--- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
-reverse :: ByteString -> ByteString
-reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
-        c_reverse p (f `plusPtr` s) (fromIntegral l)
-
--- todo, fuseable version
-
--- | /O(n)/ The 'intersperse' function takes a 'Word8' and a
--- 'ByteString' and \`intersperses\' that byte between the elements of
--- the 'ByteString'.  It is analogous to the intersperse function on
--- Lists.
-intersperse :: Word8 -> ByteString -> ByteString
-intersperse c ps@(PS x s l)
-    | length ps < 2  = ps
-    | otherwise      = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f ->
-        c_intersperse p (f `plusPtr` s) (fromIntegral l) c
-
-{-
-intersperse c = pack . List.intersperse c . unpack
--}
-
--- | The 'transpose' function transposes the rows and columns of its
--- 'ByteString' argument.
-transpose :: [ByteString] -> [ByteString]
-transpose ps = P.map pack (List.transpose (P.map unpack ps))
-
--- ---------------------------------------------------------------------
--- Reducing 'ByteString's
-
--- | 'foldl', applied to a binary operator, a starting value (typically
--- the left-identity of the operator), and a ByteString, reduces the
--- ByteString using the binary operator, from left to right.
--- This function is subject to array fusion.
-foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
-#if !defined(LOOPU_FUSION)
-foldl f z = loopAcc . loopUp (foldEFL f) z
-#else
-foldl f z = loopAcc . loopU (foldEFL f) z
-#endif
-{-# INLINE foldl #-}
-
-{-
---
--- About twice as fast with 6.4.1, but not fuseable
--- A simple fold . map is enough to make it worth while.
---
-foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
-        lgo v (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
-    where
-        STRICT3(lgo)
-        lgo z p q | p == q    = return z
-                  | otherwise = do c <- peek p
-                                   lgo (f z c) (p `plusPtr` 1) q
--}
-
--- | 'foldl\'' is like 'foldl', but strict in the accumulator.
--- Though actually foldl is also strict in the accumulator.
-foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
-foldl' = foldl
--- foldl' f z = loopAcc . loopU (foldEFL' f) z
-{-# INLINE foldl' #-}
-
--- | 'foldr', applied to a binary operator, a starting value
--- (typically the right-identity of the operator), and a ByteString,
--- reduces the ByteString using the binary operator, from right to left.
-foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
-foldr k z = loopAcc . loopDown (foldEFL (flip k)) z
-{-# INLINE foldr #-}
-
--- | 'foldr\'' is like 'foldr', but strict in the accumulator.
-foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
-foldr' k v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
-        go v (ptr `plusPtr` (s+l-1)) (ptr `plusPtr` (s-1))
-    where
-        STRICT3(go)
-        go z p q | p == q    = return z
-                 | otherwise = do c  <- peek p
-                                  go (c `k` z) (p `plusPtr` (-1)) q -- tail recursive
-{-# INLINE [1] foldr' #-}
-
--- | 'foldl1' is a variant of 'foldl' that has no starting value
--- argument, and thus must be applied to non-empty 'ByteStrings'.
--- This function is subject to array fusion. 
--- An exception will be thrown in the case of an empty ByteString.
-foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-foldl1 f ps
-    | null ps   = errorEmptyList "foldl1"
-    | otherwise = foldl f (unsafeHead ps) (unsafeTail ps)
-{-# INLINE foldl1 #-}
-
--- | 'foldl1\'' is like 'foldl1', but strict in the accumulator.
--- An exception will be thrown in the case of an empty ByteString.
-foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-foldl1' f ps
-    | null ps   = errorEmptyList "foldl1'"
-    | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps)
-{-# INLINE foldl1' #-}
-
--- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
--- and thus must be applied to non-empty 'ByteString's
--- An exception will be thrown in the case of an empty ByteString.
-foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-foldr1 f ps
-    | null ps        = errorEmptyList "foldr1"
-    | otherwise      = foldr f (last ps) (init ps)
-{-# INLINE foldr1 #-}
-
--- | 'foldr1\'' is a variant of 'foldr1', but is strict in the
--- accumulator.
-foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-foldr1' f ps
-    | null ps        = errorEmptyList "foldr1"
-    | otherwise      = foldr' f (last ps) (init ps)
-{-# INLINE [1] foldr1' #-}
-
--- ---------------------------------------------------------------------
--- Special folds
-
--- | /O(n)/ Concatenate a list of ByteStrings.
-concat :: [ByteString] -> ByteString
-concat []     = empty
-concat [ps]   = ps
-concat xs     = unsafeCreate len $ \ptr -> go xs ptr
-  where len = P.sum . P.map length $ xs
-        STRICT2(go)
-        go []            _   = return ()
-        go (PS p s l:ps) ptr = do
-                withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` s) (fromIntegral l)
-                go ps (ptr `plusPtr` l)
-
--- | Map a function over a 'ByteString' and concatenate the results
-concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
-concatMap f = concat . foldr ((:) . f) []
-
--- foldr (append . f) empty
-
--- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if
--- any element of the 'ByteString' satisfies the predicate.
-any :: (Word8 -> Bool) -> ByteString -> Bool
-any _ (PS _ _ 0) = False
-any f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
-        go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
-    where
-        STRICT2(go)
-        go p q | p == q    = return False
-               | otherwise = do c <- peek p
-                                if f c then return True
-                                       else go (p `plusPtr` 1) q
-
--- todo fuse
-
--- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines
--- if all elements of the 'ByteString' satisfy the predicate.
-all :: (Word8 -> Bool) -> ByteString -> Bool
-all _ (PS _ _ 0) = True
-all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
-        go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
-    where
-        STRICT2(go)
-        go p q | p == q     = return True  -- end of list
-               | otherwise  = do c <- peek p
-                                 if f c
-                                    then go (p `plusPtr` 1) q
-                                    else return False
-
-------------------------------------------------------------------------
-
--- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString'
--- This function will fuse.
--- An exception will be thrown in the case of an empty ByteString.
-maximum :: ByteString -> Word8
-maximum xs@(PS x s l)
-    | null xs   = errorEmptyList "maximum"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
-                      c_maximum (p `plusPtr` s) (fromIntegral l)
-
--- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString'
--- This function will fuse.
--- An exception will be thrown in the case of an empty ByteString.
-minimum :: ByteString -> Word8
-minimum xs@(PS x s l)
-    | null xs   = errorEmptyList "minimum"
-    | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
-                      c_minimum (p `plusPtr` s) (fromIntegral l)
-
---
--- minimum/maximum/loop fusion. As for length (and other folds), when we
--- see we're applied after a fuseable op, switch from using the C
--- version, to the fuseable version. The result should then avoid
--- allocating a buffer.
---
-
-#if defined(__GLASGOW_HASKELL__)
-{-# INLINE [1] minimum #-}
-{-# INLINE [1] maximum #-}
-#endif
-
-maximumU :: ByteString -> Word8
-maximumU = foldl1' max
-{-# INLINE maximumU #-}
-
-minimumU :: ByteString -> Word8
-minimumU = foldl1' min
-{-# INLINE minimumU #-}
-
-{-# RULES
-
-"FPS minimum/loop" forall loop s .
-  minimum  (loopArr (loopWrapper loop s)) =
-  minimumU (loopArr (loopWrapper loop s))
-
-"FPS maximum/loop" forall loop s .
-  maximum  (loopArr (loopWrapper loop s)) =
-  maximumU (loopArr (loopWrapper loop s))
-
-  #-}
-
-------------------------------------------------------------------------
-
--- | The 'mapAccumL' function behaves like a combination of 'map' and
--- 'foldl'; it applies a function to each element of a ByteString,
--- passing an accumulating parameter from left to right, and returning a
--- final value of this accumulator together with the new list.
-mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
-#if !defined(LOOPU_FUSION)
-mapAccumL f z = unSP . loopUp (mapAccumEFL f) z
-#else
-mapAccumL f z = unSP . loopU (mapAccumEFL f) z
-#endif
-{-# INLINE mapAccumL #-}
-
--- | The 'mapAccumR' function behaves like a combination of 'map' and
--- 'foldr'; it applies a function to each element of a ByteString,
--- passing an accumulating parameter from right to left, and returning a
--- final value of this accumulator together with the new ByteString.
-mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
-mapAccumR f z = unSP . loopDown (mapAccumEFL f) z
-{-# INLINE mapAccumR #-}
-
--- | /O(n)/ map Word8 functions, provided with the index at each position
-mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
-mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0
-{-# INLINE mapIndexed #-}
-
--- ---------------------------------------------------------------------
--- Building ByteStrings
-
--- | 'scanl' is similar to 'foldl', but returns a list of successive
--- reduced values from the left. This function will fuse.
---
--- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
---
--- Note that
---
--- > last (scanl f z xs) == foldl f z xs.
-scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
-#if !defined(LOOPU_FUSION)
-scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0)
-#else
-scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0)
-#endif
-
-    -- n.b. haskell's List scan returns a list one bigger than the
-    -- input, so we need to snoc here to get some extra space, however,
-    -- it breaks map/up fusion (i.e. scanl . map no longer fuses)
-{-# INLINE scanl #-}
-
--- | 'scanl1' is a variant of 'scanl' that has no starting value argument.
--- This function will fuse.
---
--- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
-scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
-scanl1 f ps
-    | null ps   = empty
-    | otherwise = scanl f (unsafeHead ps) (unsafeTail ps)
-{-# INLINE scanl1 #-}
-
--- | scanr is the right-to-left dual of scanl.
-scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
-scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space
-{-# INLINE scanr #-}
-
--- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
-scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
-scanr1 f ps
-    | null ps   = empty
-    | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions
-{-# INLINE scanr1 #-}
-
--- ---------------------------------------------------------------------
--- Unfolds and replicates
-
--- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
--- the value of every element. The following holds:
---
--- > replicate w c = unfoldr w (\u -> Just (u,u)) c
---
--- This implemenation uses @memset(3)@
-replicate :: Int -> Word8 -> ByteString
-replicate w c
-    | w <= 0    = empty
-    | otherwise = unsafeCreate w $ \ptr ->
-                      memset ptr c (fromIntegral w) >> return ()
-
--- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr' 
--- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a 
--- ByteString from a seed value.  The function takes the element and 
--- returns 'Nothing' if it is done producing the ByteString or returns 
--- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string, 
--- and @b@ is the seed value for further production.
---
--- Examples:
---
--- >    unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
--- > == pack [0, 1, 2, 3, 4, 5]
---
-unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString
-unfoldr f = concat . unfoldChunk 32 64
-  where unfoldChunk n n' x =
-          case unfoldrN n f x of
-            (s, Nothing) -> s : []
-            (s, Just x') -> s : unfoldChunk n' (n+n') x'
-
--- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed
--- value.  However, the length of the result is limited by the first
--- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'
--- when the maximum length of the result is known.
---
--- The following equation relates 'unfoldrN' and 'unfoldr':
---
--- > unfoldrN n f s == take n (unfoldr f s)
---
-unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
-unfoldrN i f x0
-    | i < 0     = (empty, Just x0)
-    | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0
-  where STRICT3(go)
-        go p x n =
-          case f x of
-            Nothing      -> return (0, n, Nothing)
-            Just (w,x')
-             | n == i    -> return (0, n, Just x)
-             | otherwise -> do poke p w
-                               go (p `plusPtr` 1) x' (n+1)
-
--- ---------------------------------------------------------------------
--- Substrings
-
--- | /O(1)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix
--- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
-take :: Int -> ByteString -> ByteString
-take n ps@(PS x s l)
-    | n <= 0    = empty
-    | n >= l    = ps
-    | otherwise = PS x s n
-{-# INLINE take #-}
-
--- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@
--- elements, or @[]@ if @n > 'length' xs@.
-drop  :: Int -> ByteString -> ByteString
-drop n ps@(PS x s l)
-    | n <= 0    = ps
-    | n >= l    = empty
-    | otherwise = PS x (s+n) (l-n)
-{-# INLINE drop #-}
-
--- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.
-splitAt :: Int -> ByteString -> (ByteString, ByteString)
-splitAt n ps@(PS x s l)
-    | n <= 0    = (empty, ps)
-    | n >= l    = (ps, empty)
-    | otherwise = (PS x s n, PS x (s+n) (l-n))
-{-# INLINE splitAt #-}
-
--- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@,
--- returns the longest prefix (possibly empty) of @xs@ of elements that
--- satisfy @p@.
-takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
-takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps
-{-# INLINE takeWhile #-}
-
--- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.
-dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
-dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps
-{-# INLINE dropWhile #-}
-
--- | 'break' @p@ is equivalent to @'span' ('not' . p)@.
-break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps)
-{-# INLINE [1] break #-}
-
-{-# RULES
-"FPS specialise break (x==)" forall x.
-    break ((==) x) = breakByte x
-  #-}
-
-#if __GLASGOW_HASKELL__ >= 605
-{-# RULES
-"FPS specialise break (==x)" forall x.
-    break (==x) = breakByte x
-  #-}
-#endif
-
--- | 'breakByte' breaks its ByteString argument at the first occurence
--- of the specified byte. It is more efficient than 'break' as it is
--- implemented with @memchr(3)@. I.e.
--- 
--- > break (=='c') "abcd" == breakByte 'c' "abcd"
---
-breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
-breakByte c p = case elemIndex c p of
-    Nothing -> (p,empty)
-    Just n  -> (unsafeTake n p, unsafeDrop n p)
-{-# INLINE breakByte #-}
-
--- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString'
--- 
--- breakEnd p == spanEnd (not.p)
-breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-breakEnd  p ps = splitAt (findFromEndUntil p ps) ps
-
--- | 'span' @p xs@ breaks the ByteString into two segments. It is
--- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
-span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-span p ps = break (not . p) ps
-{-# INLINE [1] span #-}
-
--- | 'spanByte' breaks its ByteString argument at the first
--- occurence of a byte other than its argument. It is more efficient
--- than 'span (==)'
---
--- > span  (=='c') "abcd" == spanByte 'c' "abcd"
---
-spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
-spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
-    go (p `plusPtr` s) 0
-  where
-    STRICT2(go)
-    go p i | i >= l    = return (ps, empty)
-           | otherwise = do c' <- peekByteOff p i
-                            if c /= c'
-                                then return (unsafeTake i ps, unsafeDrop i ps)
-                                else go p (i+1)
-{-# INLINE spanByte #-}
-
-{-# RULES
-"FPS specialise span (x==)" forall x.
-    span ((==) x) = spanByte x
-  #-}
-
-#if __GLASGOW_HASKELL__ >= 605
-{-# RULES
-"FPS specialise span (==x)" forall x.
-    span (==x) = spanByte x
-  #-}
-#endif
-
--- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'.
--- We have
---
--- > spanEnd (not.isSpace) "x y z" == ("x y ","z")
---
--- and
---
--- > spanEnd (not . isSpace) ps
--- >    == 
--- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x) 
---
-spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-spanEnd  p ps = splitAt (findFromEndUntil (not.p) ps) ps
-
--- | /O(n)/ Splits a 'ByteString' into components delimited by
--- separators, where the predicate returns True for a separator element.
--- The resulting components do not contain the separators.  Two adjacent
--- separators result in an empty component in the output.  eg.
---
--- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
--- > splitWith (=='a') []        == []
---
-splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
-
-#if defined(__GLASGOW_HASKELL__)
-splitWith _pred (PS _  _   0) = []
-splitWith pred_ (PS fp off len) = splitWith0 pred# off len fp
-  where pred# c# = pred_ (W8# c#)
-
-        STRICT4(splitWith0)
-        splitWith0 pred' off' len' fp' = withPtr fp $ \p ->
-            splitLoop pred' p 0 off' len' fp'
-
-        splitLoop :: (Word# -> Bool)
-                  -> Ptr Word8
-                  -> Int -> Int -> Int
-                  -> ForeignPtr Word8
-                  -> IO [ByteString]
-
-        splitLoop pred' p idx' off' len' fp'
-            | pred' `seq` p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
-            | idx' >= len'  = return [PS fp' off' idx']
-            | otherwise = do
-                w <- peekElemOff p (off'+idx')
-                if pred' (case w of W8# w# -> w#)
-                   then return (PS fp' off' idx' :
-                              splitWith0 pred' (off'+idx'+1) (len'-idx'-1) fp')
-                   else splitLoop pred' p (idx'+1) off' len' fp'
-{-# INLINE splitWith #-}
-
-#else
-splitWith _ (PS _ _ 0) = []
-splitWith p ps = loop p ps
-    where
-        STRICT2(loop)
-        loop q qs = if null rest then [chunk]
-                                 else chunk : loop q (unsafeTail rest)
-            where (chunk,rest) = break q qs
-#endif
-
--- | /O(n)/ Break a 'ByteString' into pieces separated by the byte
--- argument, consuming the delimiter. I.e.
---
--- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
--- > split 'a'  "aXaXaXa"    == ["","X","X","X",""]
--- > split 'x'  "x"          == ["",""]
--- 
--- and
---
--- > join [c] . split c == id
--- > split == splitWith . (==)
--- 
--- As for all splitting functions in this library, this function does
--- not copy the substrings, it just constructs new 'ByteStrings' that
--- are slices of the original.
---
-split :: Word8 -> ByteString -> [ByteString]
-split _ (PS _ _ 0) = []
-split w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
-    let ptr = p `plusPtr` s
-
-        STRICT1(loop)
-        loop n =
-            let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
-                                           w (fromIntegral (l-n))
-            in if q == nullPtr
-                then [PS x (s+n) (l-n)]
-                else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1)
-
-    return (loop 0)
-{-# INLINE split #-}
-
-{-
--- slower. but stays inside Haskell.
-split _ (PS _  _   0) = []
-split (W8# w#) (PS fp off len) = splitWith' off len fp
-    where
-        splitWith' off' len' fp' = withPtr fp $ \p ->
-            splitLoop p 0 off' len' fp'
-
-        splitLoop :: Ptr Word8
-                  -> Int -> Int -> Int
-                  -> ForeignPtr Word8
-                  -> IO [ByteString]
-
-        STRICT5(splitLoop)
-        splitLoop p idx' off' len' fp'
-            | p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
-            | idx' >= len'  = return [PS fp' off' idx']
-            | otherwise = do
-                (W8# x#) <- peekElemOff p (off'+idx')
-                if word2Int# w# ==# word2Int# x#
-                   then return (PS fp' off' idx' :
-                              splitWith' (off'+idx'+1) (len'-idx'-1) fp')
-                   else splitLoop p (idx'+1) off' len' fp'
--}
-
-{-
--- | Like 'splitWith', except that sequences of adjacent separators are
--- treated as a single separator. eg.
--- 
--- > tokens (=='a') "aabbaca" == ["bb","c"]
---
-tokens :: (Word8 -> Bool) -> ByteString -> [ByteString]
-tokens f = P.filter (not.null) . splitWith f
-{-# INLINE tokens #-}
--}
-
--- | The 'group' function takes a ByteString and returns a list of
--- ByteStrings such that the concatenation of the result is equal to the
--- argument.  Moreover, each sublist in the result contains only equal
--- elements.  For example,
---
--- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
---
--- It is a special case of 'groupBy', which allows the programmer to
--- supply their own equality test. It is about 40% faster than 
--- /groupBy (==)/
-group :: ByteString -> [ByteString]
-group xs
-    | null xs   = []
-    | otherwise = ys : group zs
-    where
-        (ys, zs) = spanByte (unsafeHead xs) xs
-
--- | The 'groupBy' function is the non-overloaded version of 'group'.
-groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
-groupBy k xs
-    | null xs   = []
-    | otherwise = unsafeTake n xs : groupBy k (unsafeDrop n xs)
-    where
-        n = 1 + findIndexOrEnd (not . k (unsafeHead xs)) (unsafeTail xs)
-
--- | /O(n)/ The 'join' function takes a 'ByteString' and a list of
--- 'ByteString's and concatenates the list after interspersing the first
--- argument between each element of the list.
-join :: ByteString -> [ByteString] -> ByteString
-join s = concat . (List.intersperse s)
-{-# INLINE [1] join #-}
-
-{-# RULES
-"FPS specialise join c -> joinByte" forall c s1 s2 .
-    join (singleton c) (s1 : s2 : []) = joinWithByte c s1 s2
-  #-}
-
---
--- | /O(n)/ joinWithByte. An efficient way to join to two ByteStrings
--- with a char. Around 4 times faster than the generalised join.
---
-joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString
-joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = unsafeCreate len $ \ptr ->
-    withForeignPtr ffp $ \fp ->
-    withForeignPtr fgp $ \gp -> do
-        memcpy ptr (fp `plusPtr` s) (fromIntegral l)
-        poke (ptr `plusPtr` l) c
-        memcpy (ptr `plusPtr` (l + 1)) (gp `plusPtr` t) (fromIntegral m)
-    where
-      len = length f + length g + 1
-{-# INLINE joinWithByte #-}
-
--- ---------------------------------------------------------------------
--- Indexing ByteStrings
-
--- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
-index :: ByteString -> Int -> Word8
-index ps n
-    | n < 0          = moduleError "index" ("negative index: " ++ show n)
-    | n >= length ps = moduleError "index" ("index too large: " ++ show n
-                                         ++ ", length = " ++ show (length ps))
-    | otherwise      = ps `unsafeIndex` n
-{-# INLINE index #-}
-
--- | /O(n)/ The 'elemIndex' function returns the index of the first
--- element in the given 'ByteString' which is equal to the query
--- element, or 'Nothing' if there is no such element. 
--- This implementation uses memchr(3).
-elemIndex :: Word8 -> ByteString -> Maybe Int
-elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
-    let p' = p `plusPtr` s
-    q <- memchr p' c (fromIntegral l)
-    return $! if q == nullPtr then Nothing else Just $! q `minusPtr` p'
-{-# INLINE elemIndex #-}
-
--- | /O(n)/ The 'elemIndexEnd' function returns the last index of the
--- element in the given 'ByteString' which is equal to the query
--- element, or 'Nothing' if there is no such element. The following
--- holds:
---
--- > elemIndexEnd c xs == 
--- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)
---
-elemIndexEnd :: Word8 -> ByteString -> Maybe Int
-elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
-    go (p `plusPtr` s) (l-1)
-  where
-    STRICT2(go)
-    go p i | i < 0     = return Nothing
-           | otherwise = do ch' <- peekByteOff p i
-                            if ch == ch'
-                                then return $ Just i
-                                else go p (i-1)
-{-# INLINE elemIndexEnd #-}
-
--- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
--- the indices of all elements equal to the query element, in ascending order.
--- This implementation uses memchr(3).
-elemIndices :: Word8 -> ByteString -> [Int]
-elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
-    let ptr = p `plusPtr` s
-
-        STRICT1(loop)
-        loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
-                                                w (fromIntegral (l - n))
-                 in if q == nullPtr
-                        then []
-                        else let i = q `minusPtr` ptr
-                             in i : loop (i+1)
-    return $! loop 0
-{-# INLINE elemIndices #-}
-
-{-
--- much slower
-elemIndices :: Word8 -> ByteString -> [Int]
-elemIndices c ps = loop 0 ps
-   where STRICT2(loop)
-         loop _ ps' | null ps'            = []
-         loop n ps' | c == unsafeHead ps' = n : loop (n+1) (unsafeTail ps')
-                    | otherwise           = loop (n+1) (unsafeTail ps')
--}
-
--- | count returns the number of times its argument appears in the ByteString
---
--- > count = length . elemIndices
---
--- But more efficiently than using length on the intermediate list.
-count :: Word8 -> ByteString -> Int
-count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
-    fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
-{-# INLINE count #-}
-
-{-
---
--- around 30% slower
---
-count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
-     go (p `plusPtr` s) (fromIntegral m) 0
-    where
-        go :: Ptr Word8 -> CSize -> Int -> IO Int
-        STRICT3(go)
-        go p l i = do
-            q <- memchr p w l
-            if q == nullPtr
-                then return i
-                else do let k = fromIntegral $ q `minusPtr` p
-                        go (q `plusPtr` 1) (l-k-1) (i+1)
--}
-
--- | The 'findIndex' function takes a predicate and a 'ByteString' and
--- returns the index of the first element in the ByteString
--- satisfying the predicate.
-findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
-findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0
-  where
-    STRICT2(go)
-    go ptr n | n >= l    = return Nothing
-             | otherwise = do w <- peek ptr
-                              if k w
-                                then return (Just n)
-                                else go (ptr `plusPtr` 1) (n+1)
-{-# INLINE findIndex #-}
-
--- | The 'findIndices' function extends 'findIndex', by returning the
--- indices of all elements satisfying the predicate, in ascending order.
-findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
-findIndices p ps = loop 0 ps
-   where
-     STRICT2(loop)
-     loop n qs | null qs           = []
-               | p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs)
-               | otherwise         =     loop (n+1) (unsafeTail qs)
-
--- ---------------------------------------------------------------------
--- Searching ByteStrings
-
--- | /O(n)/ 'elem' is the 'ByteString' membership predicate.
-elem :: Word8 -> ByteString -> Bool
-elem c ps = case elemIndex c ps of Nothing -> False ; _ -> True
-{-# INLINE elem #-}
-
--- | /O(n)/ 'notElem' is the inverse of 'elem'
-notElem :: Word8 -> ByteString -> Bool
-notElem c ps = not (elem c ps)
-{-# INLINE notElem #-}
-
--- | /O(n)/ 'filter', applied to a predicate and a ByteString,
--- returns a ByteString containing those characters that satisfy the
--- predicate. This function is subject to array fusion.
-filter :: (Word8 -> Bool) -> ByteString -> ByteString
-#if defined(LOOPU_FUSION)
-filter p  = loopArr . loopU (filterEFL p) NoAcc
-#elif defined(LOOPUP_FUSION)
-filter p  = loopArr . loopUp (filterEFL p) NoAcc
-#elif defined(LOOPNOACC_FUSION)
-filter p  = loopArr . loopNoAcc (filterEFL p)
-#else
-filter f = loopArr . loopFilter f
-#endif
-{-# INLINE filter #-}
-
-{-
--- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be
--- around 2x faster for some one-shot applications.
-filter' :: (Word8 -> Bool) -> ByteString -> ByteString
-filter' k ps@(PS x s l)
-    | null ps   = ps
-    | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do
-        t <- go (f `plusPtr` s) p (f `plusPtr` (s + l))
-        return $! t `minusPtr` p -- actual length
-    where
-        STRICT3(go)
-        go f t end | f == end  = return t
-                   | otherwise = do
-                        w <- peek f
-                        if k w
-                            then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end
-                            else             go (f `plusPtr` 1) t               end
-{-# INLINE filter' #-}
--}
-
---
--- | /O(n)/ A first order equivalent of /filter . (==)/, for the common
--- case of filtering a single byte. It is more efficient to use
--- /filterByte/ in this case.
---
--- > filterByte == filter . (==)
---
--- filterByte is around 10x faster, and uses much less space, than its
--- filter equivalent
-filterByte :: Word8 -> ByteString -> ByteString
-filterByte w ps = replicate (count w ps) w
-{-# INLINE filterByte #-}
-
-{-# RULES
-  "FPS specialise filter (== x)" forall x.
-      filter ((==) x) = filterByte x
-  #-}
-
-#if __GLASGOW_HASKELL__ >= 605
-{-# RULES
-  "FPS specialise filter (== x)" forall x.
-     filter (== x) = filterByte x
-  #-}
-#endif
-
---
--- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common
--- case of filtering a single byte out of a list. It is more efficient
--- to use /filterNotByte/ in this case.
---
--- > filterNotByte == filter . (/=)
---
--- filterNotByte is around 2x faster than its filter equivalent.
-filterNotByte :: Word8 -> ByteString -> ByteString
-filterNotByte w = filter (/= w)
-{-# INLINE filterNotByte #-}
-
-{-# RULES
-"FPS specialise filter (x /=)" forall x.
-    filter ((/=) x) = filterNotByte x
-  #-}
-
-#if __GLASGOW_HASKELL__ >= 605
-{-# RULES
-"FPS specialise filter (/= x)" forall x.
-    filter (/= x) = filterNotByte x
-  #-}
-#endif
-
--- | /O(n)/ The 'find' function takes a predicate and a ByteString,
--- and returns the first element in matching the predicate, or 'Nothing'
--- if there is no such element.
---
--- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing
---
-find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
-find f p = case findIndex f p of
-                    Just n -> Just (p `unsafeIndex` n)
-                    _      -> Nothing
-{-# INLINE find #-}
-
-{-
---
--- fuseable, but we don't want to walk the whole array.
--- 
-find k = foldl findEFL Nothing
-    where findEFL a@(Just _) _ = a
-          findEFL _          c | k c       = Just c
-                               | otherwise = Nothing
--}
-
--- ---------------------------------------------------------------------
--- Searching for substrings
-
--- | /O(n)/ The 'isPrefixOf' function takes two ByteStrings and returns 'True'
--- iff the first is a prefix of the second.
-isPrefixOf :: ByteString -> ByteString -> Bool
-isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2)
-    | l1 == 0   = True
-    | l2 < l1   = False
-    | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
-        withForeignPtr x2 $ \p2 -> do
-            i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1)
-            return $! i == 0
-
--- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True'
--- iff the first is a suffix of the second.
--- 
--- The following holds:
---
--- > isSuffixOf x y == reverse x `isPrefixOf` reverse y
---
--- However, the real implemenation uses memcmp to compare the end of the
--- string only, with no reverse required..
-isSuffixOf :: ByteString -> ByteString -> Bool
-isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2)
-    | l1 == 0   = True
-    | l2 < l1   = False
-    | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
-        withForeignPtr x2 $ \p2 -> do
-            i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1)
-            return $! i == 0
-
--- | Check whether one string is a substring of another. @isSubstringOf
--- p s@ is equivalent to @not (null (findSubstrings p s))@.
-isSubstringOf :: ByteString -- ^ String to search for.
-              -> ByteString -- ^ String to search in.
-              -> Bool
-isSubstringOf p s = not $ P.null $ findSubstrings p s
-
--- | Get the first index of a substring in another string,
---   or 'Nothing' if the string is not found.
---   @findSubstring p s@ is equivalent to @listToMaybe (findSubstrings p s)@.
-findSubstring :: ByteString -- ^ String to search for.
-              -> ByteString -- ^ String to seach in.
-              -> Maybe Int
-findSubstring = (listToMaybe .) . findSubstrings
-
--- | Find the indexes of all (possibly overlapping) occurances of a
--- substring in a string.  This function uses the Knuth-Morris-Pratt
--- string matching algorithm.
-findSubstrings :: ByteString -- ^ String to search for.
-               -> ByteString -- ^ String to seach in.
-               -> [Int]
-
-findSubstrings pat@(PS _ _ m) str@(PS _ _ n) = search 0 0
-  where
-      patc x = pat `unsafeIndex` x
-      strc x = str `unsafeIndex` x
-
-      -- maybe we should make kmpNext a UArray before using it in search?
-      kmpNext = listArray (0,m) (-1:kmpNextL pat (-1))
-      kmpNextL p _ | null p = []
-      kmpNextL p j = let j' = next (unsafeHead p) j + 1
-                         ps = unsafeTail p
-                         x = if not (null ps) && unsafeHead ps == patc j'
-                                then kmpNext Array.! j' else j'
-                        in x:kmpNextL ps j'
-      search i j = match ++ rest -- i: position in string, j: position in pattern
-        where match = if j == m then [(i - j)] else []
-              rest = if i == n then [] else search (i+1) (next (strc i) j + 1)
-      next c j | j >= 0 && (j == m || c /= patc j) = next c (kmpNext Array.! j)
-               | otherwise = j
-
--- ---------------------------------------------------------------------
--- Zipping
-
--- | /O(n)/ 'zip' takes two ByteStrings and returns a list of
--- corresponding pairs of bytes. If one input ByteString is short,
--- excess elements of the longer ByteString are discarded. This is
--- equivalent to a pair of 'unpack' operations.
-zip :: ByteString -> ByteString -> [(Word8,Word8)]
-zip ps qs
-    | null ps || null qs = []
-    | otherwise = (unsafeHead ps, unsafeHead qs) : zip (unsafeTail ps) (unsafeTail qs)
-
--- | 'zipWith' generalises 'zip' by zipping with the function given as
--- the first argument, instead of a tupling function.  For example,
--- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of
--- corresponding sums. 
-zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
-zipWith f ps qs
-    | null ps || null qs = []
-    | otherwise = f (unsafeHead ps) (unsafeHead qs) : zipWith f (unsafeTail ps) (unsafeTail qs)
-#if defined(__GLASGOW_HASKELL__)
-{-# INLINE [1] zipWith #-}
-#endif
-
---
--- | A specialised version of zipWith for the common case of a
--- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules
--- are used to automatically covert zipWith into zipWith' when a pack is
--- performed on the result of zipWith, but we also export it for
--- convenience.
---
-zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
-zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $
-    withForeignPtr fp $ \a ->
-    withForeignPtr fq $ \b ->
-    create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t)
-  where
-    zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
-    STRICT4(zipWith_)
-    zipWith_ n p1 p2 r
-       | n >= len = return ()
-       | otherwise = do
-            x <- peekByteOff p1 n
-            y <- peekByteOff p2 n
-            pokeByteOff r n (f x y)
-            zipWith_ (n+1) p1 p2 r
-
-    len = min l m
-{-# INLINE zipWith' #-}
-
-{-# RULES
-
-"FPS specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
-    zipWith f p q = unpack (zipWith' f p q)
-
-  #-}
-
--- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of
--- ByteStrings. Note that this performs two 'pack' operations.
-unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
-unzip ls = (pack (P.map fst ls), pack (P.map snd ls))
-{-# INLINE unzip #-}
-
--- ---------------------------------------------------------------------
--- Special lists
-
--- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first.
-inits :: ByteString -> [ByteString]
-inits (PS x s l) = [PS x s n | n <- [0..l]]
-
--- | /O(n)/ Return all final segments of the given 'ByteString', longest first.
-tails :: ByteString -> [ByteString]
-tails p | null p    = [empty]
-        | otherwise = p : tails (unsafeTail p)
-
--- less efficent spacewise: tails (PS x s l) = [PS x (s+n) (l-n) | n <- [0..l]]
-
--- ---------------------------------------------------------------------
--- ** Ordered 'ByteString's
-
--- | /O(n)/ Sort a ByteString efficiently, using counting sort.
-sort :: ByteString -> ByteString
-sort (PS input s l) = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do
-
-    memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))
-    withForeignPtr input (\x -> countOccurrences arr (x `plusPtr` s) l)
-
-    let STRICT2(go)
-        go 256 _   = return ()
-        go i   ptr = do n <- peekElemOff arr i
-                        when (n /= 0) $ memset ptr (fromIntegral i) n >> return ()
-                        go (i + 1) (ptr `plusPtr` (fromIntegral n))
-    go 0 p
-
-{-
-sort :: ByteString -> ByteString
-sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do
-        memcpy p (f `plusPtr` s) l
-        c_qsort p l -- inplace
--}
-
--- | The 'sortBy' function is the non-overloaded version of 'sort'.
---
--- Try some linear sorts: radix, counting
--- Or mergesort.
---
--- sortBy :: (Word8 -> Word8 -> Ordering) -> ByteString -> ByteString
--- sortBy f ps = undefined
-
--- ---------------------------------------------------------------------
--- Low level constructors
-
--- | /O(n)/ Build a @ByteString@ from a @CString@. This value will have /no/
--- finalizer associated to it. The ByteString length is calculated using
--- /strlen(3)/, and thus the complexity is a /O(n)/.
-packCString :: CString -> ByteString
-packCString cstr = unsafePerformIO $ do
-    fp <- newForeignPtr_ (castPtr cstr)
-    l <- c_strlen cstr
-    return $! PS fp 0 (fromIntegral l)
-
--- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will
--- have /no/ finalizer associated with it. This operation has /O(1)/
--- complexity as we already know the final size, so no /strlen(3)/ is
--- required.
-packCStringLen :: CStringLen -> ByteString
-packCStringLen (ptr,len) = unsafePerformIO $ do
-    fp <- newForeignPtr_ (castPtr ptr)
-    return $! PS fp 0 (fromIntegral len)
-
--- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will
--- have a @free(3)@ finalizer associated to it.
-packMallocCString :: CString -> ByteString
-packMallocCString cstr = unsafePerformIO $ do
-    fp <- newForeignFreePtr (castPtr cstr)
-    len <- c_strlen cstr
-    return $! PS fp 0 (fromIntegral len)
-
--- | /O(n) construction/ Use a @ByteString@ with a function requiring a
--- null-terminated @CString@.  The @CString@ will be freed
--- automatically. This is a memcpy(3).
-useAsCString :: ByteString -> (CString -> IO a) -> IO a
-useAsCString (PS ps s l) = bracket alloc (c_free.castPtr)
-    where alloc = withForeignPtr ps $ \p -> do
-            buf <- c_malloc (fromIntegral l+1)
-            memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
-            poke (buf `plusPtr` l) (0::Word8) -- n.b.
-            return (castPtr buf)
-
--- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@.
-useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
-useAsCStringLen = unsafeUseAsCStringLen
-
---
--- why were we doing this?
---
--- useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
--- useAsCStringLen (PS ps s l) = bracket alloc (c_free.castPtr.fst)
---     where
---       alloc = withForeignPtr ps $ \p -> do
---                 buf <- c_malloc (fromIntegral l+1)
---                 memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
---                 poke (buf `plusPtr` l) (0::Word8) -- n.b.
---                 return $! (castPtr buf, l)
---
-
--- | /O(n)/ Make a copy of the 'ByteString' with its own storage. 
---   This is mainly useful to allow the rest of the data pointed
---   to by the 'ByteString' to be garbage collected, for example
---   if a large string has been read in, and only a small part of it 
---   is needed in the rest of the program.
-copy :: ByteString -> ByteString
-copy (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
-    memcpy p (f `plusPtr` s) (fromIntegral l)
-
--- | /O(n)/ Duplicate a CString as a ByteString. Useful if you know the
--- CString is going to be deallocated from C land.
-copyCString :: CString -> IO ByteString
-copyCString cstr = do
-    len <- c_strlen cstr
-    copyCStringLen (cstr, fromIntegral len)
-
--- | /O(n)/ Same as copyCString, but saves a strlen call when the length is known.
-copyCStringLen :: CStringLen -> IO ByteString
-copyCStringLen (cstr, len) = create len $ \p ->
-    memcpy p (castPtr cstr) (fromIntegral len)
-
--- ---------------------------------------------------------------------
--- line IO
-
--- | Read a line from stdin.
-getLine :: IO ByteString
-getLine = hGetLine stdin
-
-{-
--- | Lazily construct a list of lines of ByteStrings. This will be much
--- better on memory consumption than using 'hGetContents >>= lines'
--- If you're considering this, a better choice might be to use
--- Data.ByteString.Lazy
-hGetLines :: Handle -> IO [ByteString]
-hGetLines h = go
-    where
-        go = unsafeInterleaveIO $ do
-                e <- hIsEOF h
-                if e
-                  then return []
-                  else do
-                x  <- hGetLine h
-                xs <- go
-                return (x:xs)
--}
-
--- | Read a line from a handle
-
-hGetLine :: Handle -> IO ByteString
-#if !defined(__GLASGOW_HASKELL__)
-hGetLine h = System.IO.hGetLine h >>= return . pack . P.map c2w
-#else
-hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do
-    case haBufferMode handle_ of
-       NoBuffering -> error "no buffering"
-       _other      -> hGetLineBuffered handle_
-
- where
-    hGetLineBuffered handle_ = do
-        let ref = haBuffer handle_
-        buf <- readIORef ref
-        hGetLineBufferedLoop handle_ ref buf 0 []
-
-    hGetLineBufferedLoop handle_ ref
-            buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } len xss =
-        len `seq` do
-        off <- findEOL r w raw
-        let new_len = len + off - r
-        xs <- mkPS raw r off
-
-      -- if eol == True, then off is the offset of the '\n'
-      -- otherwise off == w and the buffer is now empty.
-        if off /= w
-            then do if (w == off + 1)
-                            then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-                            else writeIORef ref buf{ bufRPtr = off + 1 }
-                    mkBigPS new_len (xs:xss)
-            else do
-                 maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
-                                    buf{ bufWPtr=0, bufRPtr=0 }
-                 case maybe_buf of
-                    -- Nothing indicates we caught an EOF, and we may have a
-                    -- partial line to return.
-                    Nothing -> do
-                         writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-                         if new_len > 0
-                            then mkBigPS new_len (xs:xss)
-                            else ioe_EOF
-                    Just new_buf ->
-                         hGetLineBufferedLoop handle_ ref new_buf new_len (xs:xss)
-
-    -- find the end-of-line character, if there is one
-    findEOL r w raw
-        | r == w = return w
-        | otherwise =  do
-            (c,r') <- readCharFromBuffer raw r
-            if c == '\n'
-                then return r -- NB. not r': don't include the '\n'
-                else findEOL r' w raw
-
-    maybeFillReadBuffer fd is_line is_stream buf = catch
-        (do buf' <- fillReadBuffer fd is_line is_stream buf
-            return (Just buf'))
-        (\e -> if isEOFError e then return Nothing else ioError e)
-
--- TODO, rewrite to use normal memcpy
-mkPS :: RawBuffer -> Int -> Int -> IO ByteString
-mkPS buf start end =
-    let len = end - start
-    in create len $ \p -> do
-        memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len)
-        return ()
-
-mkBigPS :: Int -&