From c8d2d94c7c124efd2cec865bdd35d35109963524 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 7 Jan 2020 12:01:08 -0500
Subject: [PATCH]  Make Storable vectors nominally roled, and add
 unsafeCoerceVector functions (#235)

* Make Storable vectors nominally roled, and add unsafeCoerceVector functions

* Fix some CPP bounds
---
 Data/Vector/Storable.hs         | 19 +++++++++++++++++--
 Data/Vector/Storable/Mutable.hs | 21 ++++++++++++++++++++-
 changelog                       | 25 +++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 3 deletions(-)

diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs
index 09ef382..56deedf 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 2d39ab9..b8a1d3a 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 3823bdb..d663b7c 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.
-- 
GitLab