From 3874631b7806b483ee3bdafe08fb2866976eeecf Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 13 Jun 2020 17:42:06 +0300
Subject: [PATCH] Make primitive vectors nominally roled

Reasoning is identical to one for storable vectors. See discussion in #224, and
PR #235.

Fixes #277
---
 Data/Vector/Primitive.hs         | 16 +++++++++++++++-
 Data/Vector/Primitive/Mutable.hs | 28 +++++++++++++++++++++++++++-
 changelog.md                     |  5 ++++-
 3 files changed, 46 insertions(+), 3 deletions(-)

diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs
index 15732b3f..7a85a69e 100644
--- a/Data/Vector/Primitive.hs
+++ b/Data/Vector/Primitive.hs
@@ -137,6 +137,9 @@ module Data.Vector.Primitive (
 
   -- ** Other vector types
   G.convert,
+#if __GLASGOW_HASKELL__ >= 708
+  unsafeCoerceVector,
+#endif
 
   -- ** Mutable vectors
   freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy
@@ -183,11 +186,22 @@ import Data.Traversable ( Traversable )
 #endif
 
 #if __GLASGOW_HASKELL__ >= 708
+import Data.Coerce
+import Unsafe.Coerce
 import qualified GHC.Exts as Exts
 #endif
 
 #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.
+--
+-- While it guarantees that elements of vector are representationally
+-- equal it doesn't guarantee that 'Prim' instances are memory-compatible.
+unsafeCoerceVector :: Coercible a b => Vector a -> Vector b
+unsafeCoerceVector = unsafeCoerce
 #endif
 
 -- | Unboxed vectors of primitive types
diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs
index 14d4e740..165e15ad 100644
--- a/Data/Vector/Primitive/Mutable.hs
+++ b/Data/Vector/Primitive/Mutable.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}
 
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
+
 -- |
 -- Module      : Data.Vector.Primitive.Mutable
 -- Copyright   : (c) Roman Leshchinskiy 2008-2010
@@ -47,7 +51,12 @@ module Data.Vector.Primitive.Mutable (
   nextPermutation,
 
   -- ** Filling and copying
-  set, copy, move, unsafeCopy, unsafeMove
+  set, copy, move, unsafeCopy, unsafeMove,
+
+  -- * Unsafe conversions
+#if __GLASGOW_HASKELL__ >= 708
+  unsafeCoerceMVector
+#endif
 ) where
 
 import qualified Data.Vector.Generic.Mutable as G
@@ -67,11 +76,28 @@ import Prelude hiding ( length, null, replicate, reverse, map, read,
                         take, drop, splitAt, init, tail )
 
 import Data.Typeable ( Typeable )
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Coerce
+import Unsafe.Coerce
+#endif
 
 -- Data.Vector.Internal.Check is unnecessary
 #define NOT_VECTOR_MODULE
 #include "vector.h"
 
+#if __GLASGOW_HASKELL__ >= 708
+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.
+--
+-- While it guarantees that elements of vector are representationally
+-- equal it doesn't guarantee that 'Prim' instances are memory-compatible.
+unsafeCoerceMVector :: Coercible a b => MVector s a -> MVector s b
+unsafeCoerceMVector = unsafeCoerce
+#endif
+
 -- | Mutable vectors of primitive types.
 data MVector s a = MVector {-# UNPACK #-} !Int
                            {-# UNPACK #-} !Int
diff --git a/changelog.md b/changelog.md
index 381df631..4a814edf 100644
--- a/changelog.md
+++ b/changelog.md
@@ -15,7 +15,10 @@
      `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`).
+     `type role Vector nominal` (previously, it was `phantom`).
+     for `Data.Vector.Primitive.Mutable.MVector` is now
+     `type role MVector nominal nominal` (previous, both arguments were
+     `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