Skip to content

Commit 04194a0

Browse files
ShimuuarShimuuar
authored
Merge pull request #518 from ruifengx/unboxed-storable
Add Unboxed instances for Storable vectors
2 parents f7be437 + 982df63 commit 04194a0

File tree

5 files changed

+298
-13
lines changed

5 files changed

+298
-13
lines changed

‎vector/src/Data/Vector/Unboxed.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,8 @@
6868
-- @
6969
module Data.Vector.Unboxed (
7070
-- * Unboxed vectors
71-
Vector(V_UnboxAs, V_UnboxViaPrim), MVector(..), Unbox,
71+
Vector(V_UnboxAs, V_UnboxViaPrim, V_UnboxViaStorable,V_DoNotUnboxLazy,V_DoNotUnboxStrict,V_DoNotUnboxNormalForm),
72+
MVector(..), Unbox,
7273

7374
-- * Accessors
7475

@@ -210,6 +211,7 @@ module Data.Vector.Unboxed (
210211
UnboxViaPrim(..),
211212
As(..),
212213
IsoUnbox(..),
214+
UnboxViaStorable(..),
213215

214216
-- *** /Lazy/ boxing
215217
DoNotUnboxLazy(..),

‎vector/src/Data/Vector/Unboxed/Base.hs‎

Lines changed: 106 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -26,14 +26,15 @@
2626

2727
module Data.Vector.Unboxed.Base (
2828
MVector(..), IOVector, STVector, Vector(..), Unbox,
29-
UnboxViaPrim(..), As(..), IsoUnbox(..),
29+
UnboxViaPrim(..), UnboxViaStorable(..), As(..), IsoUnbox(..),
3030
DoNotUnboxLazy(..), DoNotUnboxNormalForm(..), DoNotUnboxStrict(..)
3131
) where
3232

3333
import qualified Data.Vector.Generic as G
3434
import qualified Data.Vector.Generic.Mutable as M
3535
import qualified Data.Vector as B
3636
import qualified Data.Vector.Strict as S
37+
import qualified Data.Vector.Storable as St
3738

3839
import qualified Data.Vector.Primitive as P
3940

@@ -187,14 +188,14 @@ instance G.Vector Vector () where
187188
-- >>>
188189
-- >>> newtype Foo = Foo Int deriving VP.Prim
189190
-- >>>
190-
-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Foo)
191-
-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Foo)
191+
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Foo)
192+
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Foo)
192193
-- >>> deriving via (VU.UnboxViaPrim Foo) instance VGM.MVector VU.MVector Foo
193194
-- >>> deriving via (VU.UnboxViaPrim Foo) instance VG.Vector VU.Vector Foo
194195
-- >>> instance VU.Unbox Foo
195196
--
196197
-- Second example is essentially same but with a twist. Instead of
197-
-- using @Prim@ instance of data type, we use underlying instance of @Int@:
198+
-- using 'P.Prim' instance of data type, we use underlying instance of 'Int':
198199
--
199200
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
200201
-- >>>
@@ -205,8 +206,8 @@ instance G.Vector Vector () where
205206
-- >>>
206207
-- >>> newtype Foo = Foo Int
207208
-- >>>
208-
-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Int)
209-
-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Int)
209+
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Int)
210+
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Int)
210211
-- >>> deriving via (VU.UnboxViaPrim Int) instance VGM.MVector VU.MVector Foo
211212
-- >>> deriving via (VU.UnboxViaPrim Int) instance VG.Vector VU.Vector Foo
212213
-- >>> instance VU.Unbox Foo
@@ -760,6 +761,102 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
760761
elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x
761762
$ G.elemseq (undefined :: Vector b) y z
762763

764+
-- -------
765+
-- Unboxing the Storable values
766+
-- -------
767+
768+
-- | Newtype wrapper which allows to derive unboxed vector in term of
769+
-- storable vectors using @DerivingVia@ mechanism. This is mostly
770+
-- used as illustration of use of @DerivingVia@ for vector, see examples below.
771+
--
772+
-- First is rather straightforward: we define newtype and use GND to
773+
-- derive 'St.Storable' instance. Newtype instances should be defined
774+
-- manually. Then we use deriving via to define necessary instances.
775+
--
776+
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
777+
-- >>> :set -XGeneralizedNewtypeDeriving
778+
-- >>>
779+
-- >>> import qualified Data.Vector.Generic as VG
780+
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
781+
-- >>> import qualified Data.Vector.Storable as VS
782+
-- >>> import qualified Data.Vector.Unboxed as VU
783+
-- >>>
784+
-- >>> newtype Foo = Foo Int deriving VS.Storable
785+
-- >>>
786+
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VS.MVector s Foo)
787+
-- >>> newtype instance VU.Vector Foo = V_Foo (VS.Vector Foo)
788+
-- >>> deriving via (VU.UnboxViaStorable Foo) instance VGM.MVector VU.MVector Foo
789+
-- >>> deriving via (VU.UnboxViaStorable Foo) instance VG.Vector VU.Vector Foo
790+
-- >>> instance VU.Unbox Foo
791+
--
792+
-- Second example is essentially same but with a twist. Instead of
793+
-- using 'St.Storable' instance of data type, we use underlying instance of 'Int':
794+
--
795+
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
796+
-- >>>
797+
-- >>> import qualified Data.Vector.Generic as VG
798+
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
799+
-- >>> import qualified Data.Vector.Storable as VS
800+
-- >>> import qualified Data.Vector.Unboxed as VU
801+
-- >>>
802+
-- >>> newtype Foo = Foo Int
803+
-- >>>
804+
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VS.MVector s Int)
805+
-- >>> newtype instance VU.Vector Foo = V_Foo (VS.Vector Int)
806+
-- >>> deriving via (VU.UnboxViaStorable Int) instance VGM.MVector VU.MVector Foo
807+
-- >>> deriving via (VU.UnboxViaStorable Int) instance VG.Vector VU.Vector Foo
808+
-- >>> instance VU.Unbox Foo
809+
--
810+
-- @since 0.13.3.0
811+
newtype UnboxViaStorable a = UnboxViaStorable a
812+
813+
newtype instance MVector s (UnboxViaStorable a) = MV_UnboxViaStorable (St.MVector s a)
814+
newtype instance Vector (UnboxViaStorable a) = V_UnboxViaStorable (St.Vector a)
815+
816+
instance St.Storable a => M.MVector MVector (UnboxViaStorable a) where
817+
{-# INLINE basicLength #-}
818+
{-# INLINE basicUnsafeSlice #-}
819+
{-# INLINE basicOverlaps #-}
820+
{-# INLINE basicUnsafeNew #-}
821+
{-# INLINE basicInitialize #-}
822+
{-# INLINE basicUnsafeReplicate #-}
823+
{-# INLINE basicUnsafeRead #-}
824+
{-# INLINE basicUnsafeWrite #-}
825+
{-# INLINE basicClear #-}
826+
{-# INLINE basicSet #-}
827+
{-# INLINE basicUnsafeCopy #-}
828+
{-# INLINE basicUnsafeGrow #-}
829+
basicLength = coerce $ M.basicLength @St.MVector @a
830+
basicUnsafeSlice = coerce $ M.basicUnsafeSlice @St.MVector @a
831+
basicOverlaps = coerce $ M.basicOverlaps @St.MVector @a
832+
basicUnsafeNew = coerce $ M.basicUnsafeNew @St.MVector @a
833+
basicInitialize = coerce $ M.basicInitialize @St.MVector @a
834+
basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @St.MVector @a
835+
basicUnsafeRead = coerce $ M.basicUnsafeRead @St.MVector @a
836+
basicUnsafeWrite = coerce $ M.basicUnsafeWrite @St.MVector @a
837+
basicClear = coerce $ M.basicClear @St.MVector @a
838+
basicSet = coerce $ M.basicSet @St.MVector @a
839+
basicUnsafeCopy = coerce $ M.basicUnsafeCopy @St.MVector @a
840+
basicUnsafeMove = coerce $ M.basicUnsafeMove @St.MVector @a
841+
basicUnsafeGrow = coerce $ M.basicUnsafeGrow @St.MVector @a
842+
843+
instance St.Storable a => G.Vector Vector (UnboxViaStorable a) where
844+
{-# INLINE basicUnsafeFreeze #-}
845+
{-# INLINE basicUnsafeThaw #-}
846+
{-# INLINE basicLength #-}
847+
{-# INLINE basicUnsafeSlice #-}
848+
{-# INLINE basicUnsafeIndexM #-}
849+
{-# INLINE elemseq #-}
850+
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @St.Vector @a
851+
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @St.Vector @a
852+
basicLength = coerce $ G.basicLength @St.Vector @a
853+
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @St.Vector @a
854+
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @St.Vector @a
855+
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @St.Vector @a
856+
elemseq _ = seq
857+
858+
instance St.Storable a => Unbox (UnboxViaStorable a)
859+
763860
-- -------
764861
-- Unboxing the boxed values
765862
-- -------
@@ -777,7 +874,6 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
777874
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia
778875
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
779876
-- >>> import qualified Data.Vector.Unboxed as VU
780-
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
781877
-- >>> import qualified Data.Vector.Generic as VG
782878
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
783879
-- >>> :{
@@ -790,7 +886,7 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
790886
-- >>> {-# INLINE fromURepr #-}
791887
-- >>> newtype instance VU.MVector s (Foo a) = MV_Foo (VU.MVector s (Int, VU.DoNotUnboxLazy a))
792888
-- >>> newtype instance VU.Vector (Foo a) = V_Foo (VU.Vector (Int, VU.DoNotUnboxLazy a))
793-
-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VGM.MVector VUM.MVector (Foo a)
889+
-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VGM.MVector VU.MVector (Foo a)
794890
-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VG.Vector VU.Vector (Foo a)
795891
-- >>> instance VU.Unbox (Foo a)
796892
-- >>> :}
@@ -862,7 +958,6 @@ instance Unbox (DoNotUnboxLazy a)
862958
-- >>> :set -XBangPatterns -XTypeFamilies -XStandaloneDeriving -XDerivingVia
863959
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
864960
-- >>> import qualified Data.Vector.Unboxed as VU
865-
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
866961
-- >>> import qualified Data.Vector.Generic as VG
867962
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
868963
-- >>> :{
@@ -875,7 +970,7 @@ instance Unbox (DoNotUnboxLazy a)
875970
-- >>> {-# INLINE fromURepr #-}
876971
-- >>> newtype instance VU.MVector s (Bar a) = MV_Bar (VU.MVector s (Int, VU.DoNotUnboxStrict a))
877972
-- >>> newtype instance VU.Vector (Bar a) = V_Bar (VU.Vector (Int, VU.DoNotUnboxStrict a))
878-
-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VGM.MVector VUM.MVector (Bar a)
973+
-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VGM.MVector VU.MVector (Bar a)
879974
-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VG.Vector VU.Vector (Bar a)
880975
-- >>> instance VU.Unbox (Bar a)
881976
-- >>> :}
@@ -947,7 +1042,6 @@ instance Unbox (DoNotUnboxStrict a)
9471042
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia
9481043
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
9491044
-- >>> import qualified Data.Vector.Unboxed as VU
950-
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
9511045
-- >>> import qualified Data.Vector.Generic as VG
9521046
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
9531047
-- >>> import qualified Control.DeepSeq as NF
@@ -961,7 +1055,7 @@ instance Unbox (DoNotUnboxStrict a)
9611055
-- >>> {-# INLINE fromURepr #-}
9621056
-- >>> newtype instance VU.MVector s (Baz a) = MV_Baz (VU.MVector s (Int, VU.DoNotUnboxNormalForm a))
9631057
-- >>> newtype instance VU.Vector (Baz a) = V_Baz (VU.Vector (Int, VU.DoNotUnboxNormalForm a))
964-
-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VGM.MVector VUM.MVector (Baz a)
1058+
-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VGM.MVector VU.MVector (Baz a)
9651059
-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VG.Vector VU.Vector (Baz a)
9661060
-- >>> instance NF.NFData a => VU.Unbox (Baz a)
9671061
-- >>> :}

‎vector/tests/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ import qualified Tests.Vector.Strict
88
import qualified Tests.Vector.Unboxed
99
import qualified Tests.Bundle
1010
import qualified Tests.Move
11+
import qualified Tests.Deriving ()
1112

1213
import Test.Tasty (defaultMain,testGroup)
1314

0 commit comments

Comments
 (0)