UArray
Simon Marlow
simonmarhaskell at gmail.com
Mon Mar 13 09:22:24 EST 2006
Frederik Eaton wrote:
> I was trying to track down the problem with this piece of code:
>
> instance (Elt k, IxB a, Eq a, Eq k) => Num (Vector k a) where
> (+) = vmap2 (+)
> (-) = vmap2 (-)
> (*) = vmap2 (*)
> negate = vmap negate
> signum = vmap signum
> abs = vmap abs
> fromInteger n = vconst $ fromInteger n
>
> Vector2.hs:246:0:
> Could not deduce (Eq (UArray a k)) from the context (Elt k, IxB a, Eq a, Eq k)
> arising from the superclasses of an instance declaration at Vector2.hs:246:0
> Probable fix:
> add (Eq (UArray a k)) to the instance declaration superclass context
> or add an instance declaration for (Eq (UArray a k))
> In the instance declaration for `Num (Vector k a)'
>
> So it appears that here is another barrier to using UArray
> polymorphically. Am I the first user of this interface?
>
> In Data/Array/Base.hs it says:
>
> 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]]
>
> ...
> instance Ix ix => Eq (UArray ix Bool) where
> (==) = eqUArray
>
> instance Ix ix => Eq (UArray ix Bool) where
> (==) = eqUArray
>
> instance Ix ix => Eq (UArray ix Char) where
> (==) = eqUArray
>
> instance Ix ix => Eq (UArray ix Int) where
> (==) = eqUArray
>
> instance Ix ix => Eq (UArray ix Word) where
> (==) = eqUArray
> ...
> etc.
>
> Why define separate instances when one could just define one
> equivalent one:
>
> instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e)
> (==) = eqUArray
That version certainly compiles without any extra options. It's not
H98, but then this library requires MPTC anyway (but not much else, I
think). I think Hugs will accept it too. It certainly looks like an
improvement, so I'll commit it. Thanks!
Cheers,
Simon
More information about the Libraries
mailing list