diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,8 @@ +# Changelog for unboxing-vector + +## Version 0.1.0.0 (2019-06-17) + +Initial release with + +- Data.Vector.Unboxing +- Data.Vector.Unboxing.Mutable diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright ARATA Mizuki (c) 2019 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of ARATA Mizuki nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,80 @@ +# unboxing-vector + +This package provides newtype-friendly wrappers for `Data.Vector.Unboxed` in [`vector` package](http://hackage.haskell.org/package/vector). + +## Description + +Suppose you define a newtype for `Int` and want to store them in an unboxed vector. + +```haskell +newtype Foo = Foo Int + +generate 10 (\i -> Foo i) :: Data.Vector.Unboxed.Vector Foo +``` + +With plain `Data.Vector.Unboxed`, you either write two dozen of lines of code to get it work (the exact code is [here](https://github.com/minoki/unboxing-vector/blob/3a152014b9660ef1e2885d6b9c66423064223f63/test/Foo.hs#L36-L63)), or resort to Template Haskell ([`vector-th-unbox` package](http://hackage.haskell.org/package/vector-th-unbox)) to generate it. + +But with `Data.Vector.Unboxing`, the code you write is just two lines: + +```haskell +instance Data.Vector.Unboxing.Unboxable Foo where + type Rep Foo = Int + +generate 10 (\i -> Foo i) :: Data.Vector.Unboxing.Vector Foo +``` + +...and if you want to be even more concise, you can derive `Unboxable` instance with `GeneralizedNewtypeDeriving`. + +Note that the vector type provided by this package (`Data.Vector.Unboxing.Vector`) is *different* from `Data.Vector.Unboxed.Vector`. + +The module defining the type `Foo` does not need to export its constructor to enable use of `Vector Foo`. + +## For non-newtypes + +Suppose you define a datatype isomorphic to a tuple of primitive types, like: + +```haskell +data ComplexDouble = MkComplexDouble {-# UNPACK #-} !Double {-# UNPACK #-} !Double +``` + +In this example, `ComplexDouble` is isomorphic to `(Double, Double)`, but has a different representation. Thus, you cannot derive `Data.Vector.Unboxing.Unboxable` from `(Double, Double)`. + +For such cases, unboxing-vector provides a feature to derive `Unboxable` using `Generic`. + +```haskell +{-# LANGUAGE DeriveGeneric, DerivingVia, UndecidableInstances #-} + +data ComplexDouble = .. + deriving Generic + deriving Data.Vector.Unboxing.Unboxable via Data.Vector.Unboxing.Generics ComplexDouble +``` + +## Conversion + +### Conversion from/to Unboxed vector + +You can use `fromUnboxedVector` and `toUnboxedVector` to convert one vector type to another. + +```haskell +import qualified Data.Vector.Unboxed as Unboxed +import qualified Data.Vector.Unboxing as Unboxing + +convert :: Unboxed.Vector Int -> Unboxing.Vector Int +convert vec = Unboxing.fromUnboxedVector vec +``` + +### Coercion between Unboxing vectors + +You can use `coerceVector` to convert vector types of different element types, if they have the same representation and have appropriate data constructors in scope. + +```haskell +import qualified Data.Vector.Unboxing as Unboxing +import Data.MonoTraversable (ofold) +import Data.Monoid (Sum(..), All, getAll) + +sum :: Unboxing.Vector Int -> Int +sum vec = getSum $ ofold (Unboxing.coerceVector vec :: Unboxing.Vector (Sum Int)) -- OK + +and :: Unboxing.Vector Bool -> Bool +and vec = getAll $ ofold (Unboxing.coerceVector vec :: Unboxing.Vector All) -- fails because the data constructor is not in scope +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/benchmark/Bench.hs b/benchmark/Bench.hs new file mode 100644 --- /dev/null +++ b/benchmark/Bench.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -Wno-type-defaults -Wno-name-shadowing #-} +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Unboxed.Mutable as UM +import qualified Data.Vector.Unboxing as V +import qualified Data.Vector as B +import qualified Data.Vector.Generic as G +import System.Environment (getArgs, getProgName) +import Control.Monad +import Data.List +import qualified Poly as P + +modulo :: Int +modulo = 17 + +newtype IntMod = IntMod Int deriving (Eq) + +instance Show IntMod where + show (IntMod n) = show n + +instance V.Unboxable IntMod where + type Rep IntMod = Int + +instance Num IntMod where + IntMod x + IntMod y = IntMod ((x + y) `rem` modulo) + IntMod x - IntMod y = IntMod ((x - y) `mod` modulo) + IntMod x * IntMod y = IntMod ((x * y) `rem` modulo) + negate (IntMod x) = IntMod (negate x `mod` modulo) + fromInteger n = IntMod (fromInteger (n `mod` fromIntegral modulo)) + abs = undefined; signum = undefined + +instance Fractional IntMod where + recip x = let x2 = x * x + x5 = x2 * x2 * x + x15 = x5 * x5 * x5 + in x15 -- x^15 + fromRational = undefined + +trim :: U.Vector Int -> U.Vector Int +trim xs + | U.null xs = U.empty + | U.last xs == 0 = trim (U.init xs) + | otherwise = xs + +addMod, subMod, mulMod :: Int -> Int -> Int +addMod x y = (x + y) `rem` modulo +subMod x y = (x - y) `mod` modulo +mulMod x y = (x * y) `rem` modulo + +sumMod :: [Int] -> Int +sumMod = foldl' addMod 0 + +negateMod :: Int -> Int +negateMod x = (negate x) `mod` modulo + +recipMod :: Int -> Int +recipMod x = let x2 = x `mulMod` x + x5 = (x2 `mulMod` x2) `mulMod` x + x15 = (x5 `mulMod` x5) `mulMod` x5 + in x15 + +polyAdd :: U.Vector Int -> U.Vector Int -> U.Vector Int +polyAdd xs ys + | n < m = U.create $ do + v <- UM.new m + forM_ [0..n-1] $ \i -> UM.write v i ((xs U.! i) `addMod` (ys U.! i)) + forM_ [n..m-1] $ \i -> UM.write v i (ys U.! i) + return v + | m < n = U.create $ do + v <- UM.new n + forM_ [0..m-1] $ \i -> UM.write v i ((xs U.! i) `addMod` (ys U.! i)) + forM_ [m..n-1] $ \i -> UM.write v i (xs U.! i) + return v + | otherwise = trim $ U.zipWith addMod xs ys + where n = U.length xs + m = U.length ys + +polySub :: U.Vector Int -> U.Vector Int -> U.Vector Int +polySub xs ys + | n < m = U.create $ do + v <- UM.new m + forM_ [0..n-1] $ \i -> UM.write v i ((xs U.! i) `subMod` (ys U.! i)) + forM_ [n..m-1] $ \i -> UM.write v i (negateMod (ys U.! i)) + return v + | m < n = U.create $ do + v <- UM.new n + forM_ [0..m-1] $ \i -> UM.write v i ((xs U.! i) `subMod` (ys U.! i)) + forM_ [m..n-1] $ \i -> UM.write v i (xs U.! i) + return v + | otherwise = trim $ U.zipWith subMod xs ys + where n = U.length xs + m = U.length ys + +polyMul :: U.Vector Int -> U.Vector Int -> U.Vector Int +polyMul xs ys + | n == 0 || m == 0 = U.empty + | otherwise = U.generate (n + m - 1) (\i -> sumMod [(xs U.! j) `mulMod` (ys U.! (i - j)) | j <- [max 0 (i - m + 1)..min i (n-1)]]) + where n = U.length xs + m = U.length ys + +scalePoly :: Int -> U.Vector Int -> U.Vector Int +scalePoly a xs + | a == 0 = U.empty + | otherwise = U.map (`mulMod` a) xs + +toMonicPoly :: U.Vector Int -> U.Vector Int +toMonicPoly xs | U.null xs = U.empty + | otherwise = U.map (`mulMod` recipMod (U.last xs)) xs + +divModPoly :: U.Vector Int -> U.Vector Int -> (U.Vector Int, U.Vector Int) +divModPoly f g + | U.null g = error "divMod: divide by zero" + | U.length f < U.length g = (U.empty, f) + | otherwise = loop U.empty (scalePoly (recipMod b) f) + where + g' = toMonicPoly g + b = U.last g + -- invariant: f == q * g + scale b p + loop q !p | U.length p < U.length g = (q, scalePoly b p) + | otherwise = let !q' = U.drop (U.length g - 1) p + in loop (q `polyAdd` q') (p `polySub` (q' `polyMul` g')) + +modPoly :: U.Vector Int -> U.Vector Int -> U.Vector Int +modPoly f g = snd (divModPoly f g) + +powModPoly :: U.Vector Int -> Int -> U.Vector Int -> U.Vector Int +powModPoly _ 0 _modulo = U.singleton 1 +powModPoly f n modulo = loop (n-1) f f + where loop 0 !_ !acc = acc + loop 1 !m !acc = (m `polyMul` acc) `modPoly` modulo + loop i !m !acc + | even i = loop (i `quot` 2) ((m `polyMul` m) `modPoly` modulo) acc + | otherwise = loop (i `quot` 2) ((m `polyMul` m) `modPoly` modulo) ((m `polyMul` acc) `modPoly` modulo) + +powPoly :: U.Vector Int -> Int -> U.Vector Int +powPoly _ 0 = U.singleton 1 +powPoly f n = loop (n-1) f f + where loop 0 !_ !acc = acc + loop 1 !m !acc = m `polyMul` acc + loop i !m !acc + | even i = loop (i `quot` 2) (m `polyMul` m) acc + | otherwise = loop (i `quot` 2) (m `polyMul` m) (m `polyMul` acc) + +-- Specialization for unboxing vectors + IntMod: +{-# SPECIALIZE P.addPoly :: P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod #-} +{-# SPECIALIZE P.subPoly :: P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod #-} +{-# SPECIALIZE P.mulPoly :: P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod #-} +{-# SPECIALIZE P.divMod :: P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod -> (P.Poly V.Vector IntMod, P.Poly V.Vector IntMod) #-} +{-# SPECIALIZE P.powMod :: P.Poly V.Vector IntMod -> Int -> P.Poly V.Vector IntMod -> P.Poly V.Vector IntMod #-} + +-- Specialization for boxed vectors + IntMod: +{-# SPECIALIZE P.addPoly :: P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod #-} +{-# SPECIALIZE P.subPoly :: P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod #-} +{-# SPECIALIZE P.mulPoly :: P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod #-} +{-# SPECIALIZE P.divMod :: P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod -> (P.Poly B.Vector IntMod, P.Poly B.Vector IntMod) #-} +{-# SPECIALIZE P.powMod :: P.Poly B.Vector IntMod -> Int -> P.Poly B.Vector IntMod -> P.Poly B.Vector IntMod #-} + +main :: IO () +main = do + args <- getArgs + case args of + "unboxed":_ -> do + let f = U.fromList [modulo-1,modulo-1,modulo-1] `polyAdd` (powPoly (U.fromList [0,1]) 2000) {- U.fromList [if k==2000 then 1 else 0 | k<-[0..2000]] -} + let g = powModPoly (U.fromList [0,1]) 1000000000 f + print $ sumMod $ U.toList g -- should print '1' + "unboxing":_ -> do + let f = P.x^2000 - (P.x^2 + P.x + 1) :: P.Poly V.Vector IntMod + let g = P.powMod P.x 1000000000 f + print $ G.sum $ P.coeffAsc g -- should print '1' + "boxed":_ -> do + let f = P.x^2000 - (P.x^2 + P.x + 1) :: P.Poly B.Vector IntMod + let g = P.powMod P.x 1000000000 f + print $ G.sum $ P.coeffAsc g -- should print '1' + _ -> do + progName <- getProgName + putStrLn $ progName ++ " (unboxed|unboxing|boxed)" + putStr $ unlines ["This program computes the polynomial x^1000000000 mod (x^2000 - x^2 - x - 1)" + ,"and prints its value at x=1 in the finite field F_17 (or GF(17))." + ,"Run with '+RTS -t' to show memory usage." + ] diff --git a/benchmark/Poly.hs b/benchmark/Poly.hs new file mode 100644 --- /dev/null +++ b/benchmark/Poly.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE BangPatterns #-} +module Poly where +import Prelude hiding (gcd, div, mod, divMod, const) +import Control.Monad +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as GM +import qualified Data.Vector.Unboxing -- for writing SPECIALIZE instance pragma +import qualified Data.Vector -- for writing SPECIALIZE instance pragma + +infixl 7 `div`, `mod` + +-- univariate polynomial, coefficients in ascending order +newtype Poly vect a = Poly (vect a) deriving (Eq,Show) + +zero :: (G.Vector vect a) => Poly vect a +zero = Poly G.empty +{-# INLINE zero #-} + +isZero :: (G.Vector vect a) => Poly vect a -> Bool +isZero (Poly xs) = G.null xs +{-# INLINE isZero #-} + +const :: (Eq a, Num a, G.Vector vect a) => a -> Poly vect a +const 0 = zero +const a = Poly (G.singleton a) +{-# INLINE const #-} + +x :: (Num a, Eq a, G.Vector vect a) => Poly vect a +x = Poly (G.fromList [0, 1]) +{-# INLINE x #-} + +fromCoeffAsc :: (Eq a, Num a, G.Vector vect a) => vect a -> Poly vect a +fromCoeffAsc xs + | G.null xs = Poly G.empty + | G.last xs == 0 = fromCoeffAsc (G.init xs) + | otherwise = Poly xs +{-# INLINE fromCoeffAsc #-} + +coeffAsc :: Poly vect a -> vect a +coeffAsc (Poly xs) = xs +{-# INLINE coeffAsc #-} + +addPoly :: (Eq a, Num a, G.Vector vect a) => Poly vect a -> Poly vect a -> Poly vect a +addPoly (Poly xs) (Poly ys) + | n < m = Poly $ G.create $ do + v <- GM.new m + forM_ [0..n-1] $ \i -> GM.write v i ((xs G.! i) + (ys G.! i)) + forM_ [n..m-1] $ \i -> GM.write v i (ys G.! i) + return v + | m < n = Poly $ G.create $ do + v <- GM.new n + forM_ [0..m-1] $ \i -> GM.write v i ((xs G.! i) + (ys G.! i)) + forM_ [m..n-1] $ \i -> GM.write v i (xs G.! i) + return v + | otherwise = fromCoeffAsc $ G.zipWith (+) xs ys + where n = G.length xs + m = G.length ys +{-# INLINABLE addPoly #-} + +subPoly :: (Eq a, Num a, G.Vector vect a) => Poly vect a -> Poly vect a -> Poly vect a +subPoly (Poly xs) (Poly ys) + | n < m = Poly $ G.create $ do + v <- GM.new m + forM_ [0..n-1] $ \i -> GM.write v i ((xs G.! i) - (ys G.! i)) + forM_ [n..m-1] $ \i -> GM.write v i (negate (ys G.! i)) + return v + | m < n = Poly $ G.create $ do + v <- GM.new n + forM_ [0..m-1] $ \i -> GM.write v i ((xs G.! i) - (ys G.! i)) + forM_ [m..n-1] $ \i -> GM.write v i (xs G.! i) + return v + | otherwise = fromCoeffAsc $ G.zipWith (-) xs ys + where n = G.length xs + m = G.length ys +{-# INLINABLE subPoly #-} + +-- multiplication: naive method +mulPoly :: (Eq a, Num a, G.Vector vect a) => Poly vect a -> Poly vect a -> Poly vect a +mulPoly (Poly xs) (Poly ys) + | n == 0 || m == 0 = zero + | otherwise = Poly $ G.generate (n + m - 1) (\i -> sum [(xs G.! j) * (ys G.! (i - j)) | j <- [max 0 (i - m + 1)..min i (n-1)]]) + where n = G.length xs + m = G.length ys +{-# INLINABLE mulPoly #-} + +instance (Eq a, Num a, G.Vector vect a) => Num (Poly vect a) where + negate (Poly xs) = Poly $ G.map negate xs + {-# INLINE negate #-} + + (+) = addPoly + {-# INLINE (+) #-} + + (-) = subPoly + {-# INLINE (-) #-} + + (*) = mulPoly + {-# INLINE (*) #-} + + fromInteger n = const $ fromInteger n + {-# INLINE fromInteger #-} + + abs = undefined + signum = undefined + + {-# SPECIALIZE instance (Eq a, Num a) => Num (Poly Data.Vector.Vector a) #-} + {-# SPECIALIZE instance (Eq a, Num a, Data.Vector.Unboxing.Unboxable a) => Num (Poly Data.Vector.Unboxing.Vector a) #-} + +degree :: (G.Vector vect a) => Poly vect a -> Maybe Int +degree (Poly xs) = case G.length xs - 1 of + -1 -> Nothing + n -> Just n +{-# INLINE degree #-} + +degree' :: (G.Vector vect a) => Poly vect a -> Int +degree' (Poly xs) = case G.length xs of + 0 -> error "degree': zero polynomial" + n -> n - 1 +{-# INLINE degree' #-} + +leadingCoefficient :: (Num a, G.Vector vect a) => Poly vect a -> a +leadingCoefficient (Poly xs) + | G.null xs = 0 + | otherwise = G.last xs +{-# INLINE leadingCoefficient #-} + +toMonic :: (Fractional a, G.Vector vect a) => Poly vect a -> Poly vect a +toMonic f@(Poly xs) + | G.null xs = zero + | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs +{-# INLINE toMonic #-} + +scale :: (Eq a, Num a, G.Vector vect a) => a -> Poly vect a -> Poly vect a +scale a (Poly xs) + | a == 0 = zero + | otherwise = Poly $ G.map (* a) xs +{-# INLINE scale #-} + +divMod :: (Eq a, Fractional a, G.Vector vect a) => Poly vect a -> Poly vect a -> (Poly vect a, Poly vect a) +divMod f g + | isZero g = error "divMod: divide by zero" + | degree f < degree g = (zero, f) + | otherwise = loop zero (scale (recip b) f) + where + g' = toMonic g + b = leadingCoefficient g + -- invariant: f == q * g + scale b p + loop q !p | degree p < degree g = (q, scale b p) + | otherwise = let !q' = Poly (G.drop (degree' g) (coeffAsc p)) + in loop (q + q') (p - q' * g') +{-# INLINABLE divMod #-} + +div, mod :: (Eq a, Fractional a, G.Vector vect a) => Poly vect a -> Poly vect a -> Poly vect a +div f g = fst (divMod f g) +mod f g = snd (divMod f g) +{-# INLINE div #-} +{-# INLINE mod #-} + +-- | GCD with naive Euclidean algorithm +gcd :: (Eq a, Fractional a, G.Vector vect a) => Poly vect a -> Poly vect a -> Poly vect a +gcd f g | isZero g = f + | otherwise = gcd g (f `mod` g) +{-# INLINE gcd #-} + +powMod :: (Eq a, Fractional a, G.Vector vect a) => Poly vect a -> Int -> Poly vect a -> Poly vect a +powMod _a 0 _modulo = 1 +powMod a n modulo = loop (n-1) a a + where loop 0 !_ !acc = acc + loop 1 !m !acc = m * acc `mod` modulo + loop i !m !acc + | even i = loop (i `quot` 2) (m * m `mod` modulo) acc + | otherwise = loop (i `quot` 2) (m * m `mod` modulo) (m * acc `mod` modulo) +{-# INLINABLE powMod #-} diff --git a/src/Data/Vector/Unboxing.hs b/src/Data/Vector/Unboxing.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxing.hs @@ -0,0 +1,839 @@ +{-# LANGUAGE RankNTypes #-} +module Data.Vector.Unboxing + (Vector + ,Unboxable(Rep) + ,Generics(..) + -- * Accessors + -- ** Length information + ,length,null + -- ** Indexing + ,(!),(!?),head,last,unsafeIndex,unsafeHead,unsafeLast + -- ** Monadic indexing + ,indexM,headM,lastM,unsafeIndexM,unsafeHeadM,unsafeLastM + -- ** Extracting subvectors (slicing) + ,slice,init,tail,take,drop,splitAt,unsafeSlice,unsafeInit,unsafeTail + ,unsafeTake,unsafeDrop + -- * Construction + -- ** Initialisation + ,empty,singleton,replicate,generate,iterateN + -- ** Monadic initialisation + ,replicateM,generateM,iterateNM,create,createT + -- ** Unfolding + ,unfoldr,unfoldrN,unfoldrM,unfoldrNM,constructN,constructrN + -- ** Enumeration + ,enumFromN,enumFromStepN,enumFromTo,enumFromThenTo + -- ** Concatenation + ,cons,snoc,(++),concat + -- ** Restricting memory usage + ,force + -- * Modifying vectors + -- ** Bulk updates + ,(//),update,update_,unsafeUpd,unsafeUpdate,unsafeUpdate_ + -- ** Accumulations + ,accum,accumulate,accumulate_,unsafeAccum,unsafeAccumulate,unsafeAccumulate_ + -- ** Permutations + ,reverse,backpermute,unsafeBackpermute + -- ** Safe destructive updates + ,modify + -- * Elementwise operations + -- ** Indexing + ,indexed + -- ** Mapping + ,map,imap,concatMap + -- ** Monadic mapping + ,mapM,imapM,mapM_,imapM_,forM,forM_ + -- ** Zipping + ,zipWith,zipWith3,zipWith4,zipWith5,zipWith6,izipWith,izipWith3,izipWith4 + ,izipWith5,izipWith6,zip,zip3,zip4,zip5,zip6 + -- ** Monadic zipping + ,zipWithM,izipWithM,zipWithM_,izipWithM_ + -- ** Unzipping + ,unzip,unzip3,unzip4,unzip5,unzip6 + -- * Working with predicates + -- ** Filtering + ,filter,ifilter,uniq,mapMaybe,imapMaybe,filterM,takeWhile,dropWhile + -- ** Partitioning + ,partition,unstablePartition,span,break + -- ** Searching + ,elem,notElem,find,findIndex,findIndices,elemIndex,elemIndices + -- * Folding + ,foldl,foldl1,foldl',foldl1',foldr,foldr1,foldr',foldr1',ifoldl,ifoldl' + ,ifoldr,ifoldr' + -- ** Specialised folds + ,all,any,and,or,sum,product,maximum,maximumBy,minimum,minimumBy,minIndex + ,minIndexBy,maxIndex,maxIndexBy + -- ** Monadic folds + ,foldM,ifoldM,foldM',ifoldM',fold1M,fold1M',foldM_,ifoldM_,foldM'_,ifoldM'_ + ,fold1M_,fold1M'_ + -- * Prefix sums (scans) + ,prescanl,prescanl',postscanl,postscanl',scanl,scanl',scanl1,scanl1',iscanl + ,iscanl',prescanr,prescanr',postscanr,postscanr',scanr,scanr',scanr1,scanr1' + ,iscanr,iscanr' + -- * Conversions + -- ** Lists + ,toList,fromList,fromListN + -- ** Other vector types + ,convert -- from Data.Vector.Generic + ,toUnboxedVector + ,fromUnboxedVector + ,coerceVector + ,liftCoercion + ,vectorCoercion + -- ** Mutable vectors + ,freeze,thaw,copy,unsafeFreeze,unsafeThaw,unsafeCopy + ) where + +import Prelude (Monad,Int,Bool,Maybe,Traversable,Eq,Num,Enum,Ord,Ordering) +import qualified Data.Vector.Generic as G +import Data.Vector.Generic (convert) +import Data.Vector.Unboxing.Internal +import Control.Monad.ST +import Control.Monad.Primitive (PrimMonad,PrimState) + +length :: (Unboxable a) => Vector a -> Int +length = G.length +{-# INLINE length #-} + +null :: (Unboxable a) => Vector a -> Bool +null = G.null +{-# INLINE null #-} + +(!) :: (Unboxable a) => Vector a -> Int -> a +(!) = (G.!) +{-# INLINE (!) #-} + +(!?) :: (Unboxable a) => Vector a -> Int -> Maybe a +(!?) = (G.!?) +{-# INLINE (!?) #-} + +head :: (Unboxable a) => Vector a -> a +head = G.head +{-# INLINE head #-} + +last :: (Unboxable a) => Vector a -> a +last = G.last +{-# INLINE last #-} + +unsafeIndex :: (Unboxable a) => Vector a -> Int -> a +unsafeIndex = G.unsafeIndex +{-# INLINE unsafeIndex #-} + +unsafeHead :: (Unboxable a) => Vector a -> a +unsafeHead = G.unsafeHead +{-# INLINE unsafeHead #-} + +unsafeLast :: (Unboxable a) => Vector a -> a +unsafeLast = G.unsafeLast +{-# INLINE unsafeLast #-} + +indexM :: (Monad m, Unboxable a) => Vector a -> Int -> m a +indexM = G.indexM +{-# INLINE indexM #-} + +headM :: (Monad m, Unboxable a) => Vector a -> m a +headM = G.headM +{-# INLINE headM #-} + +lastM :: (Monad m, Unboxable a) => Vector a -> m a +lastM = G.lastM +{-# INLINE lastM #-} + +unsafeIndexM :: (Monad m, Unboxable a) => Vector a -> Int -> m a +unsafeIndexM = G.unsafeIndexM +{-# INLINE unsafeIndexM #-} + +unsafeHeadM :: (Monad m, Unboxable a) => Vector a -> m a +unsafeHeadM = G.unsafeHeadM +{-# INLINE unsafeHeadM #-} + +unsafeLastM :: (Monad m, Unboxable a) => Vector a -> m a +unsafeLastM = G.unsafeLastM +{-# INLINE unsafeLastM #-} + +slice :: (Unboxable a) => Int -> Int -> Vector a -> Vector a +slice = G.slice +{-# INLINE slice #-} + +init :: (Unboxable a) => Vector a -> Vector a +init = G.init +{-# INLINE init #-} + +tail :: (Unboxable a) => Vector a -> Vector a +tail = G.tail +{-# INLINE tail #-} + +take :: (Unboxable a) => Int -> Vector a -> Vector a +take = G.take +{-# INLINE take #-} + +drop :: (Unboxable a) => Int -> Vector a -> Vector a +drop = G.drop +{-# INLINE drop #-} + +splitAt :: (Unboxable a) => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt +{-# INLINE splitAt #-} + +unsafeSlice :: (Unboxable a) => Int -> Int -> Vector a -> Vector a +unsafeSlice = G.unsafeSlice +{-# INLINE unsafeSlice #-} + +unsafeInit :: (Unboxable a) => Vector a -> Vector a +unsafeInit = G.unsafeInit +{-# INLINE unsafeInit #-} + +unsafeTail :: (Unboxable a) => Vector a -> Vector a +unsafeTail = G.unsafeTail +{-# INLINE unsafeTail #-} + +unsafeTake :: (Unboxable a) => Int -> Vector a -> Vector a +unsafeTake = G.unsafeTake +{-# INLINE unsafeTake #-} + +unsafeDrop :: (Unboxable a) => Int -> Vector a -> Vector a +unsafeDrop = G.unsafeDrop +{-# INLINE unsafeDrop #-} + +empty :: (Unboxable a) => Vector a +empty = G.empty +{-# INLINE empty #-} + +singleton :: (Unboxable a) => a -> Vector a +singleton = G.singleton +{-# INLINE singleton #-} + +replicate :: (Unboxable a) => Int -> a -> Vector a +replicate = G.replicate +{-# INLINE replicate #-} + +generate :: (Unboxable a) => Int -> (Int -> a) -> Vector a +generate = G.generate +{-# INLINE generate #-} + +iterateN :: (Unboxable a) => Int -> (a -> a) -> a -> Vector a +iterateN = G.iterateN +{-# INLINE iterateN #-} + +replicateM :: (Monad m, Unboxable a) => Int -> m a -> m (Vector a) +replicateM = G.replicateM +{-# INLINE replicateM #-} + +generateM :: (Monad m, Unboxable a) => Int -> (Int -> m a) -> m (Vector a) +generateM = G.generateM +{-# INLINE generateM #-} + +iterateNM :: (Monad m, Unboxable a) => Int -> (a -> m a) -> a -> m (Vector a) +iterateNM = G.iterateNM +{-# INLINE iterateNM #-} + +create :: (Unboxable a) => (forall s. ST s (MVector s a)) -> Vector a +create = G.create +{-# INLINE create #-} + +createT :: (Traversable f, Unboxable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +createT = G.createT +{-# INLINE createT #-} + +unfoldr :: (Unboxable a) => (b -> Maybe (a, b)) -> b -> Vector a +unfoldr = G.unfoldr +{-# INLINE unfoldr #-} + +unfoldrN :: (Unboxable a) => Int -> (b -> Maybe (a, b)) -> b -> Vector a +unfoldrN = G.unfoldrN +{-# INLINE unfoldrN #-} + +unfoldrM :: (Monad m, Unboxable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +unfoldrM = G.unfoldrM +{-# INLINE unfoldrM #-} + +unfoldrNM :: (Monad m, Unboxable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +unfoldrNM = G.unfoldrNM +{-# INLINE unfoldrNM #-} + +constructN :: (Unboxable a) => Int -> (Vector a -> a) -> Vector a +constructN = G.constructN +{-# INLINE constructN #-} + +constructrN :: (Unboxable a) => Int -> (Vector a -> a) -> Vector a +constructrN = G.constructrN +{-# INLINE constructrN #-} + +enumFromN :: (Num a, Unboxable a) => a -> Int -> Vector a +enumFromN = G.enumFromN +{-# INLINE enumFromN #-} + +enumFromStepN :: (Num a, Unboxable a) => a -> a -> Int -> Vector a +enumFromStepN = G.enumFromStepN +{-# INLINE enumFromStepN #-} + +enumFromTo :: (Enum a, Unboxable a) => a -> a -> Vector a +enumFromTo = G.enumFromTo +{-# INLINE enumFromTo #-} + +enumFromThenTo :: (Enum a, Unboxable a) => a -> a -> a -> Vector a +enumFromThenTo = G.enumFromThenTo +{-# INLINE enumFromThenTo #-} + +cons :: (Unboxable a) => a -> Vector a -> Vector a +cons = G.cons +{-# INLINE cons #-} + +snoc :: (Unboxable a) => Vector a -> a -> Vector a +snoc = G.snoc +{-# INLINE snoc #-} + +(++) :: (Unboxable a) => Vector a -> Vector a -> Vector a +(++) = (G.++) +{-# INLINE (++) #-} + +concat :: (Unboxable a) => [Vector a] -> Vector a +concat = G.concat +{-# INLINE concat #-} + +force :: (Unboxable a) => Vector a -> Vector a +force = G.force +{-# INLINE force #-} + +(//) :: (Unboxable a) => Vector a -> [(Int, a)] -> Vector a +(//) = (G.//) +{-# INLINE (//) #-} + +update :: (Unboxable a) => Vector a -> Vector (Int, a) -> Vector a +update = G.update +{-# INLINE update #-} + +update_ :: (Unboxable a) => Vector a -> Vector Int -> Vector a -> Vector a +update_ = G.update_ +{-# INLINE update_ #-} + +unsafeUpd :: (Unboxable a) => Vector a -> [(Int, a)] -> Vector a +unsafeUpd = G.unsafeUpd +{-# INLINE unsafeUpd #-} + +unsafeUpdate :: (Unboxable a) => Vector a -> Vector (Int, a) -> Vector a +unsafeUpdate = G.unsafeUpdate +{-# INLINE unsafeUpdate #-} + +unsafeUpdate_ :: (Unboxable a) => Vector a -> Vector Int -> Vector a -> Vector a +unsafeUpdate_ = G.unsafeUpdate_ +{-# INLINE unsafeUpdate_ #-} + +accum :: (Unboxable a) => (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a +accum = G.accum +{-# INLINE accum #-} + +accumulate :: (Unboxable a, Unboxable b) => (a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a +accumulate = G.accumulate +{-# INLINE accumulate #-} + +accumulate_ :: (Unboxable a, Unboxable b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +accumulate_ = G.accumulate_ +{-# INLINE accumulate_ #-} + +unsafeAccum :: (Unboxable a) => (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a +unsafeAccum = G.unsafeAccum +{-# INLINE unsafeAccum #-} + +unsafeAccumulate :: (Unboxable a, Unboxable b) => (a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a +unsafeAccumulate = G.unsafeAccumulate +{-# INLINE unsafeAccumulate #-} + +unsafeAccumulate_ :: (Unboxable a, Unboxable b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +unsafeAccumulate_ = G.unsafeAccumulate_ +{-# INLINE unsafeAccumulate_ #-} + +reverse :: (Unboxable a) => Vector a -> Vector a +reverse = G.reverse +{-# INLINE reverse #-} + +backpermute :: (Unboxable a) => Vector a -> Vector Int -> Vector a +backpermute = G.backpermute +{-# INLINE backpermute #-} + +unsafeBackpermute :: (Unboxable a) => Vector a -> Vector Int -> Vector a +unsafeBackpermute = G.unsafeBackpermute +{-# INLINE unsafeBackpermute #-} + +modify :: (Unboxable a) => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +modify = G.modify +{-# INLINE modify #-} + +indexed :: (Unboxable a) => Vector a -> Vector (Int, a) +indexed = G.indexed +{-# INLINE indexed #-} + +map :: (Unboxable a, Unboxable b) => (a -> b) -> Vector a -> Vector b +map = G.map +{-# INLINE map #-} + +imap :: (Unboxable a, Unboxable b) => (Int -> a -> b) -> Vector a -> Vector b +imap = G.imap +{-# INLINE imap #-} + +concatMap :: (Unboxable a, Unboxable b) => (a -> Vector b) -> Vector a -> Vector b +concatMap = G.concatMap +{-# INLINE concatMap #-} + +mapM :: (Monad m, Unboxable a, Unboxable b) => (a -> m b) -> Vector a -> m (Vector b) +mapM = G.mapM +{-# INLINE mapM #-} + +imapM :: (Monad m, Unboxable a, Unboxable b) => (Int -> a -> m b) -> Vector a -> m (Vector b) +imapM = G.imapM +{-# INLINE imapM #-} + +mapM_ :: (Monad m, Unboxable a) => (a -> m b) -> Vector a -> m () +mapM_ = G.mapM_ +{-# INLINE mapM_ #-} + +imapM_ :: (Monad m, Unboxable a) => (Int -> a -> m b) -> Vector a -> m () +imapM_ = G.imapM_ +{-# INLINE imapM_ #-} + +forM :: (Monad m, Unboxable a, Unboxable b) => Vector a -> (a -> m b) -> m (Vector b) +forM = G.forM +{-# INLINE forM #-} + +forM_ :: (Monad m, Unboxable a) => Vector a -> (a -> m b) -> m () +forM_ = G.forM_ +{-# INLINE forM_ #-} + +zipWith :: (Unboxable a, Unboxable b, Unboxable c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c +zipWith = G.zipWith +{-# INLINE zipWith #-} + +zipWith3 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +zipWith3 = G.zipWith3 +{-# INLINE zipWith3 #-} + +zipWith4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +zipWith4 = G.zipWith4 +{-# INLINE zipWith4 #-} + +zipWith5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f +zipWith5 = G.zipWith5 +{-# INLINE zipWith5 #-} + +zipWith6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f, Unboxable g) => (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g +zipWith6 = G.zipWith6 +{-# INLINE zipWith6 #-} + +izipWith :: (Unboxable a, Unboxable b, Unboxable c) => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +izipWith = G.izipWith +{-# INLINE izipWith #-} + +izipWith3 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +izipWith3 = G.izipWith3 +{-# INLINE izipWith3 #-} + +izipWith4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +izipWith4 = G.izipWith4 +{-# INLINE izipWith4 #-} + +izipWith5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f +izipWith5 = G.izipWith5 +{-# INLINE izipWith5 #-} + +izipWith6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f, Unboxable g) => (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g +izipWith6 = G.izipWith6 +{-# INLINE izipWith6 #-} + +zip :: (Unboxable a, Unboxable b) => Vector a -> Vector b -> Vector (a, b) +zip = G.zip +{-# INLINE zip #-} + +zip3 :: (Unboxable a, Unboxable b, Unboxable c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c) +zip3 = G.zip3 +{-# INLINE zip3 #-} + +zip4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d) +zip4 = G.zip4 +{-# INLINE zip4 #-} + +zip5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e) +zip5 = G.zip5 +{-# INLINE zip5 #-} + +zip6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f) +zip6 = G.zip6 +{-# INLINE zip6 #-} + +zipWithM :: (Monad m, Unboxable a, Unboxable b, Unboxable c) => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +zipWithM = G.zipWithM +{-# INLINE zipWithM #-} + +izipWithM :: (Monad m, Unboxable a, Unboxable b, Unboxable c) => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +izipWithM = G.izipWithM +{-# INLINE izipWithM #-} + +zipWithM_ :: (Monad m, Unboxable a, Unboxable b) => (a -> b -> m c) -> Vector a -> Vector b -> m () +zipWithM_ = G.zipWithM_ +{-# INLINE zipWithM_ #-} + +izipWithM_ :: (Monad m, Unboxable a, Unboxable b) => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +izipWithM_ = G.izipWithM_ +{-# INLINE izipWithM_ #-} + +unzip :: (Unboxable a, Unboxable b) => Vector (a, b) -> (Vector a, Vector b) +unzip = G.unzip +{-# INLINE unzip #-} + +unzip3 :: (Unboxable a, Unboxable b, Unboxable c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) +unzip3 = G.unzip3 +{-# INLINE unzip3 #-} + +unzip4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) +unzip4 = G.unzip4 +{-# INLINE unzip4 #-} + +unzip5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => Vector (a, b, c, d, e) -> (Vector a, Vector b, Vector c, Vector d, Vector e) +unzip5 = G.unzip5 +{-# INLINE unzip5 #-} + +unzip6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => Vector (a, b, c, d, e, f) -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) +unzip6 = G.unzip6 +{-# INLINE unzip6 #-} + +filter :: (Unboxable a) => (a -> Bool) -> Vector a -> Vector a +filter = G.filter +{-# INLINE filter #-} + +ifilter :: (Unboxable a) => (Int -> a -> Bool) -> Vector a -> Vector a +ifilter = G.ifilter +{-# INLINE ifilter #-} + +uniq :: (Eq a, Unboxable a) => Vector a -> Vector a +uniq = G.uniq +{-# INLINE uniq #-} + +mapMaybe :: (Unboxable a, Unboxable b) => (a -> Maybe b) -> Vector a -> Vector b +mapMaybe = G.mapMaybe +{-# INLINE mapMaybe #-} + +imapMaybe :: (Unboxable a, Unboxable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +imapMaybe = G.imapMaybe +{-# INLINE imapMaybe #-} + +filterM :: (Monad m, Unboxable a) => (a -> m Bool) -> Vector a -> m (Vector a) +filterM = G.filterM +{-# INLINE filterM #-} + +takeWhile :: (Unboxable a) => (a -> Bool) -> Vector a -> Vector a +takeWhile = G.takeWhile +{-# INLINE takeWhile #-} + +dropWhile :: (Unboxable a) => (a -> Bool) -> Vector a -> Vector a +dropWhile = G.dropWhile +{-# INLINE dropWhile #-} + +partition :: (Unboxable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) +partition = G.partition +{-# INLINE partition #-} + +unstablePartition :: (Unboxable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) +unstablePartition = G.unstablePartition +{-# INLINE unstablePartition #-} + +span :: (Unboxable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) +span = G.span +{-# INLINE span #-} + +break :: (Unboxable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) +break = G.break +{-# INLINE break #-} + +elem :: (Eq a, Unboxable a) => a -> Vector a -> Bool +elem = G.elem +{-# INLINE elem #-} + +notElem :: (Eq a, Unboxable a) => a -> Vector a -> Bool +notElem = G.notElem +{-# INLINE notElem #-} + +find :: (Unboxable a) => (a -> Bool) -> Vector a -> Maybe a +find = G.find +{-# INLINE find #-} + +findIndex :: (Unboxable a) => (a -> Bool) -> Vector a -> Maybe Int +findIndex = G.findIndex +{-# INLINE findIndex #-} + +findIndices :: (Unboxable a) => (a -> Bool) -> Vector a -> Vector Int +findIndices = G.findIndices +{-# INLINE findIndices #-} + +elemIndex :: (Eq a, Unboxable a) => a -> Vector a -> Maybe Int +elemIndex = G.elemIndex +{-# INLINE elemIndex #-} + +elemIndices :: (Eq a, Unboxable a) => a -> Vector a -> Vector Int +elemIndices = G.elemIndices +{-# INLINE elemIndices #-} + +foldl :: (Unboxable b) => (a -> b -> a) -> a -> Vector b -> a +foldl = G.foldl +{-# INLINE foldl #-} + +foldl1 :: (Unboxable a) => (a -> a -> a) -> Vector a -> a +foldl1 = G.foldl1 +{-# INLINE foldl1 #-} + +foldl' :: (Unboxable b) => (a -> b -> a) -> a -> Vector b -> a +foldl' = G.foldl' +{-# INLINE foldl' #-} + +foldl1' :: (Unboxable a) => (a -> a -> a) -> Vector a -> a +foldl1' = G.foldl1' +{-# INLINE foldl1' #-} + +foldr :: (Unboxable a) => (a -> b -> b) -> b -> Vector a -> b +foldr = G.foldr +{-# INLINE foldr #-} + +foldr1 :: (Unboxable a) => (a -> a -> a) -> Vector a -> a +foldr1 = G.foldr1 +{-# INLINE foldr1 #-} + +foldr' :: (Unboxable a) => (a -> b -> b) -> b -> Vector a -> b +foldr' = G.foldr' +{-# INLINE foldr' #-} + +foldr1' :: (Unboxable a) => (a -> a -> a) -> Vector a -> a +foldr1' = G.foldr1' +{-# INLINE foldr1' #-} + +ifoldl :: (Unboxable b) => (a -> Int -> b -> a) -> a -> Vector b -> a +ifoldl = G.ifoldl +{-# INLINE ifoldl #-} + +ifoldl' :: (Unboxable b) => (a -> Int -> b -> a) -> a -> Vector b -> a +ifoldl' = G.ifoldl' +{-# INLINE ifoldl' #-} + +ifoldr :: (Unboxable a) => (Int -> a -> b -> b) -> b -> Vector a -> b +ifoldr = G.ifoldr +{-# INLINE ifoldr #-} + +ifoldr' :: (Unboxable a) => (Int -> a -> b -> b) -> b -> Vector a -> b +ifoldr' = G.ifoldr' +{-# INLINE ifoldr' #-} + +all :: (Unboxable a) => (a -> Bool) -> Vector a -> Bool +all = G.all +{-# INLINE all #-} + +any :: (Unboxable a) => (a -> Bool) -> Vector a -> Bool +any = G.any +{-# INLINE any #-} + +and :: Vector Bool -> Bool +and = G.and +{-# INLINE and #-} + +or :: Vector Bool -> Bool +or = G.or +{-# INLINE or #-} + +sum :: (Num a, Unboxable a) => Vector a -> a +sum = G.sum +{-# INLINE sum #-} + +product :: (Num a, Unboxable a) => Vector a -> a +product = G.product +{-# INLINE product #-} + +maximum :: (Ord a, Unboxable a) => Vector a -> a +maximum = G.maximum +{-# INLINE maximum #-} + +maximumBy :: (Unboxable a) => (a -> a -> Ordering) -> Vector a -> a +maximumBy = G.maximumBy +{-# INLINE maximumBy #-} + +minimum :: (Ord a, Unboxable a) => Vector a -> a +minimum = G.minimum +{-# INLINE minimum #-} + +minimumBy :: (Unboxable a) => (a -> a -> Ordering) -> Vector a -> a +minimumBy = G.minimumBy +{-# INLINE minimumBy #-} + +minIndex :: (Ord a, Unboxable a) => Vector a -> Int +minIndex = G.minIndex +{-# INLINE minIndex #-} + +minIndexBy :: (Unboxable a) => (a -> a -> Ordering) -> Vector a -> Int +minIndexBy = G.minIndexBy +{-# INLINE minIndexBy #-} + +maxIndex :: (Ord a, Unboxable a) => Vector a -> Int +maxIndex = G.maxIndex +{-# INLINE maxIndex #-} + +maxIndexBy :: (Unboxable a) => (a -> a -> Ordering) -> Vector a -> Int +maxIndexBy = G.maxIndexBy +{-# INLINE maxIndexBy #-} + +foldM :: (Monad m, Unboxable b) => (a -> b -> m a) -> a -> Vector b -> m a +foldM = G.foldM +{-# INLINE foldM #-} + +ifoldM :: (Monad m, Unboxable b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +ifoldM = G.ifoldM +{-# INLINE ifoldM #-} + +foldM' :: (Monad m, Unboxable b) => (a -> b -> m a) -> a -> Vector b -> m a +foldM' = G.foldM' +{-# INLINE foldM' #-} + +ifoldM' :: (Monad m, Unboxable b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +ifoldM' = G.ifoldM' +{-# INLINE ifoldM' #-} + +fold1M :: (Monad m, Unboxable a) => (a -> a -> m a) -> Vector a -> m a +fold1M = G.fold1M +{-# INLINE fold1M #-} + +fold1M' :: (Monad m, Unboxable a) => (a -> a -> m a) -> Vector a -> m a +fold1M' = G.fold1M' +{-# INLINE fold1M' #-} + +foldM_ :: (Monad m, Unboxable b) => (a -> b -> m a) -> a -> Vector b -> m () +foldM_ = G.foldM_ +{-# INLINE foldM_ #-} + +ifoldM_ :: (Monad m, Unboxable b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () +ifoldM_ = G.ifoldM_ +{-# INLINE ifoldM_ #-} + +foldM'_ :: (Monad m, Unboxable b) => (a -> b -> m a) -> a -> Vector b -> m () +foldM'_ = G.foldM'_ +{-# INLINE foldM'_ #-} + +ifoldM'_ :: (Monad m, Unboxable b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () +ifoldM'_ = G.ifoldM'_ +{-# INLINE ifoldM'_ #-} + +fold1M_ :: (Monad m, Unboxable a) => (a -> a -> m a) -> Vector a -> m () +fold1M_ = G.fold1M_ +{-# INLINE fold1M_ #-} + +fold1M'_ :: (Monad m, Unboxable a) => (a -> a -> m a) -> Vector a -> m () +fold1M'_ = G.fold1M'_ +{-# INLINE fold1M'_ #-} + +prescanl :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +prescanl = G.prescanl +{-# INLINE prescanl #-} + +prescanl' :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +prescanl' = G.prescanl' +{-# INLINE prescanl' #-} + +postscanl :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +postscanl = G.postscanl +{-# INLINE postscanl #-} + +postscanl' :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +postscanl' = G.postscanl' +{-# INLINE postscanl' #-} + +scanl :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +scanl = G.scanl +{-# INLINE scanl #-} + +scanl' :: (Unboxable a, Unboxable b) => (a -> b -> a) -> a -> Vector b -> Vector a +scanl' = G.scanl' +{-# INLINE scanl' #-} + +scanl1 :: (Unboxable a) => (a -> a -> a) -> Vector a -> Vector a +scanl1 = G.scanl1 +{-# INLINE scanl1 #-} + +scanl1' :: (Unboxable a) => (a -> a -> a) -> Vector a -> Vector a +scanl1' = G.scanl1' +{-# INLINE scanl1' #-} + +iscanl :: (Unboxable a, Unboxable b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +iscanl = G.iscanl +{-# INLINE iscanl #-} + +iscanl' :: (Unboxable a, Unboxable b) => (Int -> a -> b -> a) -> a -> Vector b -> Vector a +iscanl' = G.iscanl' +{-# INLINE iscanl' #-} + +prescanr :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +prescanr = G.prescanr +{-# INLINE prescanr #-} + +prescanr' :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +prescanr' = G.prescanr' +{-# INLINE prescanr' #-} + +postscanr :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +postscanr = G.postscanr +{-# INLINE postscanr #-} + +postscanr' :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +postscanr' = G.postscanr' +{-# INLINE postscanr' #-} + +scanr :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +scanr = G.scanr +{-# INLINE scanr #-} + +scanr' :: (Unboxable a, Unboxable b) => (a -> b -> b) -> b -> Vector a -> Vector b +scanr' = G.scanr' +{-# INLINE scanr' #-} + +scanr1 :: (Unboxable a) => (a -> a -> a) -> Vector a -> Vector a +scanr1 = G.scanr1 +{-# INLINE scanr1 #-} + +scanr1' :: (Unboxable a) => (a -> a -> a) -> Vector a -> Vector a +scanr1' = G.scanr1' +{-# INLINE scanr1' #-} + +iscanr :: (Unboxable a, Unboxable b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +iscanr = G.iscanr +{-# INLINE iscanr #-} + +iscanr' :: (Unboxable a, Unboxable b) => (Int -> a -> b -> b) -> b -> Vector a -> Vector b +iscanr' = G.iscanr' +{-# INLINE iscanr' #-} + +toList :: (Unboxable a) => Vector a -> [a] +toList = G.toList +{-# INLINE toList #-} + +fromList :: (Unboxable a) => [a] -> Vector a +fromList = G.fromList +{-# INLINE fromList #-} + +fromListN :: (Unboxable a) => Int -> [a] -> Vector a +fromListN = G.fromListN +{-# INLINE fromListN #-} + +freeze :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> m (Vector a) +freeze = G.freeze +{-# INLINE freeze #-} + +thaw :: (PrimMonad m, Unboxable a) => Vector a -> m (MVector (PrimState m) a) +thaw = G.thaw +{-# INLINE thaw #-} + +copy :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Vector a -> m () +copy = G.copy +{-# INLINE copy #-} + +unsafeFreeze :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> m (Vector a) +unsafeFreeze = G.unsafeFreeze +{-# INLINE unsafeFreeze #-} + +unsafeThaw :: (PrimMonad m, Unboxable a) => Vector a -> m (MVector (PrimState m) a) +unsafeThaw = G.unsafeThaw +{-# INLINE unsafeThaw #-} + +unsafeCopy :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Vector a -> m () +unsafeCopy = G.unsafeCopy +{-# INLINE unsafeCopy #-} diff --git a/src/Data/Vector/Unboxing/Internal.hs b/src/Data/Vector/Unboxing/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxing/Internal.hs @@ -0,0 +1,521 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK hide #-} +module Data.Vector.Unboxing.Internal + (Unboxable(Rep) + ,Vector(UnboxingVector) + ,MVector(UnboxingMVector) + ,Generics(..) + ,coerceVector + ,liftCoercion + ,vectorCoercion + ,toUnboxedVector + ,fromUnboxedVector + ,coercionWithUnboxedVector + ,toUnboxedMVector + ,fromUnboxedMVector + ,coercionWithUnboxedMVector + ) where +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as GM +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Unboxed.Mutable as UM +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Coerce +import Data.Type.Coercion +import Data.Int +import Data.Word +import qualified GHC.Generics +import Data.Type.Bool +import qualified Data.Complex +import qualified Data.Functor.Identity +import qualified Data.Functor.Const +import qualified Data.Ord +import qualified Data.Semigroup +import qualified Data.Monoid +import qualified Data.MonoTraversable -- from mono-traversable +import qualified Data.Sequences -- from mono-traversable +import GHC.Exts (IsList(..)) +import Control.DeepSeq (NFData(..)) +import Text.Read (Read(..),readListPrecDefault) +import GHC.TypeLits (TypeError,ErrorMessage(Text)) + +newtype Vector a = UnboxingVector (U.Vector (Rep a)) +newtype MVector s a = UnboxingMVector (UM.MVector s (Rep a)) + +type instance G.Mutable Vector = MVector + +-- | Types that can be stored in unboxed vectors ('Vector' and 'MVector'). +-- +-- You can define instances of this class like: +-- +-- > newtype Foo = Foo Int +-- > instance Unboxable Foo where +-- > type Rep Foo = Int +-- +-- The type specified by 'Rep' needs to be an instance of 'U.Unbox', +-- and coercion must be possible between the two types. +-- +-- Instances can also be derived with @GeneralizedNewtypeDeriving@. +-- GND always works if the base type is an instance of 'Unboxable'. +-- +-- If you want to have non-trivial correspondence between the type and the representation, +-- use 'Generics' wrapper with @DerivingVia@. +-- +-- Note that @UndecidableInstances@ is needed if you use GND or @DerivingVia@ to derive instances. +class U.Unbox (Rep a) => Unboxable a where + -- | The underlying type of @a@. Must be an instance of 'U.Unbox'. + type Rep a + + -- Hidden members: + + -- Used by 'coerceVector' + type CoercibleRep a + type CoercibleRep a = Rep a + + -- True if both 'unboxingFrom and 'unboxingTo' are just 'coerce' + type IsTrivial a :: Bool + type IsTrivial a = 'True + -- TODO: Use ConstraintKinds? + + unboxingFrom :: a -> Rep a + default unboxingFrom :: Coercible a (Rep a) => a -> Rep a + unboxingFrom = coerce + {-# INLINE unboxingFrom #-} + + unboxingTo :: Rep a -> a + default unboxingTo :: Coercible a (Rep a) => Rep a -> a + unboxingTo = coerce + {-# INLINE unboxingTo #-} + +coerceVector :: (Coercible a b, Unboxable a, Unboxable b, CoercibleRep a ~ CoercibleRep b, Rep a ~ Rep b) => Vector a -> Vector b +coerceVector = coerce +{-# INLINE coerceVector #-} + +liftCoercion :: (Unboxable a, Unboxable b, CoercibleRep a ~ CoercibleRep b, Rep a ~ Rep b) => Coercion a b -> Coercion (Vector a) (Vector b) +liftCoercion Coercion = Coercion +{-# INLINE liftCoercion #-} + +vectorCoercion :: (Coercible a b, Unboxable a, Unboxable b, CoercibleRep a ~ CoercibleRep b, Rep a ~ Rep b) => Coercion (Vector a) (Vector b) +vectorCoercion = Coercion +{-# INLINE vectorCoercion #-} + +toUnboxedVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => Vector a -> U.Vector a +toUnboxedVector = coerce +{-# INLINE toUnboxedVector #-} + +fromUnboxedVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => U.Vector a -> Vector a +fromUnboxedVector = coerce +{-# INLINE fromUnboxedVector #-} + +toUnboxedMVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => MVector s a -> UM.MVector s a +toUnboxedMVector = coerce +{-# INLINE toUnboxedMVector #-} + +fromUnboxedMVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => UM.MVector s a -> MVector s a +fromUnboxedMVector = coerce +{-# INLINE fromUnboxedMVector #-} + +coercionWithUnboxedVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => Coercion (Vector a) (U.Vector a) +coercionWithUnboxedVector = Coercion +{-# INLINE coercionWithUnboxedVector #-} + +coercionWithUnboxedMVector :: (Unboxable a, Rep a ~ a, IsTrivial a ~ 'True) => Coercion (MVector s a) (U.MVector s a) +coercionWithUnboxedMVector = Coercion +{-# INLINE coercionWithUnboxedMVector #-} + +----- + +-- Generics + +-- | A newtype wrapper to be used with @DerivingVia@. +-- +-- Usage: +-- +-- > data Bar = Bar !Int !Int +-- > deriving Generic +-- > deriving Unboxable via Generics Bar +newtype Generics a = Generics a + +instance (GHC.Generics.Generic a, Unboxable (Rep' (GHC.Generics.Rep a)), Unboxable' (GHC.Generics.Rep a)) => Unboxable (Generics a) where + type Rep (Generics a) = Rep (Rep' (GHC.Generics.Rep a)) + type CoercibleRep (Generics a) = a + type IsTrivial (Generics a) = 'False + unboxingFrom (Generics x) = unboxingFrom (from' (GHC.Generics.from x)) + {-# INLINE unboxingFrom #-} + unboxingTo y = Generics (GHC.Generics.to (to' (unboxingTo y))) + {-# INLINE unboxingTo #-} + +class Unboxable' f where + type Rep' f + from' :: f x -> Rep' f + to' :: Rep' f -> f x +instance Unboxable' GHC.Generics.U1 where + type Rep' GHC.Generics.U1 = () + from' _ = () + to' _ = GHC.Generics.U1 + {-# INLINE from' #-} + {-# INLINE to' #-} +instance Unboxable c => Unboxable' (GHC.Generics.K1 i c) where + type Rep' (GHC.Generics.K1 i c) = Rep c + from' = {- from . GHC.Generics.unK1 -} coerce (unboxingFrom :: c -> Rep c) + to' = {- GHC.Generics.K1 . to -} coerce (unboxingTo :: Rep c -> c) + {-# INLINE from' #-} + {-# INLINE to' #-} +instance Unboxable' f => Unboxable' (GHC.Generics.M1 i c f) where + type Rep' (GHC.Generics.M1 i c f) = Rep' f + from' = from' . GHC.Generics.unM1 + to' = GHC.Generics.M1 . to' + {-# INLINE from' #-} + {-# INLINE to' #-} +instance (Unboxable' f, Unboxable' g) => Unboxable' (f GHC.Generics.:*: g) where + type Rep' (f GHC.Generics.:*: g) = (Rep' f, Rep' g) + from' (x GHC.Generics.:*: y) = (from' x, from' y) + to' (x, y) = (to' x GHC.Generics.:*: to' y) + {-# INLINE from' #-} + {-# INLINE to' #-} +instance Unboxable' (f GHC.Generics.:+: g) where + type Rep' (f GHC.Generics.:+: g) = TypeError ('Text "Cannot derive Unboxable instance for a sum type.") + from' = undefined + to' = undefined + +----- + +-- Instances + +instance (Unboxable a) => IsList (Vector a) where + type Item (Vector a) = a + fromList = G.fromList + fromListN = G.fromListN + toList = G.toList + {-# INLINE fromList #-} + {-# INLINE fromListN #-} + {-# INLINE toList #-} + +instance (Eq a, Unboxable a) => Eq (Vector a) where + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + {-# INLINE (==) #-} + {-# INLINE (/=) #-} + +instance (Ord a, Unboxable a) => Ord (Vector a) where + compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys) + {-# INLINE compare #-} + +instance (Show a, Unboxable a) => Show (Vector a) where + showsPrec = G.showsPrec + {-# INLINE showsPrec #-} + +instance (Read a, Unboxable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + {-# INLINE readPrec #-} + {-# INLINE readListPrec #-} + +instance (Unboxable a) => Semigroup (Vector a) where + (<>) = (G.++) + sconcat = G.concatNE + {-# INLINE (<>) #-} + {-# INLINE sconcat #-} + +instance (Unboxable a) => Monoid (Vector a) where + mempty = G.empty + mappend = (<>) + mconcat = G.concat + {-# INLINE mempty #-} + {-# INLINE mappend #-} + {-# INLINE mconcat #-} + +instance NFData (Vector a) where + rnf !_ = () -- the content is unboxed + +instance (Unboxable a) => GM.MVector MVector a where + basicLength (UnboxingMVector mv) = GM.basicLength mv + basicUnsafeSlice i l (UnboxingMVector mv) = UnboxingMVector (GM.basicUnsafeSlice i l mv) + basicOverlaps (UnboxingMVector mv) (UnboxingMVector mv') = GM.basicOverlaps mv mv' + basicUnsafeNew l = UnboxingMVector <$> GM.basicUnsafeNew l + basicInitialize (UnboxingMVector mv) = GM.basicInitialize mv + basicUnsafeReplicate i x = UnboxingMVector <$> GM.basicUnsafeReplicate i (unboxingFrom x) + basicUnsafeRead (UnboxingMVector mv) i = unboxingTo <$> GM.basicUnsafeRead mv i + basicUnsafeWrite (UnboxingMVector mv) i x = GM.basicUnsafeWrite mv i (unboxingFrom x) + basicClear (UnboxingMVector mv) = GM.basicClear mv + basicSet (UnboxingMVector mv) x = GM.basicSet mv (unboxingFrom x) + basicUnsafeCopy (UnboxingMVector mv) (UnboxingMVector mv') = GM.basicUnsafeCopy mv mv' + basicUnsafeMove (UnboxingMVector mv) (UnboxingMVector mv') = GM.basicUnsafeMove mv mv' + basicUnsafeGrow (UnboxingMVector mv) n = UnboxingMVector <$> GM.basicUnsafeGrow mv n + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeMove #-} + {-# INLINE basicUnsafeGrow #-} + +instance (Unboxable a) => G.Vector Vector a where + basicUnsafeFreeze (UnboxingMVector mv) = UnboxingVector <$> G.basicUnsafeFreeze mv + basicUnsafeThaw (UnboxingVector v) = UnboxingMVector <$> G.basicUnsafeThaw v + basicLength (UnboxingVector v) = G.basicLength v + basicUnsafeSlice i l (UnboxingVector v) = UnboxingVector (G.basicUnsafeSlice i l v) + basicUnsafeIndexM (UnboxingVector v) i = unboxingTo <$> G.basicUnsafeIndexM v i + basicUnsafeCopy (UnboxingMVector mv) (UnboxingVector v) = G.basicUnsafeCopy mv v + elemseq (UnboxingVector v) x y = G.elemseq v (unboxingFrom x) y -- ? + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE elemseq #-} + +----- + +-- Classes from mono-traversable + +type instance Data.MonoTraversable.Element (Vector a) = a + +instance (Unboxable a) => Data.MonoTraversable.MonoFunctor (Vector a) where + omap = G.map + {-# INLINE omap #-} + +instance (Unboxable a) => Data.MonoTraversable.MonoFoldable (Vector a) where + ofoldMap f = G.foldr (mappend . f) mempty + ofoldr = G.foldr + ofoldl' = G.foldl' + otoList = G.toList + oall = G.all + oany = G.any + onull = G.null + olength = G.length + olength64 = fromIntegral . G.length + -- ocompareLength : use default + -- otraverse_ : use default + -- ofor_ : use default + -- omapM_ : use default (G.mapM_ requires a Monad, unfortunately) + -- oforM_ : use default (G.forM_ requires a Monad, unfortunately) + ofoldlM = G.foldM + -- ofoldMap1Ex : use default + ofoldr1Ex = G.foldr1 + ofoldl1Ex' = G.foldl1' + headEx = G.head + lastEx = G.last + unsafeHead = G.unsafeHead + unsafeLast = G.unsafeLast + maximumByEx = G.maximumBy + minimumByEx = G.minimumBy + oelem = G.elem + onotElem = G.notElem + {-# INLINE ofoldMap #-} + {-# INLINE ofoldr #-} + {-# INLINE ofoldl' #-} + {-# INLINE otoList #-} + {-# INLINE oall #-} + {-# INLINE oany #-} + {-# INLINE onull #-} + {-# INLINE olength #-} + {-# INLINE olength64 #-} + {-# INLINE ofoldlM #-} + {-# INLINE ofoldr1Ex #-} + {-# INLINE ofoldl1Ex' #-} + {-# INLINE headEx #-} + {-# INLINE lastEx #-} + {-# INLINE unsafeHead #-} + {-# INLINE unsafeLast #-} + {-# INLINE maximumByEx #-} + {-# INLINE minimumByEx #-} + {-# INLINE oelem #-} + {-# INLINE onotElem #-} + +instance (Unboxable a) => Data.MonoTraversable.MonoTraversable (Vector a) where + otraverse f v = let !n = G.length v + in G.fromListN n <$> traverse f (G.toList v) + omapM = Data.MonoTraversable.otraverse + {-# INLINE otraverse #-} + {-# INLINE omapM #-} + +instance (Unboxable a) => Data.MonoTraversable.MonoPointed (Vector a) where + opoint = G.singleton + {-# INLINE opoint #-} + +instance (Unboxable a) => Data.MonoTraversable.GrowingAppend (Vector a) + +instance (Unboxable a) => Data.Sequences.SemiSequence (Vector a) where + type Index (Vector a) = Int + intersperse = Data.Sequences.defaultIntersperse + reverse = G.reverse + find = G.find + sortBy = Data.Sequences.vectorSortBy + cons = G.cons + snoc = G.snoc + {-# INLINE intersperse #-} + {-# INLINE reverse #-} + {-# INLINE find #-} + {-# INLINE sortBy #-} + {-# INLINE cons #-} + {-# INLINE snoc #-} + +instance (Unboxable a) => Data.Sequences.IsSequence (Vector a) where + fromList = G.fromList + lengthIndex = G.length + break = G.break + span = G.span + dropWhile = G.dropWhile + takeWhile = G.takeWhile + splitAt = G.splitAt + -- unsafeSplitAt : use default + take = G.take + unsafeTake = G.unsafeTake + drop = G.drop + unsafeDrop = G.unsafeDrop + -- dropEnd : use default + partition = G.partition + uncons v | G.null v = Nothing + | otherwise = Just (G.head v, G.tail v) + unsnoc v | G.null v = Nothing + | otherwise = Just (G.init v, G.last v) + filter = G.filter + filterM = G.filterM + replicate = G.replicate + replicateM = G.replicateM + -- groupBy : use default + -- groupAllOn : use default + -- subsequences : use default + -- permutations : use default + tailEx = G.tail + -- tailMay : use default + initEx = G.init + -- initMay : use default + unsafeTail = G.unsafeTail + unsafeInit = G.unsafeInit + index = (G.!?) + indexEx = (G.!) + unsafeIndex = G.unsafeIndex + -- splitWhen : use default + {-# INLINE fromList #-} + {-# INLINE lengthIndex #-} + {-# INLINE break #-} + {-# INLINE span #-} + {-# INLINE dropWhile #-} + {-# INLINE takeWhile #-} + {-# INLINE splitAt #-} + {-# INLINE take #-} + {-# INLINE unsafeTake #-} + {-# INLINE drop #-} + {-# INLINE unsafeDrop #-} + {-# INLINE partition #-} + {-# INLINE uncons #-} + {-# INLINE unsnoc #-} + {-# INLINE filter #-} + {-# INLINE filterM #-} + {-# INLINE replicate #-} + {-# INLINE replicateM #-} + {-# INLINE tailEx #-} + {-# INLINE initEx #-} + {-# INLINE unsafeTail #-} + {-# INLINE unsafeInit #-} + {-# INLINE index #-} + {-# INLINE indexEx #-} + {-# INLINE unsafeIndex #-} + +----- + +-- Unboxable instances + +instance Unboxable Bool where type Rep Bool = Bool +instance Unboxable Char where type Rep Char = Char +instance Unboxable Double where type Rep Double = Double +instance Unboxable Float where type Rep Float = Float +instance Unboxable Int where type Rep Int = Int +instance Unboxable Int8 where type Rep Int8 = Int8 +instance Unboxable Int16 where type Rep Int16 = Int16 +instance Unboxable Int32 where type Rep Int32 = Int32 +instance Unboxable Int64 where type Rep Int64 = Int64 +instance Unboxable Word where type Rep Word = Word +instance Unboxable Word8 where type Rep Word8 = Word8 +instance Unboxable Word16 where type Rep Word16 = Word16 +instance Unboxable Word32 where type Rep Word32 = Word32 +instance Unboxable Word64 where type Rep Word64 = Word64 +instance Unboxable () where type Rep () = () + +instance (Unboxable a) => Unboxable (Data.Complex.Complex a) where + type Rep (Data.Complex.Complex a) = Data.Complex.Complex (Rep a) + type CoercibleRep (Data.Complex.Complex a) = Data.Complex.Complex (CoercibleRep a) + type IsTrivial (Data.Complex.Complex a) = IsTrivial a + unboxingFrom = fmap unboxingFrom + unboxingTo = fmap unboxingTo + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +instance (Unboxable a, Unboxable b) => Unboxable (a, b) where + type Rep (a, b) = (Rep a, Rep b) + type CoercibleRep (a, b) = (CoercibleRep a, CoercibleRep b) + type IsTrivial (a, b) = IsTrivial a && IsTrivial b + unboxingFrom (a, b) = (unboxingFrom a, unboxingFrom b) + unboxingTo (a, b) = (unboxingTo a, unboxingTo b) + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +instance (Unboxable a, Unboxable b, Unboxable c) => Unboxable (a, b, c) where + type Rep (a, b, c) = (Rep a, Rep b, Rep c) + type CoercibleRep (a, b, c) = (CoercibleRep a, CoercibleRep b, CoercibleRep c) + type IsTrivial (a, b, c) = IsTrivial a && IsTrivial b && IsTrivial c + unboxingFrom (a, b, c) = (unboxingFrom a, unboxingFrom b, unboxingFrom c) + unboxingTo (a, b, c) = (unboxingTo a, unboxingTo b, unboxingTo c) + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +instance (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => Unboxable (a, b, c, d) where + type Rep (a, b, c, d) = (Rep a, Rep b, Rep c, Rep d) + type CoercibleRep (a, b, c, d) = (CoercibleRep a, CoercibleRep b, CoercibleRep c, CoercibleRep d) + type IsTrivial (a, b, c, d) = IsTrivial a && IsTrivial b && IsTrivial c && IsTrivial d + unboxingFrom (a, b, c, d) = (unboxingFrom a, unboxingFrom b, unboxingFrom c, unboxingFrom d) + unboxingTo (a, b, c, d) = (unboxingTo a, unboxingTo b, unboxingTo c, unboxingTo d) + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +instance (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => Unboxable (a, b, c, d, e) where + type Rep (a, b, c, d, e) = (Rep a, Rep b, Rep c, Rep d, Rep e) + type CoercibleRep (a, b, c, d, e) = (CoercibleRep a, CoercibleRep b, CoercibleRep c, CoercibleRep d, CoercibleRep e) + type IsTrivial (a, b, c, d, e) = IsTrivial a && IsTrivial b && IsTrivial c && IsTrivial d && IsTrivial e + unboxingFrom (a, b, c, d, e) = (unboxingFrom a, unboxingFrom b, unboxingFrom c, unboxingFrom d, unboxingFrom e) + unboxingTo (a, b, c, d, e) = (unboxingTo a, unboxingTo b, unboxingTo c, unboxingTo d, unboxingTo e) + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +instance (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => Unboxable (a, b, c, d, e, f) where + type Rep (a, b, c, d, e, f) = (Rep a, Rep b, Rep c, Rep d, Rep e, Rep f) + type CoercibleRep (a, b, c, d, e, f) = (CoercibleRep a, CoercibleRep b, CoercibleRep c, CoercibleRep d, CoercibleRep e, CoercibleRep f) + type IsTrivial (a, b, c, d, e, f) = IsTrivial a && IsTrivial b && IsTrivial c && IsTrivial d && IsTrivial e && IsTrivial f + unboxingFrom (a, b, c, d, e, f) = (unboxingFrom a, unboxingFrom b, unboxingFrom c, unboxingFrom d, unboxingFrom e, unboxingFrom f) + unboxingTo (a, b, c, d, e, f) = (unboxingTo a, unboxingTo b, unboxingTo c, unboxingTo d, unboxingTo e, unboxingTo f) + {-# INLINE unboxingFrom #-} + {-# INLINE unboxingTo #-} + +deriving instance Unboxable a => Unboxable (Data.Functor.Identity.Identity a) +deriving instance Unboxable a => Unboxable (Data.Functor.Const.Const a b) +deriving instance Unboxable a => Unboxable (Data.Semigroup.Min a) +deriving instance Unboxable a => Unboxable (Data.Semigroup.Max a) +deriving instance Unboxable a => Unboxable (Data.Semigroup.First a) +deriving instance Unboxable a => Unboxable (Data.Semigroup.Last a) +deriving instance Unboxable a => Unboxable (Data.Semigroup.WrappedMonoid a) +deriving instance Unboxable a => Unboxable (Data.Monoid.Dual a) +deriving instance Unboxable Data.Monoid.All +deriving instance Unboxable Data.Monoid.Any +deriving instance Unboxable a => Unboxable (Data.Monoid.Sum a) +deriving instance Unboxable a => Unboxable (Data.Monoid.Product a) +deriving instance Unboxable a => Unboxable (Data.Ord.Down a) diff --git a/src/Data/Vector/Unboxing/Mutable.hs b/src/Data/Vector/Unboxing/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Unboxing/Mutable.hs @@ -0,0 +1,240 @@ +module Data.Vector.Unboxing.Mutable + (MVector + ,IOVector + ,STVector + ,Unboxable(Rep) + ,Generics(..) + -- * Accessors + -- ** Length information + ,length,null + -- ** Extracting subvectors (slicing) + ,slice,init,tail,take,drop,splitAt,unsafeSlice,unsafeInit,unsafeTail + ,unsafeTake,unsafeDrop + -- ** Overlapping + ,overlaps + -- * Construction + -- ** Initialisation + ,new,unsafeNew,replicate,replicateM,clone + -- ** Growing + ,grow,unsafeGrow + -- ** Restricting memory usage + ,clear + -- * Zipping and unzipping + ,zip,zip3,zip4,zip5,zip6,unzip,unzip3,unzip4,unzip5,unzip6 + -- * Accessing individual elements + ,read,write,modify,swap,unsafeRead,unsafeWrite,unsafeModify,unsafeSwap + -- * Modifying vectors + ,nextPermutation + -- ** Filling and copying + ,set,copy,move,unsafeCopy,unsafeMove + -- * Conversions from/to other vector types + ,toUnboxedMVector + ,fromUnboxedMVector + ) where + +import Prelude (Int,Bool,Ord) +import qualified Data.Vector.Generic.Mutable as G +import qualified Data.Vector.Unboxed.Mutable as UM +import Data.Vector.Unboxing.Internal +import Control.Monad.ST +import Control.Monad.Primitive (PrimMonad,PrimState) +import Data.Coerce + +type IOVector = MVector RealWorld +type STVector s = MVector s + +length :: (Unboxable a) => MVector s a -> Int +length = G.length +{-# INLINE length #-} + +null :: (Unboxable a) => MVector s a -> Bool +null = G.null +{-# INLINE null #-} + +slice :: (Unboxable a) => Int -> Int -> MVector s a -> MVector s a +slice = G.slice +{-# INLINE slice #-} + +init :: (Unboxable a) => MVector s a -> MVector s a +init = G.init +{-# INLINE init #-} + +tail :: (Unboxable a) => MVector s a -> MVector s a +tail = G.tail +{-# INLINE tail #-} + +take :: (Unboxable a) => Int -> MVector s a -> MVector s a +take = G.take +{-# INLINE take #-} + +drop :: (Unboxable a) => Int -> MVector s a -> MVector s a +drop = G.drop +{-# INLINE drop #-} + +splitAt :: (Unboxable a) => Int -> MVector s a -> (MVector s a, MVector s a) +splitAt = G.splitAt +{-# INLINE splitAt #-} + +unsafeSlice :: (Unboxable a) => Int -> Int -> MVector s a -> MVector s a +unsafeSlice = G.unsafeSlice +{-# INLINE unsafeSlice #-} + +unsafeInit :: (Unboxable a) => MVector s a -> MVector s a +unsafeInit = G.unsafeInit +{-# INLINE unsafeInit #-} + +unsafeTail :: (Unboxable a) => MVector s a -> MVector s a +unsafeTail = G.unsafeTail +{-# INLINE unsafeTail #-} + +unsafeTake :: (Unboxable a) => Int -> MVector s a -> MVector s a +unsafeTake = G.unsafeTake +{-# INLINE unsafeTake #-} + +unsafeDrop :: (Unboxable a) => Int -> MVector s a -> MVector s a +unsafeDrop = G.unsafeDrop +{-# INLINE unsafeDrop #-} + +overlaps :: (Unboxable a) => MVector s a -> MVector s a -> Bool +overlaps = G.overlaps +{-# INLINE overlaps #-} + +new :: (PrimMonad m, Unboxable a) => Int -> m (MVector (PrimState m) a) +new = G.new +{-# INLINE new #-} + +unsafeNew :: (PrimMonad m, Unboxable a) => Int -> m (MVector (PrimState m) a) +unsafeNew = G.unsafeNew +{-# INLINE unsafeNew #-} + +replicate :: (PrimMonad m, Unboxable a) => Int -> a -> m (MVector (PrimState m) a) +replicate = G.replicate +{-# INLINE replicate #-} + +replicateM :: (PrimMonad m, Unboxable a) => Int -> m a -> m (MVector (PrimState m) a) +replicateM = G.replicateM +{-# INLINE replicateM #-} + +clone :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) +clone = G.clone +{-# INLINE clone #-} + +grow :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +grow = G.grow +{-# INLINE grow #-} + +unsafeGrow :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +unsafeGrow = G.unsafeGrow +{-# INLINE unsafeGrow #-} + +clear :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> m () +clear = G.clear +{-# INLINE clear #-} + +read :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> m a +read = G.read +{-# INLINE read #-} + +write :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> a -> m () +write = G.write +{-# INLINE write #-} + +modify :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +modify = G.modify +{-# INLINE modify #-} + +swap :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> Int -> m () +swap = G.swap +{-# INLINE swap #-} + +unsafeRead :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> m a +unsafeRead = G.unsafeRead +{-# INLINE unsafeRead #-} + +unsafeWrite :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> a -> m () +unsafeWrite = G.unsafeWrite +{-# INLINE unsafeWrite #-} + +unsafeModify :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +unsafeModify = G.unsafeModify +{-# INLINE unsafeModify #-} + +unsafeSwap :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> Int -> Int -> m () +unsafeSwap = G.unsafeSwap +{-# INLINE unsafeSwap #-} + +nextPermutation :: (PrimMonad m, Ord e, Unboxable e) => MVector (PrimState m) e -> m Bool +nextPermutation = G.nextPermutation +{-# INLINE nextPermutation #-} + +set :: (PrimMonad m, Unboxable a) => MVector (PrimState m) a -> a -> m () +set = G.set +{-# INLINE set #-} + +copy :: (PrimMonad m, Unboxable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +copy = G.copy +{-# INLINE copy #-} + +move :: (PrimMonad m, Unboxable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +move = G.move +{-# INLINE move #-} + +unsafeCopy :: (PrimMonad m, Unboxable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +unsafeCopy = G.unsafeCopy +{-# INLINE unsafeCopy #-} + +unsafeMove :: (PrimMonad m, Unboxable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +unsafeMove = G.unsafeMove +{-# INLINE unsafeMove #-} + +zip :: (Unboxable a, Unboxable b) => MVector s a -> MVector s b -> MVector s (a, b) +zip = coerce UM.zip +{-# INLINE zip #-} + +zip3 :: (Unboxable a, Unboxable b, Unboxable c) => MVector s a -> MVector s b -> MVector s c -> MVector s (a, b, c) +zip3 = coerce UM.zip3 +{-# INLINE zip3 #-} + +zip4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s (a, b, c, d) +zip4 = coerce UM.zip4 +{-# INLINE zip4 #-} + +zip5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s e -> MVector s (a, b, c, d, e) +zip5 = coerce UM.zip5 +{-# INLINE zip5 #-} + +zip6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s e -> MVector s f -> MVector s (a, b, c, d, e, f) +zip6 = coerce UM.zip6 +{-# INLINE zip6 #-} + +unzip :: (Unboxable a, Unboxable b) => MVector s (a, b) -> (MVector s a, MVector s b) +unzip = coerce UM.unzip +{-# INLINE unzip #-} + +unzip3 :: (Unboxable a, Unboxable b, Unboxable c) => MVector s (a, b, c) -> (MVector s a, MVector s b, MVector s c) +unzip3 = coerce UM.unzip3 +{-# INLINE unzip3 #-} + +unzip4 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d) => MVector s (a, b, c, d) -> (MVector s a, MVector s b, MVector s c, MVector s d) +unzip4 = coerce UM.unzip4 +{-# INLINE unzip4 #-} + +unzip5 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e) => MVector s (a, b, c, d, e) -> (MVector s a, MVector s b, MVector s c, MVector s d, MVector s e) +unzip5 = coerce UM.unzip5 +{-# INLINE unzip5 #-} + +unzip6 :: (Unboxable a, Unboxable b, Unboxable c, Unboxable d, Unboxable e, Unboxable f) => MVector s (a, b, c, d, e, f) -> (MVector s a, MVector s b, MVector s c, MVector s d, MVector s e, MVector s f) +unzip6 = coerce UM.unzip6 +{-# INLINE unzip6 #-} diff --git a/test/Foo.hs b/test/Foo.hs new file mode 100644 --- /dev/null +++ b/test/Foo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Foo + (Foo -- the constructor is not exported! + ,mkFoo + ) where +import Data.Vector.Unboxing (Unboxable(..)) +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Unboxed.Mutable as UM +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as GM +import Control.DeepSeq (NFData) +import GHC.Generics +import Data.Coerce + +newtype Foo = Foo Int deriving (Eq,Show,Generic) + +instance NFData Foo + +mkFoo :: Foo +mkFoo = Foo 42 + +-- Comparison of Data.Vector.Unboxing and Data.Vector.Unboxed: + +-- The number of lines needed to enable 'Data.Vector.Unboxing.Vector Foo' is ... + +instance Unboxable Foo where + type Rep Foo = Int -- needs TypeFamilies here + +-- ... only 2 lines! +-- Also, you can use GeneralizedNewtypeDeriving + UndecidableInstances if you want to write less. + +-- On the other hand, the number of lines needed to enable 'Data.Vector.Unboxed.Vector Foo' is ... + +newtype instance UM.MVector s Foo = MV_Foo (UM.MVector s Int) +newtype instance U.Vector Foo = V_Foo (U.Vector Int) + +instance GM.MVector UM.MVector Foo where -- needs MultiParamTypeClasses here + basicLength (MV_Foo mv) = GM.basicLength mv + basicUnsafeSlice i l (MV_Foo mv) = MV_Foo (GM.basicUnsafeSlice i l mv) + basicOverlaps (MV_Foo mv) (MV_Foo mv') = GM.basicOverlaps mv mv' + basicUnsafeNew l = MV_Foo <$> GM.basicUnsafeNew l + basicInitialize (MV_Foo mv) = GM.basicInitialize mv + basicUnsafeReplicate i x = MV_Foo <$> GM.basicUnsafeReplicate i (coerce x) + basicUnsafeRead (MV_Foo mv) i = coerce <$> GM.basicUnsafeRead mv i + basicUnsafeWrite (MV_Foo mv) i x = GM.basicUnsafeWrite mv i (coerce x) + basicClear (MV_Foo mv) = GM.basicClear mv + basicSet (MV_Foo mv) x = GM.basicSet mv (coerce x) + basicUnsafeCopy (MV_Foo mv) (MV_Foo mv') = GM.basicUnsafeCopy mv mv' + basicUnsafeMove (MV_Foo mv) (MV_Foo mv') = GM.basicUnsafeMove mv mv' + basicUnsafeGrow (MV_Foo mv) n = MV_Foo <$> GM.basicUnsafeGrow mv n + +instance G.Vector U.Vector Foo where -- needs MultiParamTypeClasses here + basicUnsafeFreeze (MV_Foo mv) = V_Foo <$> G.basicUnsafeFreeze mv + basicUnsafeThaw (V_Foo v) = MV_Foo <$> G.basicUnsafeThaw v + basicLength (V_Foo v) = G.basicLength v + basicUnsafeSlice i l (V_Foo v) = V_Foo (G.basicUnsafeSlice i l v) + basicUnsafeIndexM (V_Foo v) i = coerce <$> G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Foo mv) (V_Foo v) = G.basicUnsafeCopy mv v + elemseq (V_Foo v) x y = G.elemseq v (coerce x) y + +instance U.Unbox Foo + +-- ... enormous! +-- Unfortunately, you cannot use GeneralizedNewtypeDeriving to MVector/Vector classes. diff --git a/test/Generic.hs b/test/Generic.hs new file mode 100644 --- /dev/null +++ b/test/Generic.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE UndecidableInstances #-} +module Generic where +import Test.HUnit +import qualified Data.Vector.Unboxing as V +import GHC.Generics +import Foo (Foo,mkFoo) + +-- Deriving using Generic +data ComplexDouble = ComplexDouble { realPartD :: {-# UNPACK #-} !Double + , imagPartD :: {-# UNPACK #-} !Double + } + deriving (Eq,Show,Generic) + deriving V.Unboxable via V.Generics ComplexDouble + +testComplexDouble = TestCase $ do + let v :: V.Vector ComplexDouble + v = V.singleton (ComplexDouble 1.0 2.0) + x :: V.Vector Double + x = V.map realPartD v + assertEqual "construction" (ComplexDouble 1.0 2.0) (V.head v) + assertEqual "map" (V.singleton 1.0) x + +data Bar = Bar {-# UNPACK #-} !Foo {-# UNPACK #-} !Double + deriving (Eq,Show,Generic) + deriving V.Unboxable via V.Generics Bar + +testBar = TestCase $ do + let v :: V.Vector Bar + v = V.singleton (Bar mkFoo 3.14) + assertEqual "construction" (Bar mkFoo 3.14) (V.head v) + assertEqual "map" (V.singleton mkFoo) (V.map (\(Bar foo _) -> foo) v) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +import Prelude +import Test.HUnit +import qualified Data.Vector.Unboxing as V +import qualified Data.Vector.Unboxed +import Data.Monoid (Sum(..)) +import Data.MonoTraversable (ofold) +--- +import TestTypeErrors +import Foo (Foo,mkFoo) +import Generic + +testInt = TestCase $ do + let v = V.fromList [2,-5,42] :: V.Vector Int + w = Data.Vector.Unboxed.fromList [2,-5,42] :: Data.Vector.Unboxed.Vector Int + assertEqual "to unboxed" w (V.toUnboxedVector v) + assertEqual "from unboxed" v (V.fromUnboxedVector w) + +newtype IntMod17 = IntMod17 Int + deriving (Eq,Show) +-- deriving newtype VF.Unboxable + +instance V.Unboxable IntMod17 where + type Rep IntMod17 = Int + +instance Num IntMod17 where + IntMod17 x + IntMod17 y = IntMod17 ((x + y) `rem` 17) + IntMod17 x - IntMod17 y = IntMod17 ((x - y) `mod` 17) + IntMod17 x * IntMod17 y = IntMod17 ((x * y) `rem` 17) + negate (IntMod17 x) = IntMod17 (negate x `mod` 17) + fromInteger x = IntMod17 (fromIntegral (x `mod` 17)) + abs = undefined; signum = undefined + +testIntMod17 = TestCase $ do + let v = V.fromList [-3,-2,-1,0,1,2,3,4,5] :: V.Vector IntMod17 + assertEqual "construction" (V.fromList [14,15,16,0,1,2,3,4,5]) v + assertEqual "sum" 9 (V.sum v) -- not 60 + assertEqual "coercion" (V.fromList [14,15,16,0,1,2,3,4,5] :: V.Vector Int) (V.coerceVector v) -- this is possible because the constructor of IntMod17 is visible here + let vSum = V.coerceVector v :: V.Vector (Sum IntMod17) + assertEqual "coercion and sum" (Sum 9) (ofold vSum) + +newtype Baz = Baz Foo + deriving (Eq,Show,V.Unboxable) + +testBaz = TestCase $ do + let foo :: V.Vector Foo + foo = V.singleton mkFoo + baz :: V.Vector Baz + baz = V.singleton (Baz mkFoo) + assertEqual "construction" (Baz mkFoo) (V.head baz) + assertEqual "map 1" baz (V.map Baz foo) + assertEqual "map 2" foo (V.map (\(Baz x) -> x) baz) + assertEqual "coercion" baz (V.coerceVector foo) + +-- We can make an unboxed vector of Foo, even though we don't have 'Coercible Int Foo' in scope. +testAbstractType = TestCase $ do + let v = V.singleton mkFoo :: V.Vector Foo + assertEqual "Foo" mkFoo (V.head v) + assertEqual "coercion" mkFoo (getSum $ V.head (V.coerceVector v :: V.Vector (Sum Foo))) + +tests = TestList [TestLabel "Basic features" testIntMod17 + ,TestLabel "Conversion with Data.Vector.Unboxed" testInt + ,TestLabel "Test with abstract type" testAbstractType + ,TestLabel "Check for type errors" testTypeErrors + ,TestLabel "Test with generic 1" testComplexDouble + ,TestLabel "Test with generic 2" testBar + ,TestLabel "Test with GND" testBaz + ] + +main = runTestTT tests + diff --git a/test/TestTypeErrors.hs b/test/TestTypeErrors.hs new file mode 100644 --- /dev/null +++ b/test/TestTypeErrors.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-} +module TestTypeErrors where +import Test.HUnit +import Test.ShouldNotTypecheck +import Data.Coerce +import qualified Data.Vector.Unboxing as V +import Foo (Foo) +import GHC.Generics + +-- Since the module Foo does not export Foo's constructor, +-- it should be impossible to create a value of Foo in this module. + +-- 'intToFoo1' should not compile because the constructor of 'Foo' is not visible. +intToFoo1 :: Int -> Foo +intToFoo1 x = coerce x + +-- 'intToFoo2' should not compile because 'coerceVector' requires the constructor to be visible. +-- This one does compile if 'coerceVector' is defined as +-- > coerceVector :: ({- Coercible a b, -} Rep a ~ Rep b) => Vector a -> Vector b +intToFoo2 :: Int -> Foo +intToFoo2 x = V.head (V.coerceVector (V.singleton x)) + +-- 'intToFoo3' should not compile because the constructor of Foo is not visible. +-- This one does compile if 'Unboxable' is defined as +-- > class (U.Unbox (Rep a), Coercible a (Rep a)) => Unboxable a +intToFoo3 :: (V.Unboxable a, a ~ Foo) => Int -> a +intToFoo3 x = coerce x + +data Animal = Dog | Cat + deriving (Eq,Show,Generic) + deriving V.Unboxable via V.Generics Animal + +testTypeErrors :: Test +testTypeErrors = TestList [TestLabel "Basic test for coerce" $ TestCase $ shouldNotTypecheck (intToFoo1 0xDEAD) + ,TestLabel "Test for coerceVector" $ TestCase $ shouldNotTypecheck (intToFoo2 0xDEAD) + ,TestLabel "Test for Unboxable" $ TestCase $ shouldNotTypecheck (intToFoo3 0xDEAD) + ,TestLabel "Test generic deriving for a sum type" $ TestCase $ shouldNotTypecheck (V.singleton Dog) + ] + diff --git a/unboxing-vector.cabal b/unboxing-vector.cabal new file mode 100644 --- /dev/null +++ b/unboxing-vector.cabal @@ -0,0 +1,85 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 6f43e3e12c9aa312cf1e18e1bc60132a5cb9878c463bd2b9863a20ea6c7125cf + +name: unboxing-vector +version: 0.1.0.0 +synopsis: Newtype-friendly Unboxed Vectors +description: Please see the README on GitHub at +category: Data, Data Structures +homepage: https://github.com/minoki/unboxing-vector#readme +bug-reports: https://github.com/minoki/unboxing-vector/issues +author: ARATA Mizuki +maintainer: ARATA Mizuki +copyright: 2019 ARATA Mizuki +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/minoki/unboxing-vector + +library + exposed-modules: + Data.Vector.Unboxing + Data.Vector.Unboxing.Mutable + other-modules: + Data.Vector.Unboxing.Internal + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.9 && <5 + , deepseq + , mono-traversable + , primitive + , vector + default-language: Haskell2010 + +test-suite unboxing-vector-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Foo + Generic + TestTypeErrors + Paths_unboxing_vector + hs-source-dirs: + test + ghc-options: -Wall -Wno-missing-signatures + build-depends: + HUnit + , base >=4.9 && <5 + , deepseq + , mono-traversable + , primitive + , should-not-typecheck + , unboxing-vector + , vector + default-language: Haskell2010 + +benchmark unboxing-vector-benchmark + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Poly + Paths_unboxing_vector + hs-source-dirs: + benchmark + ghc-options: -Wall -rtsopts + build-depends: + base >=4.9 && <5 + , deepseq + , mono-traversable + , primitive + , unboxing-vector + , vector + default-language: Haskell2010