Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Unboxed instances for Storable vectors #518

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
110 changes: 104 additions & 6 deletions vector/src/Data/Vector/Unboxed/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,14 +27,15 @@

module Data.Vector.Unboxed.Base (
MVector(..), IOVector, STVector, Vector(..), Unbox,
UnboxViaPrim(..), As(..), IsoUnbox(..),
UnboxViaPrim(..), UnboxViaStorable(..), As(..), IsoUnbox(..),
DoNotUnboxLazy(..), DoNotUnboxNormalForm(..), DoNotUnboxStrict(..)
) where

import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector as B
import qualified Data.Vector.Strict as S
import qualified Data.Vector.Storable as St

import qualified Data.Vector.Primitive as P

Expand Down Expand Up @@ -195,14 +196,14 @@ instance G.Vector Vector () where
-- >>>
-- >>> newtype Foo = Foo Int deriving VP.Prim
-- >>>
-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Foo)
-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Foo)
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Foo)
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Foo)
-- >>> deriving via (VU.UnboxViaPrim Foo) instance VGM.MVector VU.MVector Foo
-- >>> deriving via (VU.UnboxViaPrim Foo) instance VG.Vector VU.Vector Foo
-- >>> instance VU.Unbox Foo
--
-- Second example is essentially same but with a twist. Instead of
-- using @Prim@ instance of data type, we use underlying instance of @Int@:
-- using 'P.Prim' instance of data type, we use underlying instance of 'Int':
--
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
-- >>>
Expand All @@ -213,8 +214,8 @@ instance G.Vector Vector () where
-- >>>
-- >>> newtype Foo = Foo Int
-- >>>
-- >>> newtype instance VU.MVector s Foo = MV_Int (VP.MVector s Int)
-- >>> newtype instance VU.Vector Foo = V_Int (VP.Vector Int)
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Int)
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Int)
-- >>> deriving via (VU.UnboxViaPrim Int) instance VGM.MVector VU.MVector Foo
-- >>> deriving via (VU.UnboxViaPrim Int) instance VG.Vector VU.Vector Foo
-- >>> instance VU.Unbox Foo
Expand Down Expand Up @@ -768,6 +769,103 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x
$ G.elemseq (undefined :: Vector b) y z

-- -------
-- Unboxing the Storable values
-- -------

-- | Newtype wrapper which allows to derive unboxed vector in term of
-- storable vectors using @DerivingVia@ mechanism. This is mostly
-- used as illustration of use of @DerivingVia@ for vector, see examples below.
--
-- First is rather straightforward: we define newtype and use GND to
-- derive 'St.Storable' instance. Newtype instances should be defined
-- manually. Then we use deriving via to define necessary instances.
--
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
-- >>> -- Needed to derive Prim
-- >>> :set -XGeneralizedNewtypeDeriving -XDataKinds -XUnboxedTuples -XPolyKinds
-- >>>
-- >>> import qualified Data.Vector.Generic as VG
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
-- >>> import qualified Data.Vector.Storable as VS
-- >>> import qualified Data.Vector.Unboxed as VU
-- >>>
-- >>> newtype Foo = Foo Int deriving VS.Storable
-- >>>
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Foo)
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Foo)
-- >>> deriving via (VU.UnboxViaStorable Foo) instance VGM.MVector VU.MVector Foo
-- >>> deriving via (VU.UnboxViaStorable Foo) instance VG.Vector VU.Vector Foo
-- >>> instance VU.Unbox Foo
--
-- Second example is essentially same but with a twist. Instead of
-- using 'St.Storable' instance of data type, we use underlying instance of 'Int':
--
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia -XMultiParamTypeClasses
-- >>>
-- >>> import qualified Data.Vector.Generic as VG
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
-- >>> import qualified Data.Vector.Storable as VS
-- >>> import qualified Data.Vector.Unboxed as VU
-- >>>
-- >>> newtype Foo = Foo Int
-- >>>
-- >>> newtype instance VU.MVector s Foo = MV_Foo (VP.MVector s Int)
-- >>> newtype instance VU.Vector Foo = V_Foo (VP.Vector Int)
-- >>> deriving via (VU.UnboxViaStorable Int) instance VGM.MVector VU.MVector Foo
-- >>> deriving via (VU.UnboxViaStorable Int) instance VG.Vector VU.Vector Foo
-- >>> instance VU.Unbox Foo
--
-- @since 0.13.0.0
newtype UnboxViaStorable a = UnboxViaStorable a

newtype instance MVector s (UnboxViaStorable a) = MV_UnboxViaStorable (St.MVector s a)
newtype instance Vector (UnboxViaStorable a) = V_UnboxViaStorable (St.Vector a)

instance St.Storable a => M.MVector MVector (UnboxViaStorable a) where
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
{-# INLINE basicUnsafeNew #-}
{-# INLINE basicInitialize #-}
{-# INLINE basicUnsafeReplicate #-}
{-# INLINE basicUnsafeRead #-}
{-# INLINE basicUnsafeWrite #-}
{-# INLINE basicClear #-}
{-# INLINE basicSet #-}
{-# INLINE basicUnsafeCopy #-}
{-# INLINE basicUnsafeGrow #-}
basicLength = coerce $ M.basicLength @St.MVector @a
basicUnsafeSlice = coerce $ M.basicUnsafeSlice @St.MVector @a
basicOverlaps = coerce $ M.basicOverlaps @St.MVector @a
basicUnsafeNew = coerce $ M.basicUnsafeNew @St.MVector @a
basicInitialize = coerce $ M.basicInitialize @St.MVector @a
basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @St.MVector @a
basicUnsafeRead = coerce $ M.basicUnsafeRead @St.MVector @a
basicUnsafeWrite = coerce $ M.basicUnsafeWrite @St.MVector @a
basicClear = coerce $ M.basicClear @St.MVector @a
basicSet = coerce $ M.basicSet @St.MVector @a
basicUnsafeCopy = coerce $ M.basicUnsafeCopy @St.MVector @a
basicUnsafeMove = coerce $ M.basicUnsafeMove @St.MVector @a
basicUnsafeGrow = coerce $ M.basicUnsafeGrow @St.MVector @a

instance St.Storable a => G.Vector Vector (UnboxViaStorable a) where
{-# INLINE basicUnsafeFreeze #-}
{-# INLINE basicUnsafeThaw #-}
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicUnsafeIndexM #-}
{-# INLINE elemseq #-}
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @St.Vector @a
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @St.Vector @a
basicLength = coerce $ G.basicLength @St.Vector @a
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @St.Vector @a
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @St.Vector @a
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @St.Vector @a
elemseq _ = seq

instance St.Storable a => Unbox (UnboxViaStorable a)

-- -------
-- Unboxing the boxed values
-- -------
Expand Down