[Haskell] How to use STArray?

[oleg at pobox.com]

Benjamin Franksen wrote:

> On Thursday 25 August 2005 19:58, Udo Stenzel wrote:
> > [...] you'll need a type signature somewhere to help ghc resolve
> > the overloading of newArray and readArray, which is surprisingly
> > tricky due to the "s" that must not escape.  This works:
> >
> > compute :: Int -> Int
> > compute n = runST ( do
> >     arr <- newArray (-1, 1) n :: ST s (STArray s Int Int)
> >     readArray arr 1
> >   )

> I am fighting with a similar problem. I want to use STUArray but
> without committing to a fixed element type.

That problem has been addressed in a message
	http://www.haskell.org/pipermail/haskell-cafe/2004-July/006400.html
which discussed several solutions. Given below is one of the solutions
adjusted to fit the question of the original poster. His code is
almost unchanged. 

It would havebeen nice if the GHC library supported the second
solution, a class Unpackable. Currently there are instances of
	MArray (STUArray s) e (ST s)
and
	IArray UArray e
for exactly the same set of types `e'. Alas, that condition is not
stated formally, so we cannot infer that MArray (STUArray s) e (ST s)
holds whenever IArray UArray e does.

> {-# OPTIONS -fglasgow-exts #-}
>
> module Foo where
>
> import Data.Array.Unboxed
> import Data.Array.ST
> import Control.Monad.ST
>
> data Allocator m i e = forall a. MArray a e m => 
>                        Allocator ((i, i) -> m (a i e))
>
>
> copy :: (MArray a e m, IArray b e) =>
>         a Int e -> Int -> b Int e -> Int -> Int -> m ()
> copy dest destix src srcix cnt
>   | cnt <= 0  = return ()
>   | otherwise = do
>       writeArray dest destix (src ! srcix)
>       copy dest (destix+1) src (srcix+1) (cnt-1)

> append :: (IArray UArray e, STUGood e) => 
> 	      UArray Int e -> UArray Int e -> Int -> UArray Int e
> append x y low = 
>     runST (case allcg of Allocator newArray_ -> 
> 		           (do
> 			    z <-  newArray_ (low,low+len x+len y)
> 			    copy z low x (first x) (len x)
> 			    copy z (low+len x) y (first y) (len y)
> 			    unsafeFreeze z))
>   where
>     len = rangeSize . bounds
>     first = fst . bounds
>
> class STUGood e where
>     allcg::Ix i => Allocator (ST s) i e 
>
> instance STUGood Bool where
>     allcg = Allocator (newArray_:: Ix i => (i,i) -> ST s (STUArray s i Bool))
>
> instance STUGood Float where
>     allcg = Allocator (newArray_:: Ix i => (i,i)-> ST s (STUArray s i Float))
>
> -- etc.
>
> test = 
>     append (listArray (1,1) [True]) (listArray (1,1) [False]) 0