[Haskell] How to use STArray?
Benjamin Franksen
benjamin.franksen at bessy.de
Mon Aug 29 16:58:06 EDT 2005
Hmmm, no answer on cafe, maybe someone here with a good idea?
---------- Forwarded Message ----------
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
> )
Hello,
I am fighting with a similar problem. I want to use STUArray but
without committing to a fixed element type. For instance (this is not my
real problem, but it's similar and easier to motivate), here is a
function that appends two UArrays:
A little helper first
> 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)
and here is the append function
> append :: UArray Int e -> UArray Int e -> Int -> UArray Int e
> append x y low = runSTUArray (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)
> return z)
> where
> len = rangeSize . bounds
> first = fst . bounds
Of course this can't work, because 'copy' needs the MArray and IArray
contexts:
No instance for (MArray (STUArray s) e (ST s))
arising from use of `copy' at Problem.lhs:31:7-10
[...]
No instance for (IArray UArray e)
arising from use of `copy' at Problem.lhs:31:7-10
[...]
But now, when I add
> append :: (IArray UArray e, MArray (STUArray s) e (ST s)) => ...
I still get the same error message regarding the MArray constraint:
No instance for (MArray (STUArray s) e (ST s))
arising from use of `copy' at Problem.lhs:31:7-10
What am I missing? That is, how and where do I have to specify the
constraint?
Ben
More information about the Haskell
mailing list