vector and GeneralizedNewtypeDeriving
John Lato
jwlato at gmail.com
Wed May 14 01:39:57 UTC 2014
Hello,
Prior to ghc-7.8, it was possible to do this:
> module M where
>
> import qualified Data.Vector.Generic.Base as G
> import qualified Data.Vector.Generic.Mutable as M
> import Data.Vector.Unboxed.Base -- provides MVector and Vector
>
> newtype Foo = Foo Int deriving (Eq, Show, Num,
> M.MVector MVector, G.Vector Vector, Unbox)
M.MVector is defined as
> class MVector v a where
> basicLength :: v s a -> Int
etc.
With ghc-7.8 this no longer compiles due to an unsafe coercion, as MVector
s Foo and MVector s Int have different types. The error suggests trying
-XStandaloneDeriving to manually specify the context, however I don't see
any way that will help in this case.
For that matter, I don't see any way to fix this in the vector package
either. We might think to define
> type role M.MVector nominal representational
but that doesn't work as both parameters to M.MVector require a nominal
role (and it's probably not what we really want anyway). Furthermore
Data.Vector.Unboxed.Base.MVector (which fills in at `v` in the instance) is
a data family, so we're stuck at that point also.
So given this situation, is there any way to automatically derive Vector
instances from newtypes?
tl;dr: I would really like to be able to do:
> coerce (someVector :: Vector Foo) :: Vector Int
am I correct that the current machinery isn't up to handling this?
Thanks,
John
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20140513/6c0d0a42/attachment.html>
More information about the Glasgow-haskell-users
mailing list