diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index 09ef3829827dbff83b1b3f6add64395344aba257..56deedf4c831d20a9157c2805fa8e97980c6ab24 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -133,6 +133,9 @@ module Data.Vector.Storable ( -- ** Other vector types G.convert, unsafeCast, +#if __GLASGOW_HASKELL__ >= 708 + unsafeCoerceVector, +#endif -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, @@ -187,7 +190,9 @@ import Data.Traversable ( Traversable ) #endif #if __GLASGOW_HASKELL__ >= 708 +import Data.Coerce import qualified GHC.Exts as Exts +import Unsafe.Coerce #endif -- Data.Vector.Internal.Check is unused @@ -195,7 +200,18 @@ import qualified GHC.Exts as Exts #include "vector.h" #if __GLASGOW_HASKELL__ >= 708 -type role Vector representational +type role Vector nominal + +-- | /O(1)/ Unsafely coerce a mutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- This is marginally safer than 'unsafeCast', since this function imposes an +-- extra 'Coercible' constraint. This function is still not safe, however, +-- since it cannot guarantee that the two types have memory-compatible +-- 'Storable' instances. +unsafeCoerceVector :: Coercible a b => Vector a -> Vector b +unsafeCoerceVector = unsafeCoerce #endif -- | 'Storable'-based vectors @@ -1415,7 +1431,6 @@ unsafeCast (Vector n fp) = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp) - -- Conversions - Mutable vectors -- ----------------------------- diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index 2d39ab9dc64ca6f85a2b259f83b389c44413b353..b8a1d3a02e1627240974e5e316bc626597c7395d 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -54,6 +54,9 @@ module Data.Vector.Storable.Mutable( -- * Unsafe conversions unsafeCast, +#if __GLASGOW_HASKELL__ >= 708 + unsafeCoerceMVector, +#endif -- * Raw pointers unsafeFromForeignPtr, unsafeFromForeignPtr0, @@ -99,12 +102,28 @@ import Prelude hiding ( length, null, replicate, reverse, map, read, import Data.Typeable ( Typeable ) +#if __GLASGOW_HASKELL__ >= 708 +import Data.Coerce +import Unsafe.Coerce +#endif + -- Data.Vector.Internal.Check is not needed #define NOT_VECTOR_MODULE #include "vector.h" #if __GLASGOW_HASKELL__ >= 708 -type role MVector nominal representational +type role MVector nominal nominal + +-- | /O(1)/ Unsafely coerce a mutable vector from one element type to another, +-- representationally equal type. The operation just changes the type of the +-- underlying pointer and does not modify the elements. +-- +-- This is marginally safer than 'unsafeCast', since this function imposes an +-- extra 'Coercible' constraint. This function is still not safe, however, +-- since it cannot guarantee that the two types have memory-compatible +-- 'Storable' instances. +unsafeCoerceMVector :: Coercible a b => MVector s a -> MVector s b +unsafeCoerceMVector = unsafeCoerce #endif -- | Mutable 'Storable'-based vectors diff --git a/changelog b/changelog index 3823bdb542cb3b8483326370e068726fa731a1c9..d663b7c993820642b19715f437ad0a62c1bd77ce 100644 --- a/changelog +++ b/changelog @@ -6,6 +6,31 @@ Changes in version next it would choose the first element). Similarly, `maxIndexBy` will also now pick the last element if several elements could be considered the maximum. + * The role signatures on several `Vector` types were too permissive, so they + have been tightened up: + * The role signature for `Data.Vector.Mutable.MVector` is now + `type role MVector nominal representational` (previously, both arguments + were `phantom`). + * The role signature for `Data.Vector.Primitive.Vector` is now + `type role Vector representational` (previously, it was `phantom`). + * The role signature for `Data.Vector.Storable.Vector` is now + `type role Vector nominal` (previous, it was `phantom`), and the signature + for `Data.Vector.Storable.Mutable.MVector` is now + `type role MVector nominal nominal` (previous, both arguments were + `phantom`). + + We pick `nominal` for the role of the last argument instead of + `representational` since the internal structure of a `Storable` vector + is determined by the `Storable` instance of the element type, and it is + not guaranteed that the `Storable` instances between two + representationally equal types will preserve this internal structure. + One consequence of this choice is that it is no longer possible to + `coerce` between `Storable.Vector a` and `Storable.Vector b` if `a` and + `b` are nominally distinct but representationally equal types. We now + provide `unsafeCoerce{M}Vector` functions in + `Data.Vector.Storable{.Mutable}` to allow this (the onus is on the user + to ensure that no `Storable` invariants are broken when using these + functions). * The `Mutable` type family is now injective on GHC 8.0 or later. * Using empty `Storable` vectors no longer results in division-by-zero errors.