Skip to content

Commit 89d7584

Browse files
recursion-ninjarecursion-ninja
authored
Adding implementation of unboxing newtypes for boxed data. (#508)
1 parent 81bcf1c commit 89d7584

File tree

2 files changed

+282
-31
lines changed

2 files changed

+282
-31
lines changed

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

Lines changed: 14 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -132,15 +132,12 @@ module Data.Vector.Unboxed (
132132
-- ** Zipping
133133
zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
134134
izipWith, izipWith3, izipWith4, izipWith5, izipWith6,
135-
-- *** Zipping tuples
136-
-- $zip
137135
zip, zip3, zip4, zip5, zip6,
138136

139137
-- ** Monadic zipping
140138
zipWithM, izipWithM, zipWithM_, izipWithM_,
141139

142140
-- ** Unzipping
143-
-- $unzip
144141
unzip, unzip3, unzip4, unzip5, unzip6,
145142

146143
-- * Working with predicates
@@ -201,7 +198,14 @@ module Data.Vector.Unboxed (
201198
-- ** Deriving via
202199
UnboxViaPrim(..),
203200
As(..),
204-
IsoUnbox(..)
201+
IsoUnbox(..),
202+
203+
-- *** /Lazy/ boxing
204+
DoNotUnboxLazy(..),
205+
206+
-- *** /Strict/ boxing
207+
DoNotUnboxStrict(..),
208+
DoNotUnboxNormalForm(..)
205209
) where
206210

207211
import Data.Vector.Unboxed.Base
@@ -973,26 +977,6 @@ iforM_ = G.iforM_
973977
-- Zipping
974978
-- -------
975979

976-
-- $zip
977-
--
978-
-- Following functions could be used to construct vector of tuples
979-
-- from tuple of vectors. This operation is done in /O(1)/ time and
980-
-- will share underlying buffers.
981-
--
982-
-- Note that variants from "Data.Vector.Generic" doesn't have this
983-
-- property.
984-
985-
-- $unzip
986-
--
987-
-- Following functions could be used to access underlying
988-
-- representation of array of tuples. They convert array to tuple of
989-
-- arrays. This operation is done in /O(1)/ time and will share
990-
-- underlying buffers.
991-
--
992-
-- Note that variants from "Data.Vector.Generic" doesn't have this
993-
-- property.
994-
995-
996980
-- | /O(min(m,n))/ Zip two vectors with the given function.
997981
zipWith :: (Unbox a, Unbox b, Unbox c)
998982
=> (a -> b -> c) -> Vector a -> Vector b -> Vector c
@@ -1951,12 +1935,12 @@ toList :: Unbox a => Vector a -> [a]
19511935
{-# INLINE toList #-}
19521936
toList = G.toList
19531937

1954-
-- | /O(n)/ Convert a list to a vector. During the operation, the
1955-
-- vector’s capacity will be doubling until the list's contents are
1956-
-- in the vector. Depending on the list’s size, up to half of the vector’s
1957-
-- capacity might be empty. If you’d rather avoid this, you can use
1958-
-- 'fromListN', which will provide the exact space the list requires but will
1959-
-- prevent list fusion, or @'force' . 'fromList'@, which will create the
1938+
-- | /O(n)/ Convert a list to a vector. During the operation, the
1939+
-- vector’s capacity will be doubling until the list's contents are
1940+
-- in the vector. Depending on the list’s size, up to half of the vector’s
1941+
-- capacity might be empty. If you’d rather avoid this, you can use
1942+
-- 'fromListN', which will provide the exact space the list requires but will
1943+
-- prevent list fusion, or @'force' . 'fromList'@, which will create the
19601944
-- vector and then copy it without the superfluous space.
19611945
--
19621946
-- @since 0.3

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

Lines changed: 268 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,11 +27,14 @@
2727

2828
module Data.Vector.Unboxed.Base (
2929
MVector(..), IOVector, STVector, Vector(..), Unbox,
30-
UnboxViaPrim(..), As(..), IsoUnbox(..)
30+
UnboxViaPrim(..), As(..), IsoUnbox(..),
31+
DoNotUnboxLazy(..), DoNotUnboxNormalForm(..), DoNotUnboxStrict(..)
3132
) where
3233

3334
import qualified Data.Vector.Generic as G
3435
import qualified Data.Vector.Generic.Mutable as M
36+
import qualified Data.Vector as B
37+
import qualified Data.Vector.Strict as S
3538

3639
import qualified Data.Vector.Primitive as P
3740

@@ -41,6 +44,7 @@ import Control.DeepSeq ( NFData(rnf)
4144
#if MIN_VERSION_deepseq(1,4,3)
4245
, NFData1(liftRnf)
4346
#endif
47+
, force
4448
)
4549

4650
import Control.Monad.Primitive
@@ -764,6 +768,269 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where
764768
elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x
765769
$ G.elemseq (undefined :: Vector b) y z
766770

771+
-- -------
772+
-- Unboxing the boxed values
773+
-- -------
774+
775+
-- | Newtype which allows to derive unbox instances for type @a@ which
776+
-- is normally a "boxed" type. The newtype does not alter the strictness
777+
-- semantics of the underlying type and inherits the laizness of said type.
778+
-- For a strict newtype wrapper, see 'DoNotUnboxStrict'.
779+
--
780+
-- 'DoNotUnboxLazy' is intended to be unsed in conjunction with the newtype 'As'
781+
-- and the type class 'IsoUnbox'. Here's an example which uses the following
782+
-- explicit 'IsoUnbox' instance:
783+
--
784+
--
785+
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia
786+
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
787+
-- >>> import qualified Data.Vector.Unboxed as VU
788+
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
789+
-- >>> import qualified Data.Vector.Generic as VG
790+
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
791+
-- >>> :{
792+
-- >>> data Foo a = Foo Int a
793+
-- >>> deriving (Eq, Ord, Show)
794+
-- >>> instance VU.IsoUnbox (Foo a) (Int, VU.DoNotUnboxLazy a) where
795+
-- >>> toURepr (Foo i a) = (i, VU.DoNotUnboxLazy a)
796+
-- >>> fromURepr (i, VU.DoNotUnboxLazy a) = Foo i a
797+
-- >>> {-# INLINE toURepr #-}
798+
-- >>> {-# INLINE fromURepr #-}
799+
-- >>> newtype instance VU.MVector s (Foo a) = MV_Foo (VU.MVector s (Int, VU.DoNotUnboxLazy a))
800+
-- >>> newtype instance VU.Vector (Foo a) = V_Foo (VU.Vector (Int, VU.DoNotUnboxLazy a))
801+
-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VGM.MVector VUM.MVector (Foo a)
802+
-- >>> deriving via (Foo a `VU.As` (Int, VU.DoNotUnboxLazy a)) instance VG.Vector VU.Vector (Foo a)
803+
-- >>> instance VU.Unbox (Foo a)
804+
-- >>> :}
805+
--
806+
-- >>> VU.fromListN 3 [ Foo 4 "Haskell's", Foo 8 "strong", Foo 16 "types" ]
807+
-- [Foo 4 "Haskell's",Foo 8 "strong",Foo 16 "types"]
808+
--
809+
-- @since 0.13.2.0
810+
newtype DoNotUnboxLazy a = DoNotUnboxLazy a
811+
812+
newtype instance MVector s (DoNotUnboxLazy a) = MV_DoNotUnboxLazy (B.MVector s a)
813+
newtype instance Vector (DoNotUnboxLazy a) = V_DoNotUnboxLazy (B.Vector a)
814+
815+
instance M.MVector MVector (DoNotUnboxLazy a) where
816+
{-# INLINE basicLength #-}
817+
{-# INLINE basicUnsafeSlice #-}
818+
{-# INLINE basicOverlaps #-}
819+
{-# INLINE basicUnsafeNew #-}
820+
{-# INLINE basicInitialize #-}
821+
{-# INLINE basicUnsafeReplicate #-}
822+
{-# INLINE basicUnsafeRead #-}
823+
{-# INLINE basicUnsafeWrite #-}
824+
{-# INLINE basicClear #-}
825+
{-# INLINE basicSet #-}
826+
{-# INLINE basicUnsafeCopy #-}
827+
{-# INLINE basicUnsafeGrow #-}
828+
basicLength = coerce $ M.basicLength @B.MVector @a
829+
basicUnsafeSlice = coerce $ M.basicUnsafeSlice @B.MVector @a
830+
basicOverlaps = coerce $ M.basicOverlaps @B.MVector @a
831+
basicUnsafeNew = coerce $ M.basicUnsafeNew @B.MVector @a
832+
basicInitialize = coerce $ M.basicInitialize @B.MVector @a
833+
basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @B.MVector @a
834+
basicUnsafeRead = coerce $ M.basicUnsafeRead @B.MVector @a
835+
basicUnsafeWrite = coerce $ M.basicUnsafeWrite @B.MVector @a
836+
basicClear = coerce $ M.basicClear @B.MVector @a
837+
basicSet = coerce $ M.basicSet @B.MVector @a
838+
basicUnsafeCopy = coerce $ M.basicUnsafeCopy @B.MVector @a
839+
basicUnsafeMove = coerce $ M.basicUnsafeMove @B.MVector @a
840+
basicUnsafeGrow = coerce $ M.basicUnsafeGrow @B.MVector @a
841+
842+
instance G.Vector Vector (DoNotUnboxLazy a) where
843+
{-# INLINE basicUnsafeFreeze #-}
844+
{-# INLINE basicUnsafeThaw #-}
845+
{-# INLINE basicLength #-}
846+
{-# INLINE basicUnsafeSlice #-}
847+
{-# INLINE basicUnsafeIndexM #-}
848+
{-# INLINE elemseq #-}
849+
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @B.Vector @a
850+
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @B.Vector @a
851+
basicLength = coerce $ G.basicLength @B.Vector @a
852+
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @B.Vector @a
853+
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @B.Vector @a
854+
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @B.Vector @a
855+
elemseq _ = seq
856+
857+
instance Unbox (DoNotUnboxLazy a)
858+
859+
-- | Newtype which allows to derive unbox instances for type @a@ which
860+
-- is normally a "boxed" type. The newtype stictly evaluates the wrapped values
861+
-- ensuring that the unboxed vector contains no (direct) thunks.
862+
-- For a less strict newtype wrapper, see 'DoNotUnboxLazy'.
863+
-- For a more strict newtype wrapper, see 'DoNotUnboxNormalForm'.
864+
--
865+
-- 'DoNotUnboxStrict' is intended to be unsed in conjunction with the newtype 'As'
866+
-- and the type class 'IsoUnbox'. Here's an example which uses the following
867+
-- explicit 'IsoUnbox' instance:
868+
--
869+
--
870+
-- >>> :set -XBangPatterns -XTypeFamilies -XStandaloneDeriving -XDerivingVia
871+
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
872+
-- >>> import qualified Data.Vector.Unboxed as VU
873+
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
874+
-- >>> import qualified Data.Vector.Generic as VG
875+
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
876+
-- >>> :{
877+
-- >>> data Bar a = Bar Int a
878+
-- >>> deriving Show
879+
-- >>> instance VU.IsoUnbox (Bar a) (Int, VU.DoNotUnboxStrict a) where
880+
-- >>> toURepr (Bar i !a) = (i, VU.DoNotUnboxStrict a)
881+
-- >>> fromURepr (i, VU.DoNotUnboxStrict a) = Bar i a
882+
-- >>> {-# INLINE toURepr #-}
883+
-- >>> {-# INLINE fromURepr #-}
884+
-- >>> newtype instance VU.MVector s (Bar a) = MV_Bar (VU.MVector s (Int, VU.DoNotUnboxStrict a))
885+
-- >>> newtype instance VU.Vector (Bar a) = V_Bar (VU.Vector (Int, VU.DoNotUnboxStrict a))
886+
-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VGM.MVector VUM.MVector (Bar a)
887+
-- >>> deriving via (Bar a `VU.As` (Int, VU.DoNotUnboxStrict a)) instance VG.Vector VU.Vector (Bar a)
888+
-- >>> instance VU.Unbox (Bar a)
889+
-- >>> :}
890+
--
891+
-- >>> VU.fromListN 3 [ Bar 3 "Bye", Bar 2 "for", Bar 1 "now" ]
892+
-- [Bar 3 "Bye",Bar 2 "for",Bar 1 "now"]
893+
--
894+
-- @since 0.13.2.0
895+
newtype DoNotUnboxStrict a = DoNotUnboxStrict a
896+
897+
newtype instance MVector s (DoNotUnboxStrict a) = MV_DoNotUnboxStrict (S.MVector s a)
898+
newtype instance Vector (DoNotUnboxStrict a) = V_DoNotUnboxStrict (S.Vector a)
899+
900+
instance M.MVector MVector (DoNotUnboxStrict a) where
901+
{-# INLINE basicLength #-}
902+
{-# INLINE basicUnsafeSlice #-}
903+
{-# INLINE basicOverlaps #-}
904+
{-# INLINE basicUnsafeNew #-}
905+
{-# INLINE basicInitialize #-}
906+
{-# INLINE basicUnsafeReplicate #-}
907+
{-# INLINE basicUnsafeRead #-}
908+
{-# INLINE basicUnsafeWrite #-}
909+
{-# INLINE basicClear #-}
910+
{-# INLINE basicSet #-}
911+
{-# INLINE basicUnsafeCopy #-}
912+
{-# INLINE basicUnsafeGrow #-}
913+
basicLength = coerce $ M.basicLength @S.MVector @a
914+
basicUnsafeSlice = coerce $ M.basicUnsafeSlice @S.MVector @a
915+
basicOverlaps = coerce $ M.basicOverlaps @S.MVector @a
916+
basicUnsafeNew = coerce $ M.basicUnsafeNew @S.MVector @a
917+
basicInitialize = coerce $ M.basicInitialize @S.MVector @a
918+
basicUnsafeReplicate = coerce $ M.basicUnsafeReplicate @S.MVector @a
919+
basicUnsafeRead = coerce $ M.basicUnsafeRead @S.MVector @a
920+
basicUnsafeWrite = coerce $ M.basicUnsafeWrite @S.MVector @a
921+
basicClear = coerce $ M.basicClear @S.MVector @a
922+
basicSet = coerce $ M.basicSet @S.MVector @a
923+
basicUnsafeCopy = coerce $ M.basicUnsafeCopy @S.MVector @a
924+
basicUnsafeMove = coerce $ M.basicUnsafeMove @S.MVector @a
925+
basicUnsafeGrow = coerce $ M.basicUnsafeGrow @S.MVector @a
926+
927+
instance G.Vector Vector (DoNotUnboxStrict a) where
928+
{-# INLINE basicUnsafeFreeze #-}
929+
{-# INLINE basicUnsafeThaw #-}
930+
{-# INLINE basicLength #-}
931+
{-# INLINE basicUnsafeSlice #-}
932+
{-# INLINE basicUnsafeIndexM #-}
933+
{-# INLINE elemseq #-}
934+
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @S.Vector @a
935+
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @S.Vector @a
936+
basicLength = coerce $ G.basicLength @S.Vector @a
937+
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @S.Vector @a
938+
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @S.Vector @a
939+
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @S.Vector @a
940+
elemseq _ = seq
941+
942+
instance Unbox (DoNotUnboxStrict a)
943+
944+
-- | Newtype which allows to derive unbox instances for type @a@ which
945+
-- is normally a "boxed" type. The newtype stictly evaluates the wrapped values
946+
-- via thier requisite 'NFData' instance, ensuring that the unboxed vector
947+
-- contains only values reduced to normal form.
948+
-- For a less strict newtype wrappers, see 'DoNotUnboxLazy' and 'DoNotUnboxStrict'.
949+
--
950+
-- 'DoNotUnboxNormalForm' is intended to be unsed in conjunction with the newtype 'As'
951+
-- and the type class 'IsoUnbox'. Here's an example which uses the following
952+
-- explicit 'IsoUnbox' instance:
953+
--
954+
--
955+
-- >>> :set -XTypeFamilies -XStandaloneDeriving -XDerivingVia
956+
-- >>> :set -XMultiParamTypeClasses -XTypeOperators -XFlexibleInstances
957+
-- >>> import qualified Data.Vector.Unboxed as VU
958+
-- >>> import qualified Data.Vector.Unboxed.Mutable as VUM
959+
-- >>> import qualified Data.Vector.Generic as VG
960+
-- >>> import qualified Data.Vector.Generic.Mutable as VGM
961+
-- >>> import qualified Control.DeepSeq as NF
962+
-- >>> :{
963+
-- >>> data Baz a = Baz Int a
964+
-- >>> deriving Show
965+
-- >>> instance NF.NFData a => VU.IsoUnbox (Baz a) (Int, VU.DoNotUnboxNormalForm a) where
966+
-- >>> toURepr (Baz i a) = (i, VU.DoNotUnboxNormalForm $ NF.force a)
967+
-- >>> fromURepr (i, VU.DoNotUnboxNormalForm a) = Baz i a
968+
-- >>> {-# INLINE toURepr #-}
969+
-- >>> {-# INLINE fromURepr #-}
970+
-- >>> newtype instance VU.MVector s (Baz a) = MV_Baz (VU.MVector s (Int, VU.DoNotUnboxNormalForm a))
971+
-- >>> newtype instance VU.Vector (Baz a) = V_Baz (VU.Vector (Int, VU.DoNotUnboxNormalForm a))
972+
-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VGM.MVector VUM.MVector (Baz a)
973+
-- >>> deriving via (Baz a `VU.As` (Int, VU.DoNotUnboxNormalForm a)) instance NF.NFData a => VG.Vector VU.Vector (Baz a)
974+
-- >>> instance NF.NFData a => VU.Unbox (Baz a)
975+
-- >>> :}
976+
--
977+
-- >>> VU.fromListN 3 [ Baz 3 "Fully", Baz 9 "evaluated", Baz 27 "data" ]
978+
-- [Baz 3 "Fully",Baz 9 "evaluated",Baz 27 "data"]
979+
--
980+
-- @since 0.13.2.0
981+
newtype DoNotUnboxNormalForm a = DoNotUnboxNormalForm a
982+
983+
newtype instance MVector s (DoNotUnboxNormalForm a) = MV_DoNotUnboxNormalForm (S.MVector s a)
984+
newtype instance Vector (DoNotUnboxNormalForm a) = V_DoNotUnboxNormalForm (S.Vector a)
985+
986+
instance NFData a => M.MVector MVector (DoNotUnboxNormalForm a) where
987+
{-# INLINE basicLength #-}
988+
{-# INLINE basicUnsafeSlice #-}
989+
{-# INLINE basicOverlaps #-}
990+
{-# INLINE basicUnsafeNew #-}
991+
{-# INLINE basicInitialize #-}
992+
{-# INLINE basicUnsafeReplicate #-}
993+
{-# INLINE basicUnsafeRead #-}
994+
{-# INLINE basicUnsafeWrite #-}
995+
{-# INLINE basicClear #-}
996+
{-# INLINE basicSet #-}
997+
{-# INLINE basicUnsafeCopy #-}
998+
{-# INLINE basicUnsafeGrow #-}
999+
basicLength = coerce $ M.basicLength @S.MVector @a
1000+
basicUnsafeSlice = coerce $ M.basicUnsafeSlice @S.MVector @a
1001+
basicOverlaps = coerce $ M.basicOverlaps @S.MVector @a
1002+
basicUnsafeNew = coerce $ M.basicUnsafeNew @S.MVector @a
1003+
basicInitialize = coerce $ M.basicInitialize @S.MVector @a
1004+
basicUnsafeReplicate = coerce (\i x -> M.basicUnsafeReplicate @S.MVector @a i (force x))
1005+
basicUnsafeRead = coerce $ M.basicUnsafeRead @S.MVector @a
1006+
basicUnsafeWrite = coerce (\v i x -> M.basicUnsafeWrite @S.MVector @a v i (force x))
1007+
basicClear = coerce $ M.basicClear @S.MVector @a
1008+
basicSet = coerce (\v x -> M.basicSet @S.MVector @a v (force x))
1009+
basicUnsafeCopy = coerce $ M.basicUnsafeCopy @S.MVector @a
1010+
basicUnsafeMove = coerce $ M.basicUnsafeMove @S.MVector @a
1011+
basicUnsafeGrow = coerce $ M.basicUnsafeGrow @S.MVector @a
1012+
1013+
instance NFData a => G.Vector Vector (DoNotUnboxNormalForm a) where
1014+
{-# INLINE basicUnsafeFreeze #-}
1015+
{-# INLINE basicUnsafeThaw #-}
1016+
{-# INLINE basicLength #-}
1017+
{-# INLINE basicUnsafeSlice #-}
1018+
{-# INLINE basicUnsafeIndexM #-}
1019+
{-# INLINE elemseq #-}
1020+
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @S.Vector @a
1021+
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @S.Vector @a
1022+
basicLength = coerce $ G.basicLength @S.Vector @a
1023+
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @S.Vector @a
1024+
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @S.Vector @a
1025+
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @S.Vector @a
1026+
elemseq _ x y = rnf (coerce x :: a) `seq` y
1027+
1028+
instance NFData a => Unbox (DoNotUnboxNormalForm a)
1029+
1030+
instance NFData a => NFData (DoNotUnboxNormalForm a) where
1031+
{-# INLINE rnf #-}
1032+
rnf = rnf . coerce @(DoNotUnboxNormalForm a) @a
1033+
7671034
deriveNewtypeInstances((), Any, Bool, Any, V_Any, MV_Any)
7681035
deriveNewtypeInstances((), All, Bool, All, V_All, MV_All)
7691036

0 commit comments

Comments
 (0)