vector-0.10.0.1/0000755000000000000000000000000012035366315011423 5ustar0000000000000000vector-0.10.0.1/vector.cabal0000644000000000000000000001024212035366315013710 0ustar0000000000000000Name: vector Version: 0.10.0.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Roman Leshchinskiy Copyright: (c) Roman Leshchinskiy 2008-2012 Homepage: http://code.haskell.org/vector Bug-Reports: http://trac.haskell.org/vector Category: Data, Data Structures Synopsis: Efficient Arrays Description: . An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework . . It is structured as follows: . ["Data.Vector"] Boxed vectors of arbitrary types. . ["Data.Vector.Unboxed"] Unboxed vectors with an adaptive representation based on data type families. . ["Data.Vector.Storable"] Unboxed vectors of 'Storable' types. . ["Data.Vector.Primitive"] Unboxed vectors of primitive types as defined by the @primitive@ package. "Data.Vector.Unboxed" is more flexible at no performance cost. . ["Data.Vector.Generic"] Generic interface to the vector types. . There is also a (draft) tutorial on common uses of vector. . * . Please use the project trac to submit bug reports and feature requests. . * . Changes in version 0.10.0.1 . * Require @primitive@ to include workaround for a GHC array copying bug . Changes in version 0.10 . * @NFData@ instances . * More efficient block fills . * Safe Haskell support removed . Cabal-Version: >= 1.2.3 Build-Type: Simple Extra-Source-Files: tests/vector-tests.cabal tests/LICENSE tests/Setup.hs tests/Main.hs tests/Boilerplater.hs tests/Utilities.hs tests/Tests/Move.hs tests/Tests/Stream.hs tests/Tests/Vector.hs benchmarks/vector-benchmarks.cabal benchmarks/LICENSE benchmarks/Setup.hs benchmarks/Main.hs benchmarks/Algo/AwShCC.hs benchmarks/Algo/HybCC.hs benchmarks/Algo/Leaffix.hs benchmarks/Algo/ListRank.hs benchmarks/Algo/Quickhull.hs benchmarks/Algo/Rootfix.hs benchmarks/Algo/Spectral.hs benchmarks/Algo/Tridiag.hs benchmarks/TestData/Graph.hs benchmarks/TestData/ParenTree.hs benchmarks/TestData/Random.hs internal/GenUnboxTuple.hs internal/unbox-tuple-instances Flag BoundsChecks Description: Enable bounds checking Default: True Flag UnsafeChecks Description: Enable bounds checking in unsafe operations at the cost of a significant performance penalty Default: False Flag InternalChecks Description: Enable internal consistency checks at the cost of a significant performance penalty Default: False Library Extensions: CPP, DeriveDataTypeable Exposed-Modules: Data.Vector.Internal.Check Data.Vector.Fusion.Util Data.Vector.Fusion.Stream.Size Data.Vector.Fusion.Stream.Monadic Data.Vector.Fusion.Stream Data.Vector.Generic.Mutable Data.Vector.Generic.Base Data.Vector.Generic.New Data.Vector.Generic Data.Vector.Primitive.Mutable Data.Vector.Primitive Data.Vector.Storable.Internal Data.Vector.Storable.Mutable Data.Vector.Storable Data.Vector.Unboxed.Base Data.Vector.Unboxed.Mutable Data.Vector.Unboxed Data.Vector.Mutable Data.Vector Include-Dirs: include, internal Install-Includes: vector.h Build-Depends: base >= 4 && < 5 , primitive >= 0.5.0.1 && < 0.6 , ghc-prim , deepseq >= 1.1 && < 1.4 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing Ghc-Options: -O2 if flag(BoundsChecks) cpp-options: -DVECTOR_BOUNDS_CHECKS if flag(UnsafeChecks) cpp-options: -DVECTOR_UNSAFE_CHECKS if flag(InternalChecks) cpp-options: -DVECTOR_INTERNAL_CHECKS vector-0.10.0.1/LICENSE0000644000000000000000000000301612035366315012430 0ustar0000000000000000Copyright (c) 2008-2012, Roman Leshchinskiy 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 name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE 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 UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. vector-0.10.0.1/Setup.hs0000644000000000000000000000005712035366315013061 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.10.0.1/tests/0000755000000000000000000000000012035366315012565 5ustar0000000000000000vector-0.10.0.1/tests/Utilities.hs0000644000000000000000000001630412035366315015100 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, GADTs #-} module Utilities where import Test.QuickCheck import qualified Data.Vector as DV import qualified Data.Vector.Generic as DVG import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Unboxed as DVU import qualified Data.Vector.Fusion.Stream as S import Data.List ( sortBy ) instance Show a => Show (S.Stream a) where show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s) instance Arbitrary a => Arbitrary (DV.Vector a) where arbitrary = fmap DV.fromList arbitrary instance CoArbitrary a => CoArbitrary (DV.Vector a) where coarbitrary = coarbitrary . DV.toList instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where arbitrary = fmap DVP.fromList arbitrary instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where coarbitrary = coarbitrary . DVP.toList instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where arbitrary = fmap DVS.fromList arbitrary instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where coarbitrary = coarbitrary . DVS.toList instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where arbitrary = fmap DVU.fromList arbitrary instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where coarbitrary = coarbitrary . DVU.toList instance Arbitrary a => Arbitrary (S.Stream a) where arbitrary = fmap S.fromList arbitrary instance CoArbitrary a => CoArbitrary (S.Stream a) where coarbitrary = coarbitrary . S.toList class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where type Model a model :: a -> Model a unmodel :: Model a -> a type EqTest a equal :: a -> a -> EqTest a instance Eq a => TestData (S.Stream a) where type Model (S.Stream a) = [a] model = S.toList unmodel = S.fromList type EqTest (S.Stream a) = Property equal x y = property (x == y) instance Eq a => TestData (DV.Vector a) where type Model (DV.Vector a) = [a] model = DV.toList unmodel = DV.fromList type EqTest (DV.Vector a) = Property equal x y = property (x == y) instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where type Model (DVP.Vector a) = [a] model = DVP.toList unmodel = DVP.fromList type EqTest (DVP.Vector a) = Property equal x y = property (x == y) instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where type Model (DVS.Vector a) = [a] model = DVS.toList unmodel = DVS.fromList type EqTest (DVS.Vector a) = Property equal x y = property (x == y) instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where type Model (DVU.Vector a) = [a] model = DVU.toList unmodel = DVU.fromList type EqTest (DVU.Vector a) = Property equal x y = property (x == y) #define id_TestData(ty) \ instance TestData ty where { \ type Model ty = ty; \ model = id; \ unmodel = id; \ \ type EqTest ty = Property; \ equal x y = property (x == y) } id_TestData(()) id_TestData(Bool) id_TestData(Int) id_TestData(Float) id_TestData(Double) id_TestData(Ordering) -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well. instance (Eq a, TestData a) => TestData (Maybe a) where type Model (Maybe a) = Maybe (Model a) model = fmap model unmodel = fmap unmodel type EqTest (Maybe a) = Property equal x y = property (x == y) instance (Eq a, TestData a) => TestData [a] where type Model [a] = [Model a] model = fmap model unmodel = fmap unmodel type EqTest [a] = Property equal x y = property (x == y) instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where type Model (a,b) = (Model a, Model b) model (a,b) = (model a, model b) unmodel (a,b) = (unmodel a, unmodel b) type EqTest (a,b) = Property equal x y = property (x == y) instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where type Model (a,b,c) = (Model a, Model b, Model c) model (a,b,c) = (model a, model b, model c) unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c) type EqTest (a,b,c) = Property equal x y = property (x == y) instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where type Model (a -> b) = Model a -> Model b model f = model . f . unmodel unmodel f = unmodel . f . model type EqTest (a -> b) = a -> EqTest b equal f g x = equal (f x) (g x) newtype P a = P { unP :: EqTest a } instance TestData a => Testable (P a) where property (P a) = property a infix 4 `eq` eq :: TestData a => a -> Model a -> P a eq x y = P (equal x (unmodel y)) class Conclusion p where type Predicate p predicate :: Predicate p -> p -> p instance Conclusion Property where type Predicate Property = Bool predicate = (==>) instance Conclusion p => Conclusion (a -> p) where type Predicate (a -> p) = a -> Predicate p predicate f p = \x -> predicate (f x) (p x) infixr 0 ===> (===>) :: TestData a => Predicate (EqTest a) -> P a -> P a p ===> P a = P (predicate p a) notNull2 _ xs = not $ DVG.null xs notNullS2 _ s = not $ S.null s -- Generators index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)] index_value_pairs 0 = return [] index_value_pairs m = sized $ \n -> do len <- choose (0,n) is <- sequence [choose (0,m-1) | i <- [1..len]] xs <- vector len return $ zip is xs indices :: Int -> Gen [Int] indices 0 = return [] indices m = sized $ \n -> do len <- choose (0,n) sequence [choose (0,m-1) | i <- [1..len]] -- Additional list functions singleton x = [x] snoc xs x = xs ++ [x] generate n f = [f i | i <- [0 .. n-1]] slice i n xs = take n (drop i xs) backpermute xs is = map (xs!!) is prescanl f z = init . scanl f z postscanl f z = tail . scanl f z prescanr f z = tail . scanr f z postscanr f z = init . scanr f z accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a] accum f xs ps = go xs ps' 0 where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps go (x:xs) ((i,y) : ps) j | i == j = go (f x y : xs) ps j go (x:xs) ps j = x : go xs ps (j+1) go [] _ _ = [] (//) :: [a] -> [(Int, a)] -> [a] xs // ps = go xs ps' 0 where ps' = sortBy (\p q -> compare (fst p) (fst q)) ps go (x:xs) ((i,y) : ps) j | i == j = go (y:xs) ps j go (x:xs) ps j = x : go xs ps (j+1) go [] _ _ = [] imap :: (Int -> a -> a) -> [a] -> [a] imap f = map (uncurry f) . zip [0..] izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a] izipWith f = zipWith (uncurry f) . zip [0..] izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a] izipWith3 f = zipWith3 (uncurry f) . zip [0..] ifilter :: (Int -> a -> Bool) -> [a] -> [a] ifilter f = map snd . filter (uncurry f) . zip [0..] ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a ifoldl f z = foldl (uncurry . f) z . zip [0..] ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z = foldr (uncurry f) z . zip [0..] minIndex :: Ord a => [a] -> Int minIndex = fst . foldr1 imin . zip [0..] where imin (i,x) (j,y) | x <= y = (i,x) | otherwise = (j,y) maxIndex :: Ord a => [a] -> Int maxIndex = fst . foldr1 imax . zip [0..] where imax (i,x) (j,y) | x >= y = (i,x) | otherwise = (j,y) vector-0.10.0.1/tests/Main.hs0000644000000000000000000000041712035366315014007 0ustar0000000000000000module Main (main) where import qualified Tests.Vector import qualified Tests.Stream import qualified Tests.Move import Test.Framework (defaultMain) main = defaultMain $ Tests.Stream.tests ++ Tests.Vector.tests ++ Tests.Move.tests vector-0.10.0.1/tests/vector-tests.cabal0000644000000000000000000000317212035366315016216 0ustar0000000000000000Name: vector-tests Version: 0.10.0.1 License: BSD3 License-File: LICENSE Author: Max Bolingbroke, Roman Leshchinskiy Maintainer: Roman Leshchinskiy Copyright: (c) Max Bolinbroke, Roman Leshchinskiy 2008-2012 Homepage: http://darcs.haskell.org/vector Category: Data Structures Synopsis: Efficient Arrays Description: Tests for the vector package Cabal-Version: >= 1.2 Build-Type: Simple Executable "vector-tests-O0" Main-Is: Main.hs Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.0.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 Extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, Rank2Types, TypeSynonymInstances, TypeFamilies, TemplateHaskell Ghc-Options: -O0 Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures Executable "vector-tests-O2" Main-Is: Main.hs Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.0.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 Extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, Rank2Types, TypeSynonymInstances, TypeFamilies, TemplateHaskell Ghc-Options: -O2 Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures vector-0.10.0.1/tests/Boilerplater.hs0000644000000000000000000000217612035366315015553 0ustar0000000000000000module Boilerplater where import Test.Framework.Providers.QuickCheck2 import Language.Haskell.TH testProperties :: [Name] -> Q Exp testProperties nms = fmap ListE $ sequence [[| testProperty $(stringE prop_name) $(varE nm) |] | nm <- nms , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] -- This nice clean solution doesn't quite work since I need to use lexically-scoped type -- variables, which aren't supported by Template Haskell. Argh! -- testProperties :: Q [Dec] -> Q Exp -- testProperties mdecs = do -- decs <- mdecs -- property_exprs <- sequence [[| testProperty "$prop_name" $(return $ VarE nm) |] -- | FunD nm _clauses <- decs -- , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] -- return $ LetE decs (ListE property_exprs) stripPrefix_maybe :: String -> String -> Maybe String stripPrefix_maybe prefix what | what_start == prefix = Just what_end | otherwise = Nothing where (what_start, what_end) = splitAt (length prefix) what vector-0.10.0.1/tests/LICENSE0000644000000000000000000000303512035366315013573 0ustar0000000000000000Copyright (c) 2009, Max Bolingbroke and Roman Leshchinskiy 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 name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE 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 UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. vector-0.10.0.1/tests/Setup.hs0000644000000000000000000000005712035366315014223 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.10.0.1/tests/Tests/0000755000000000000000000000000012035366315013667 5ustar0000000000000000vector-0.10.0.1/tests/Tests/Move.hs0000644000000000000000000000261012035366315015130 0ustar0000000000000000module Tests.Move (tests) where import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 import Utilities () import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector as V import qualified Data.Vector.Primitive as P import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U basicMove :: G.Vector v a => v a -> Int -> Int -> Int -> v a basicMove v dstOff srcOff len | len > 0 = G.modify (\ mv -> G.copy (M.slice dstOff len mv) (G.slice srcOff len v)) v | otherwise = v testMove :: (G.Vector v a, Show (v a), Eq (v a)) => v a -> Property testMove v = G.length v > 0 ==> (do dstOff <- choose (0, G.length v - 1) srcOff <- choose (0, G.length v - 1) len <- choose (1, G.length v - max dstOff srcOff) let expected = basicMove v dstOff srcOff len let actual = G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v printTestCase ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual)) tests = [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property), testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property), testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property), testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property)]vector-0.10.0.1/tests/Tests/Stream.hs0000644000000000000000000001607212035366315015464 0ustar0000000000000000module Tests.Stream ( tests ) where import Boilerplater import Utilities import qualified Data.Vector.Fusion.Stream as S import Test.QuickCheck import Test.Framework import Test.Framework.Providers.QuickCheck2 import Text.Show.Functions () import Data.List (foldl', foldl1', unfoldr, find, findIndex) import System.Random (Random) #define COMMON_CONTEXT(a) \ VANILLA_CONTEXT(a) #define VANILLA_CONTEXT(a) \ Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property testSanity :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList ] where prop_fromList_toList :: P (S.Stream a -> S.Stream a) = (S.fromList . S.toList) `eq` id prop_toList_fromList :: P ([a] -> [a]) = (S.toList . (S.fromList :: [a] -> S.Stream a)) `eq` id testPolymorphicFunctions :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, 'prop_length, 'prop_null, 'prop_empty, 'prop_singleton, 'prop_replicate, 'prop_cons, 'prop_snoc, 'prop_append, 'prop_head, 'prop_last, 'prop_index, 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, 'prop_map, 'prop_zipWith, 'prop_zipWith3, 'prop_filter, 'prop_takeWhile, 'prop_dropWhile, 'prop_elem, 'prop_notElem, 'prop_find, 'prop_findIndex, 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 'prop_foldr, 'prop_foldr1, 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 'prop_concatMap, 'prop_unfoldr ]) where -- Prelude prop_eq :: P (S.Stream a -> S.Stream a -> Bool) = (==) `eq` (==) prop_length :: P (S.Stream a -> Int) = S.length `eq` length prop_null :: P (S.Stream a -> Bool) = S.null `eq` null prop_empty :: P (S.Stream a) = S.empty `eq` [] prop_singleton :: P (a -> S.Stream a) = S.singleton `eq` singleton prop_replicate :: P (Int -> a -> S.Stream a) = (\n _ -> n < 1000) ===> S.replicate `eq` replicate prop_cons :: P (a -> S.Stream a -> S.Stream a) = S.cons `eq` (:) prop_snoc :: P (S.Stream a -> a -> S.Stream a) = S.snoc `eq` snoc prop_append :: P (S.Stream a -> S.Stream a -> S.Stream a) = (S.++) `eq` (++) prop_head :: P (S.Stream a -> a) = not . S.null ===> S.head `eq` head prop_last :: P (S.Stream a -> a) = not . S.null ===> S.last `eq` last prop_index = \xs -> not (S.null xs) ==> forAll (choose (0, S.length xs-1)) $ \i -> unP prop xs i where prop :: P (S.Stream a -> Int -> a) = (S.!!) `eq` (!!) prop_extract = \xs -> forAll (choose (0, S.length xs)) $ \i -> forAll (choose (0, S.length xs - i)) $ \n -> unP prop i n xs where prop :: P (Int -> Int -> S.Stream a -> S.Stream a) = S.slice `eq` slice prop_tail :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.tail `eq` tail prop_init :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.init `eq` init prop_take :: P (Int -> S.Stream a -> S.Stream a) = S.take `eq` take prop_drop :: P (Int -> S.Stream a -> S.Stream a) = S.drop `eq` drop prop_map :: P ((a -> a) -> S.Stream a -> S.Stream a) = S.map `eq` map prop_zipWith :: P ((a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a) = S.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a -> S.Stream a) = S.zipWith3 `eq` zipWith3 prop_filter :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.filter `eq` filter prop_takeWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.dropWhile `eq` dropWhile prop_elem :: P (a -> S.Stream a -> Bool) = S.elem `eq` elem prop_notElem :: P (a -> S.Stream a -> Bool) = S.notElem `eq` notElem prop_find :: P ((a -> Bool) -> S.Stream a -> Maybe a) = S.find `eq` find prop_findIndex :: P ((a -> Bool) -> S.Stream a -> Maybe Int) = S.findIndex `eq` findIndex prop_foldl :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===> S.foldl1 `eq` foldl1 prop_foldl' :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl' `eq` foldl' prop_foldl1' :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===> S.foldl1' `eq` foldl1' prop_foldr :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===> S.foldr1 `eq` foldr1 prop_prescanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.prescanl' `eq` prescanl prop_postscanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.postscanl `eq` postscanl prop_postscanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.postscanl' `eq` postscanl prop_scanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a) = S.scanl' `eq` scanl prop_scanl1 :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===> S.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===> S.scanl1' `eq` scanl1 prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs where prop :: P ((a -> S.Stream a) -> S.Stream a -> S.Stream a) = S.concatMap `eq` concatMap limitUnfolds f (theirs, ours) | ours >= 0 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) | otherwise = Nothing prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Stream a) = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) testBoolFunctions :: [Test] testBoolFunctions = $(testProperties ['prop_and, 'prop_or]) where prop_and :: P (S.Stream Bool -> Bool) = S.and `eq` and prop_or :: P (S.Stream Bool -> Bool) = S.or `eq` or testStreamFunctions = testSanity (undefined :: S.Stream Int) ++ testPolymorphicFunctions (undefined :: S.Stream Int) ++ testBoolFunctions tests = [ testGroup "Data.Vector.Fusion.Stream" testStreamFunctions ] vector-0.10.0.1/tests/Tests/Vector.hs0000644000000000000000000006313412035366315015474 0ustar0000000000000000module Tests.Vector (tests) where import Boilerplater import Utilities import qualified Data.Vector.Generic as V import qualified Data.Vector import qualified Data.Vector.Primitive import qualified Data.Vector.Storable import qualified Data.Vector.Unboxed import qualified Data.Vector.Fusion.Stream as S import Test.QuickCheck import Test.Framework import Test.Framework.Providers.QuickCheck2 import Text.Show.Functions () import Data.List import Data.Monoid import qualified Control.Applicative as Applicative import System.Random (Random) #define COMMON_CONTEXT(a, v) \ VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v) #define VANILLA_CONTEXT(a, v) \ Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property #define VECTOR_CONTEXT(a, v) \ Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a), TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a -- TODO: implement Vector equivalents of list functions for some of the commented out properties -- TODO: test and implement some of these other Prelude functions: -- mapM * -- mapM_ * -- sequence -- sequence_ -- sum * -- product * -- scanl * -- scanl1 * -- scanr * -- scanr1 * -- lookup * -- lines -- words -- unlines -- unwords -- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors. -- Ones with *s are the most plausible candidates. -- TODO: add tests for the other extra functions -- IVector exports still needing tests: -- copy, -- slice, -- (//), update, bpermute, -- prescanl, prescanl', -- new, -- unsafeSlice, unsafeIndex, -- vlength, vnew -- TODO: test non-IVector stuff? testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList, testProperty "unstream.stream == id" prop_unstream_stream, testProperty "stream.unstream == id" prop_stream_unstream ] where prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, -- Length information 'prop_length, 'prop_null, -- Indexing (FIXME) 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, -- Monadic indexing (FIXME) {- 'prop_indexM, 'prop_headM, 'prop_lastM, 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} -- Subvectors (FIXME) 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, 'prop_splitAt, {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, 'prop_unsafeTake, 'prop_unsafeDrop, -} -- Initialisation (FIXME) 'prop_empty, 'prop_singleton, 'prop_replicate, 'prop_generate, 'prop_iterateN, -- Monadic initialisation (FIXME) {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} -- Unfolding (FIXME) {- 'prop_unfoldr, prop_unfoldrN, -} 'prop_constructN, 'prop_constructrN, -- Enumeration? (FIXME?) -- Concatenation (FIXME) 'prop_cons, 'prop_snoc, 'prop_append, 'prop_concat, -- Restricting memory usage 'prop_force, -- Bulk updates (FIXME) 'prop_upd, {- 'prop_update, 'prop_update_, 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} -- Accumulations (FIXME) 'prop_accum, {- 'prop_accumulate, 'prop_accumulate_, 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} -- Permutations 'prop_reverse, 'prop_backpermute, {- 'prop_unsafeBackpermute, -} -- Elementwise indexing {- 'prop_indexed, -} -- Mapping 'prop_map, 'prop_imap, 'prop_concatMap, -- Monadic mapping {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} -- Zipping 'prop_zipWith, 'prop_zipWith3, {- ... -} 'prop_izipWith, 'prop_izipWith3, {- ... -} {- 'prop_zip, ... -} -- Monadic zipping {- 'prop_zipWithM, 'prop_zipWithM_, -} -- Unzipping {- 'prop_unzip, ... -} -- Filtering 'prop_filter, 'prop_ifilter, {- prop_filterM, -} 'prop_takeWhile, 'prop_dropWhile, -- Paritioning 'prop_partition, {- 'prop_unstablePartition, -} 'prop_span, 'prop_break, -- Searching 'prop_elem, 'prop_notElem, 'prop_find, 'prop_findIndex, 'prop_findIndices, 'prop_elemIndex, 'prop_elemIndices, -- Folding 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', -- Specialised folds 'prop_all, 'prop_any, {- 'prop_maximumBy, 'prop_minimumBy, 'prop_maxIndexBy, 'prop_minIndexBy, -} -- Monadic folds {- ... -} -- Monadic sequencing {- ... -} -- Scans 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 'prop_prescanr, 'prop_prescanr', 'prop_postscanr, 'prop_postscanr', 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1' ]) where -- Prelude prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==) prop_length :: P (v a -> Int) = V.length `eq` length prop_null :: P (v a -> Bool) = V.null `eq` null prop_empty :: P (v a) = V.empty `eq` [] prop_singleton :: P (a -> v a) = V.singleton `eq` singleton prop_replicate :: P (Int -> a -> v a) = (\n _ -> n < 1000) ===> V.replicate `eq` replicate prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) prop_concat :: P ([v a] -> v a) = V.concat `eq` concat prop_force :: P (v a -> v a) = V.force `eq` id prop_generate :: P (Int -> (Int -> a) -> v a) = (\n _ -> n < 1000) ===> V.generate `eq` generate prop_iterateN :: P (Int -> (a -> a) -> a -> v a) = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last prop_index = \xs -> not (V.null xs) ==> forAll (choose (0, V.length xs-1)) $ \i -> unP prop xs i where prop :: P (v a -> Int -> a) = (V.!) `eq` (!!) prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn where fn xs i = case drop i xs of x:_ | i >= 0 -> Just x _ -> Nothing prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last prop_unsafeIndex = \xs -> not (V.null xs) ==> forAll (choose (0, V.length xs-1)) $ \i -> unP prop xs i where prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!) prop_slice = \xs -> forAll (choose (0, V.length xs)) $ \i -> forAll (choose (0, V.length xs - i)) $ \n -> unP prop i n xs where prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init prop_take :: P (Int -> v a -> v a) = V.take `eq` take prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt prop_accum = \f xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> unP prop f xs ps where prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) = V.accum `eq` accum prop_upd = \xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> unP prop xs ps where prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) prop_backpermute = \xs -> forAll (indices (V.length xs)) $ \is -> unP prop xs (V.fromList is) where prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) = V.zipWith3 `eq` zipWith3 prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a) = V.izipWith3 `eq` izipWith3 prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) = V.partition `eq` partition prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) = V.findIndex `eq` findIndex prop_findIndices :: P ((a -> Bool) -> v a -> v Int) = V.findIndices `eq` findIndices prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldl1 `eq` foldl1 prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl' prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldl1' `eq` foldl1' prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldr1 `eq` foldr1 prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> V.foldr1' `eq` foldr1 prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) = V.ifoldl `eq` ifoldl prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) = V.ifoldl' `eq` ifoldl prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) = V.ifoldr `eq` ifoldr prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) = V.ifoldr' `eq` ifoldr prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanl' `eq` prescanl prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanl `eq` postscanl prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanl' `eq` postscanl prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanl' `eq` scanl prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanl1' `eq` scanl1 prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanr `eq` prescanr prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanr' `eq` prescanr prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanr `eq` postscanr prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.postscanr' `eq` postscanr prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanr `eq` scanr prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanr' `eq` scanr prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanr1 `eq` scanr1 prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanr1' `eq` scanr1 prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs where prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any -- Data.List --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int) --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool) --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int) --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int) -- --prop_mapAccumL = eq3 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) -- --prop_mapAccumR = eq3 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B)) -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. limitUnfolds f (theirs, ours) | ours >= 0 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) | otherwise = Nothing prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] constructN xs 0 _ = xs constructN xs n f = constructN (xs ++ [f xs]) (n-1) f prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] constructrN xs 0 _ = xs constructrN xs n f = constructrN (f xs : xs) (n-1) f testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test] testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3]) where prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test] testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum, 'prop_minIndex, 'prop_maxIndex ]) where prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a, Random a) => v a -> [Test] testEnumFunctions _ = $(testProperties [ 'prop_enumFromN, 'prop_enumFromThenN, 'prop_enumFromTo, 'prop_enumFromThenTo]) where prop_enumFromN :: P (a -> Int -> v a) = (\_ n -> n < 1000) ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1) prop_enumFromThenN :: P (a -> a -> Int -> v a) = (\_ _ n -> n < 1000) ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y) prop_enumFromTo = \m -> forAll (choose (-2,100)) $ \n -> unP prop m (m+n) where prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo prop_enumFromThenTo = \i j -> j /= i ==> forAll (choose (ks i j)) $ \k -> unP prop i j k where prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo ks i j | j < i = (i-d*100, i+d*2) | otherwise = (i-d*2, i+d*100) where d = abs (j-i) testMonoidFunctions :: forall a v. (COMMON_CONTEXT(a, v), Monoid (v a)) => v a -> [Test] testMonoidFunctions _ = $(testProperties [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) where prop_mempty :: P (v a) = mempty `eq` mempty prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat testFunctorFunctions :: forall a v. (COMMON_CONTEXT(a, v), Functor v) => v a -> [Test] testFunctorFunctions _ = $(testProperties [ 'prop_fmap ]) where prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap testMonadFunctions :: forall a v. (COMMON_CONTEXT(a, v), Monad v) => v a -> [Test] testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind ]) where prop_return :: P (a -> v a) = return `eq` return prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) testApplicativeFunctions :: forall a v. (COMMON_CONTEXT(a, v), V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] testApplicativeFunctions _ = $(testProperties [ 'prop_applicative_pure, 'prop_applicative_appl ]) where prop_applicative_pure :: P (a -> v a) = Applicative.pure `eq` Applicative.pure prop_applicative_appl :: [a -> a] -> P (v a -> v a) = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs testAlternativeFunctions :: forall a v. (COMMON_CONTEXT(a, v), Applicative.Alternative v) => v a -> [Test] testAlternativeFunctions _ = $(testProperties [ 'prop_alternative_empty, 'prop_alternative_or ]) where prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty prop_alternative_or :: P (v a -> v a -> v a) = (Applicative.<|>) `eq` (Applicative.<|>) testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) where prop_and :: P (v Bool -> Bool) = V.and `eq` and prop_or :: P (v Bool -> Bool) = V.or `eq` or testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test] testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) where prop_sum :: P (v a -> a) = V.sum `eq` sum prop_product :: P (v a -> a) = V.product `eq` product testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test] testNestedVectorFunctions _ = $(testProperties []) where -- Prelude --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat -- Data.List --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a]) --prop_group = V.group `eq1` (group :: v a -> [v a]) --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) testGeneralBoxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Vector), Ord a) => Data.Vector.Vector a -> [Test] testGeneralBoxedVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions, testTuplyFunctions, testNestedVectorFunctions, testMonoidFunctions, testFunctorFunctions, testMonadFunctions, testApplicativeFunctions, testAlternativeFunctions ] testBoolBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector , testBoolFunctions ] testNumericBoxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Vector), Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test] testNumericBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector , testNumFunctions , testEnumFunctions ] testGeneralPrimitiveVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Primitive.Vector), Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test] testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions, testMonoidFunctions ] testNumericPrimitiveVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Primitive.Vector), Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test] testNumericPrimitiveVector dummy = concatMap ($ dummy) [ testGeneralPrimitiveVector , testNumFunctions , testEnumFunctions ] testGeneralStorableVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Storable.Vector), Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test] testGeneralStorableVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions, testMonoidFunctions ] testNumericStorableVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Storable.Vector), Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test] testNumericStorableVector dummy = concatMap ($ dummy) [ testGeneralStorableVector , testNumFunctions , testEnumFunctions ] testGeneralUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] testGeneralUnboxedVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, testOrdFunctions, testMonoidFunctions ] testUnitUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector ] testBoolUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector , testBoolFunctions ] testNumericUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test] testNumericUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector , testNumFunctions , testEnumFunctions ] testTupleUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] testTupleUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector ] tests = [ testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)), testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)), testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)), testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)), testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)), testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)), testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())), testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)), testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)), testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))), testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int))) ] vector-0.10.0.1/include/0000755000000000000000000000000012035366315013046 5ustar0000000000000000vector-0.10.0.1/include/vector.h0000644000000000000000000000100312035366315014513 0ustar0000000000000000#define PHASE_STREAM [1] #define PHASE_INNER [0] #define INLINE_STREAM INLINE PHASE_STREAM #define INLINE_INNER INLINE PHASE_INNER #ifndef NOT_VECTOR_MODULE import qualified Data.Vector.Internal.Check as Ck #endif #define ERROR (Ck.error __FILE__ __LINE__) #define INTERNAL_ERROR (Ck.internalError __FILE__ __LINE__) #define CHECK(f) (Ck.f __FILE__ __LINE__) #define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds) #define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe) #define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal) vector-0.10.0.1/benchmarks/0000755000000000000000000000000012035366315013540 5ustar0000000000000000vector-0.10.0.1/benchmarks/vector-benchmarks.cabal0000644000000000000000000000157112035366315020145 0ustar0000000000000000Name: vector-benchmarks Version: 0.10.0.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Roman Leshchinskiy Copyright: (c) Roman Leshchinskiy 2010-2012 Cabal-Version: >= 1.2 Build-Type: Simple Executable algorithms Main-Is: Main.hs Build-Depends: base >= 2 && < 5, array, criterion >= 0.5 && < 0.7, mwc-random >= 0.5 && < 0.13, vector == 0.10.0.1 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing Ghc-Options: -O2 Other-Modules: Algo.ListRank Algo.Rootfix Algo.Leaffix Algo.AwShCC Algo.HybCC Algo.Quickhull Algo.Spectral Algo.Tridiag TestData.ParenTree TestData.Graph TestData.Random vector-0.10.0.1/benchmarks/Main.hs0000644000000000000000000000322612035366315014763 0ustar0000000000000000module Main where import Criterion.Main import Algo.ListRank (listRank) import Algo.Rootfix (rootfix) import Algo.Leaffix (leaffix) import Algo.AwShCC (awshcc) import Algo.HybCC (hybcc) import Algo.Quickhull (quickhull) import Algo.Spectral ( spectral ) import Algo.Tridiag ( tridiag ) import TestData.ParenTree ( parenTree ) import TestData.Graph ( randomGraph ) import TestData.Random ( randomVector ) import Data.Vector.Unboxed ( Vector ) size :: Int size = 100000 main = lparens `seq` rparens `seq` nodes `seq` edges1 `seq` edges2 `seq` do as <- randomVector size :: IO (Vector Double) bs <- randomVector size :: IO (Vector Double) cs <- randomVector size :: IO (Vector Double) ds <- randomVector size :: IO (Vector Double) sp <- randomVector (floor $ sqrt $ fromIntegral size) :: IO (Vector Double) as `seq` bs `seq` cs `seq` ds `seq` sp `seq` defaultMain [ bench "listRank" $ whnf listRank size , bench "rootfix" $ whnf rootfix (lparens, rparens) , bench "leaffix" $ whnf leaffix (lparens, rparens) , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2) , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2) , bench "quickhull" $ whnf quickhull (as,bs) , bench "spectral" $ whnf spectral sp , bench "tridiag" $ whnf tridiag (as,bs,cs,ds) ] where (lparens, rparens) = parenTree size (nodes, edges1, edges2) = randomGraph size vector-0.10.0.1/benchmarks/LICENSE0000644000000000000000000000301612035366315014545 0ustar0000000000000000Copyright (c) 2008-2009, Roman Leshchinskiy 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 name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE 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 UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. vector-0.10.0.1/benchmarks/Setup.hs0000644000000000000000000000005712035366315015176 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.10.0.1/benchmarks/TestData/0000755000000000000000000000000012035366315015251 5ustar0000000000000000vector-0.10.0.1/benchmarks/TestData/Graph.hs0000644000000000000000000000233112035366315016645 0ustar0000000000000000module TestData.Graph ( randomGraph ) where import System.Random.MWC import qualified Data.Array.ST as STA import qualified Data.Vector.Unboxed as V import Control.Monad.ST ( ST, runST ) randomGraph :: Int -> (Int, V.Vector Int, V.Vector Int) randomGraph e = runST ( do g <- create arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int]) addRandomEdges n g arr e xs <- STA.getAssocs arr let (as,bs) = unzip [(i,j) | (i,js) <- xs, j <- js ] return (n, V.fromListN (length as) as, V.fromListN (length bs) bs) ) where n = e `div` 10 addRandomEdges :: Int -> Gen s -> STA.STArray s Int [Int] -> Int -> ST s () addRandomEdges n g arr = fill where fill 0 = return () fill e = do m <- random_index n <- random_index let lo = min m n hi = max m n ns <- STA.readArray arr lo if lo == hi || hi `elem` ns then fill e else do STA.writeArray arr lo (hi:ns) fill (e-1) random_index = do x <- uniform g let i = floor ((x::Double) * toEnum n) if i == n then return 0 else return i vector-0.10.0.1/benchmarks/TestData/ParenTree.hs0000644000000000000000000000121012035366315017464 0ustar0000000000000000module TestData.ParenTree where import qualified Data.Vector.Unboxed as V parenTree :: Int -> (V.Vector Int, V.Vector Int) parenTree n = case go ([],[]) 0 (if even n then n else n+1) of (ls,rs) -> (V.fromListN (length ls) (reverse ls), V.fromListN (length rs) (reverse rs)) where go (ls,rs) i j = case j-i of 0 -> (ls,rs) 2 -> (ls',rs') d -> let k = ((d-2) `div` 4) * 2 in go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1) where ls' = i:ls rs' = j-1:rs vector-0.10.0.1/benchmarks/TestData/Random.hs0000644000000000000000000000060212035366315017023 0ustar0000000000000000module TestData.Random ( randomVector ) where import qualified Data.Vector.Unboxed as V import System.Random.MWC import Control.Monad.ST ( runST ) randomVector :: (Variate a, V.Unbox a) => Int -> IO (V.Vector a) randomVector n = withSystemRandom $ \g -> do xs <- sequence $ replicate n $ uniform g io (return $ V.fromListN n xs) where io :: IO a -> IO a io = id vector-0.10.0.1/benchmarks/Algo/0000755000000000000000000000000012035366315014422 5ustar0000000000000000vector-0.10.0.1/benchmarks/Algo/Rootfix.hs0000644000000000000000000000070312035366315016410 0ustar0000000000000000module Algo.Rootfix where import Data.Vector.Unboxed as V rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int {-# NOINLINE rootfix #-} rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs where rootfix xs ls rs = let zs = V.replicate (V.length ls * 2) 0 vs = V.update_ (V.update_ zs ls xs) rs (V.map negate xs) sums = V.prescanl' (+) 0 vs in V.backpermute sums ls vector-0.10.0.1/benchmarks/Algo/AwShCC.hs0000644000000000000000000000246512035366315016035 0ustar0000000000000000{-# OPTIONS -fno-spec-constr-count #-} module Algo.AwShCC (awshcc) where import Data.Vector.Unboxed as V awshcc :: (Int, Vector Int, Vector Int) -> Vector Int {-# NOINLINE awshcc #-} awshcc (n, es1, es2) = concomp ds es1' es2' where ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1) es1' = es1 V.++ es2 es2' = es2 V.++ es1 starCheck ds = V.backpermute st' gs where gs = V.backpermute ds ds st = V.zipWith (==) ds gs st' = V.update st . V.filter (not . snd) $ V.zip gs st concomp ds es1 es2 | V.and (starCheck ds'') = ds'' | otherwise = concomp (V.backpermute ds'' ds'') es1 es2 where ds' = V.update ds . V.map (\(di, dj, gi) -> (di, dj)) . V.filter (\(di, dj, gi) -> gi == di && di > dj) $ V.zip3 (V.backpermute ds es1) (V.backpermute ds es2) (V.backpermute ds (V.backpermute ds es1)) ds'' = V.update ds' . V.map (\(di, dj, st) -> (di, dj)) . V.filter (\(di, dj, st) -> st && di /= dj) $ V.zip3 (V.backpermute ds' es1) (V.backpermute ds' es2) (V.backpermute (starCheck ds') es1) vector-0.10.0.1/benchmarks/Algo/Quickhull.hs0000644000000000000000000000162712035366315016725 0ustar0000000000000000module Algo.Quickhull (quickhull) where import Data.Vector.Unboxed as V quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double) {-# NOINLINE quickhull #-} quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys') where (xs',ys') = V.unzip $ hsplit points pmin pmax V.++ hsplit points pmax pmin imin = V.minIndex xs imax = V.maxIndex xs points = V.zip xs ys pmin = points V.! imin pmax = points V.! imax hsplit points p1 p2 | V.length packed < 2 = p1 `V.cons` packed | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2 where cs = V.map (\p -> cross p p1 p2) points packed = V.map fst $ V.filter (\t -> snd t > 0) $ V.zip points cs pm = points V.! V.maxIndex cs cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x) vector-0.10.0.1/benchmarks/Algo/Tridiag.hs0000644000000000000000000000102112035366315016333 0ustar0000000000000000module Algo.Tridiag ( tridiag ) where import Data.Vector.Unboxed as V tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double) -> Vector Double {-# NOINLINE tridiag #-} tridiag (as,bs,cs,ds) = V.prescanr' (\(c,d) x' -> d - c*x') 0 $ V.prescanl' modify (0,0) $ V.zip (V.zip as bs) (V.zip cs ds) where modify (c',d') ((a,b),(c,d)) = let id = 1 / (b - c'*a) in id `seq` (c*id, (d-d'*a)*id) vector-0.10.0.1/benchmarks/Algo/HybCC.hs0000644000000000000000000000252512035366315015712 0ustar0000000000000000module Algo.HybCC (hybcc) where import Data.Vector.Unboxed as V hybcc :: (Int, Vector Int, Vector Int) -> Vector Int {-# NOINLINE hybcc #-} hybcc (n, e1, e2) = concomp (V.zip e1 e2) n where concomp es n | V.null es = V.enumFromTo 0 (n-1) | otherwise = V.backpermute ins ins where p = shortcut_all $ V.update (V.enumFromTo 0 (n-1)) es (es',i) = compress p es r = concomp es' (V.length i) ins = V.update_ p i $ V.backpermute i r enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs pack_index bs = V.map fst . V.filter snd $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs shortcut_all p | p == pp = pp | otherwise = shortcut_all pp where pp = V.backpermute p p compress p es = (new_es, pack_index roots) where (e1,e2) = V.unzip es es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y)) . V.filter (\(x,y) -> x /= y) $ V.zip (V.backpermute p e1) (V.backpermute p e2) roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1)) labels = enumerate roots (e1',e2') = V.unzip es' new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2') vector-0.10.0.1/benchmarks/Algo/Spectral.hs0000644000000000000000000000071612035366315016537 0ustar0000000000000000module Algo.Spectral ( spectral ) where import Data.Vector.Unboxed as V import Data.Bits spectral :: Vector Double -> Vector Double {-# NOINLINE spectral #-} spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1)) where n = V.length us row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us) eval_A i j = 1 / fromIntegral r where r = u + (i+1) u = t `shiftR` 1 t = n * (n+1) n = i+j vector-0.10.0.1/benchmarks/Algo/ListRank.hs0000644000000000000000000000075712035366315016516 0ustar0000000000000000module Algo.ListRank where import Data.Vector.Unboxed as V listRank :: Int -> Vector Int {-# NOINLINE listRank #-} listRank n = pointer_jump xs val where xs = 0 `V.cons` V.enumFromTo 0 (n-2) val = V.zipWith (\i j -> if i == j then 0 else 1) xs (V.enumFromTo 0 (n-1)) pointer_jump pt val | npt == pt = val | otherwise = pointer_jump npt nval where npt = V.backpermute pt pt nval = V.zipWith (+) val (V.backpermute val pt) vector-0.10.0.1/benchmarks/Algo/Leaffix.hs0000644000000000000000000000070712035366315016340 0ustar0000000000000000module Algo.Leaffix where import Data.Vector.Unboxed as V leaffix :: (Vector Int, Vector Int) -> Vector Int {-# NOINLINE leaffix #-} leaffix (ls,rs) = leaffix (V.replicate (V.length ls) 1) ls rs where leaffix xs ls rs = let zs = V.replicate (V.length ls * 2) 0 vs = V.update_ zs ls xs sums = V.prescanl' (+) 0 vs in V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs) vector-0.10.0.1/internal/0000755000000000000000000000000012035366315013237 5ustar0000000000000000vector-0.10.0.1/internal/GenUnboxTuple.hs0000644000000000000000000002156612035366315016344 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module Main where import Text.PrettyPrint import System.Environment ( getArgs ) main = do [s] <- getArgs let n = read s mapM_ (putStrLn . render . generate) [2..n] generate :: Int -> Doc generate n = vcat [ text "#ifdef DEFINE_INSTANCES" , data_instance "MVector s" "MV" , data_instance "Vector" "V" , class_instance "Unbox" , class_instance "M.MVector MVector" <+> text "where" , nest 2 $ vcat $ map method methods_MVector , class_instance "G.Vector Vector" <+> text "where" , nest 2 $ vcat $ map method methods_Vector , text "#endif" , text "#ifdef DEFINE_MUTABLE" , define_zip "MVector s" "MV" , define_unzip "MVector s" "MV" , text "#endif" , text "#ifdef DEFINE_IMMUTABLE" , define_zip "Vector" "V" , define_zip_rule , define_unzip "Vector" "V" , text "#endif" ] where vars = map char $ take n ['a'..] varss = map (<> char 's') vars tuple xs = parens $ hsep $ punctuate comma xs vtuple xs = parens $ sep $ punctuate comma xs con s = text s <> char '_' <> int n var c = text (c : "_") data_instance ty c = hang (hsep [text "data instance", text ty, tuple vars]) 4 (hsep [char '=', con c, text "{-# UNPACK #-} !Int" , vcat $ map (\v -> char '!' <> parens (text ty <+> v)) vars]) class_instance cls = text "instance" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> text cls <+> tuple vars define_zip ty c = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors" ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars]) <+> text "->" <+> text ty <+> tuple vars ,text "{-# INLINE_STREAM" <+> name <+> text "#-}" ,name <+> sep varss <+> text "=" <+> con c <+> text "len" <+> sep [parens $ text "unsafeSlice" <+> char '0' <+> text "len" <+> vs | vs <- varss] ,nest 2 $ hang (text "where") 2 $ text "len =" <+> sep (punctuate (text " `delayed_min`") [text "length" <+> vs | vs <- varss]) ] where name | n == 2 = text "zip" | otherwise = text "zip" <> int n define_zip_rule = hang (text "{-# RULES" <+> text "\"stream/" <> name "zip" <> text " [Vector.Unboxed]\" forall" <+> sep varss <+> char '.') 2 $ text "G.stream" <+> parens (name "zip" <+> sep varss) <+> char '=' <+> text "Stream." <> name "zipWith" <+> tuple (replicate n empty) <+> sep [parens $ text "G.stream" <+> vs | vs <- varss] $$ text "#-}" where name s | n == 2 = text s | otherwise = text s <> int n define_unzip ty c = sep [text "-- | /O(1)/ Unzip" <+> int n <+> text "vectors" ,name <+> text "::" <+> vtuple [text "Unbox" <+> v | v <- vars] <+> text "=>" <+> text ty <+> tuple vars <+> text "->" <+> vtuple [text ty <+> v | v <- vars] ,text "{-# INLINE" <+> name <+> text "#-}" ,name <+> pat c <+> text "=" <+> vtuple varss ] where name | n == 2 = text "unzip" | otherwise = text "unzip" <> int n pat c = parens $ con c <+> var 'n' <+> sep varss patn c n = parens $ con c <+> (var 'n' <> int n) <+> sep [v <> int n | v <- varss] qM s = text "M." <> text s qG s = text "G." <> text s gen_length c _ = (pat c, var 'n') gen_unsafeSlice mod c rec = (var 'i' <+> var 'm' <+> pat c, con c <+> var 'm' <+> vcat [parens $ text mod <> char '.' <> text rec <+> var 'i' <+> var 'm' <+> vs | vs <- varss]) gen_overlaps rec = (patn "MV" 1 <+> patn "MV" 2, vcat $ r : [text "||" <+> r | r <- rs]) where r : rs = [qM rec <+> v <> char '1' <+> v <> char '2' | v <- varss] gen_unsafeNew rec = (var 'n', mk_do [v <+> text "<-" <+> qM rec <+> var 'n' | v <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) gen_unsafeReplicate rec = (var 'n' <+> tuple vars, mk_do [vs <+> text "<-" <+> qM rec <+> var 'n' <+> v | v <- vars | vs <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) gen_unsafeRead rec = (pat "MV" <+> var 'i', mk_do [v <+> text "<-" <+> qM rec <+> vs <+> var 'i' | v <- vars | vs <- varss] $ text "return" <+> tuple vars) gen_unsafeWrite rec = (pat "MV" <+> var 'i' <+> tuple vars, mk_do [qM rec <+> vs <+> var 'i' <+> v | v <- vars | vs <- varss] empty) gen_clear rec = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) gen_set rec = (pat "MV" <+> tuple vars, mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty) gen_unsafeCopy c q rec = (patn "MV" 1 <+> patn c 2, mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] empty) gen_unsafeMove rec = (patn "MV" 1 <+> patn "MV" 2, mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] empty) gen_unsafeGrow rec = (pat "MV" <+> var 'm', mk_do [vs <> char '\'' <+> text "<-" <+> qM rec <+> vs <+> var 'm' | vs <- varss] $ text "return $" <+> con "MV" <+> parens (var 'm' <> char '+' <> var 'n') <+> sep (map (<> char '\'') varss)) gen_unsafeFreeze rec = (pat "MV", mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] $ text "return $" <+> con "V" <+> var 'n' <+> sep [vs <> char '\'' | vs <- varss]) gen_unsafeThaw rec = (pat "V", mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] $ text "return $" <+> con "MV" <+> var 'n' <+> sep [vs <> char '\'' | vs <- varss]) gen_basicUnsafeIndexM rec = (pat "V" <+> var 'i', mk_do [v <+> text "<-" <+> qG rec <+> vs <+> var 'i' | vs <- varss | v <- vars] $ text "return" <+> tuple vars) gen_elemseq rec = (char '_' <+> tuple vars, vcat $ r : [char '.' <+> r | r <- rs]) where r : rs = [qG rec <+> parens (text "undefined :: Vector" <+> v) <+> v | v <- vars] mk_do cmds ret = hang (text "do") 2 $ vcat $ cmds ++ [ret] method (s, f) = case f s of (p,e) -> text "{-# INLINE" <+> text s <+> text " #-}" $$ hang (text s <+> p) 4 (char '=' <+> e) methods_MVector = [("basicLength", gen_length "MV") ,("basicUnsafeSlice", gen_unsafeSlice "M" "MV") ,("basicOverlaps", gen_overlaps) ,("basicUnsafeNew", gen_unsafeNew) ,("basicUnsafeReplicate", gen_unsafeReplicate) ,("basicUnsafeRead", gen_unsafeRead) ,("basicUnsafeWrite", gen_unsafeWrite) ,("basicClear", gen_clear) ,("basicSet", gen_set) ,("basicUnsafeCopy", gen_unsafeCopy "MV" qM) ,("basicUnsafeMove", gen_unsafeMove) ,("basicUnsafeGrow", gen_unsafeGrow)] methods_Vector = [("basicUnsafeFreeze", gen_unsafeFreeze) ,("basicUnsafeThaw", gen_unsafeThaw) ,("basicLength", gen_length "V") ,("basicUnsafeSlice", gen_unsafeSlice "G" "V") ,("basicUnsafeIndexM", gen_basicUnsafeIndexM) ,("basicUnsafeCopy", gen_unsafeCopy "V" qG) ,("elemseq", gen_elemseq)] vector-0.10.0.1/internal/unbox-tuple-instances0000644000000000000000000012034612035366315017437 0ustar0000000000000000#ifdef DEFINE_INSTANCES data instance MVector s (a, b) = MV_2 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) data instance Vector (a, b) = V_2 {-# UNPACK #-} !Int !(Vector a) !(Vector b) instance (Unbox a, Unbox b) => Unbox (a, b) instance (Unbox a, Unbox b) => M.MVector MVector (a, b) where {-# INLINE basicLength #-} basicLength (MV_2 n_ as bs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_2 n_ as bs) = MV_2 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ return $ MV_2 n_ as bs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b return $ MV_2 n_ as bs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_2 n_ as bs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ return (a, b) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_2 n_ as bs) i_ (a, b) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b {-# INLINE basicClear #-} basicClear (MV_2 n_ as bs) = do M.basicClear as M.basicClear bs {-# INLINE basicSet #-} basicSet (MV_2 n_ as bs) (a, b) = do M.basicSet as a M.basicSet bs b {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_2 n_1 as1 bs1) (MV_2 n_2 as2 bs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_2 n_ as bs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ return $ MV_2 (m_+n_) as' bs' instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_2 n_ as bs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs return $ V_2 n_ as' bs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_2 n_ as bs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs return $ MV_2 n_ as' bs' {-# INLINE basicLength #-} basicLength (V_2 n_ as bs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_2 n_ as bs) = V_2 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_2 n_ as bs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ return (a, b) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 n_1 as1 bs1) (V_2 n_2 as2 bs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 {-# INLINE elemseq #-} elemseq _ (a, b) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => MVector s a -> MVector s b -> MVector s (a, b) {-# INLINE_STREAM zip #-} zip as bs = MV_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) where len = length as `delayed_min` length bs -- | /O(1)/ Unzip 2 vectors unzip :: (Unbox a, Unbox b) => MVector s (a, b) -> (MVector s a, MVector s b) {-# INLINE unzip #-} unzip (MV_2 n_ as bs) = (as, bs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) {-# INLINE_STREAM zip #-} zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) where len = length as `delayed_min` length bs {-# RULES "stream/zip [Vector.Unboxed]" forall as bs . G.stream (zip as bs) = Stream.zipWith (,) (G.stream as) (G.stream bs) #-} -- | /O(1)/ Unzip 2 vectors unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} unzip (V_2 n_ as bs) = (as, bs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c) = MV_3 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) data instance Vector (a, b, c) = V_3 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) instance (Unbox a, Unbox b, Unbox c) => Unbox (a, b, c) instance (Unbox a, Unbox b, Unbox c) => M.MVector MVector (a, b, c) where {-# INLINE basicLength #-} basicLength (MV_3 n_ as bs cs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_3 n_ as bs cs) = MV_3 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ return $ MV_3 n_ as bs cs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c return $ MV_3 n_ as bs cs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_3 n_ as bs cs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ return (a, b, c) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_3 n_ as bs cs) i_ (a, b, c) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c {-# INLINE basicClear #-} basicClear (MV_3 n_ as bs cs) = do M.basicClear as M.basicClear bs M.basicClear cs {-# INLINE basicSet #-} basicSet (MV_3 n_ as bs cs) (a, b, c) = do M.basicSet as a M.basicSet bs b M.basicSet cs c {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_3 n_1 as1 bs1 cs1) (MV_3 n_2 as2 bs2 cs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_3 n_ as bs cs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ return $ MV_3 (m_+n_) as' bs' cs' instance (Unbox a, Unbox b, Unbox c) => G.Vector Vector (a, b, c) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_3 n_ as bs cs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs return $ V_3 n_ as' bs' cs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_3 n_ as bs cs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs return $ MV_3 n_ as' bs' cs' {-# INLINE basicLength #-} basicLength (V_3 n_ as bs cs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_3 n_ as bs cs) = V_3 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_3 n_ as bs cs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ return (a, b, c) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (V_3 n_2 as2 bs2 cs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 {-# INLINE elemseq #-} elemseq _ (a, b, c) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 3 vectors zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a -> MVector s b -> MVector s c -> MVector s (a, b, c) {-# INLINE_STREAM zip3 #-} zip3 as bs cs = MV_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs -- | /O(1)/ Unzip 3 vectors unzip3 :: (Unbox a, Unbox b, Unbox c) => MVector s (a, b, c) -> (MVector s a, MVector s b, MVector s c) {-# INLINE unzip3 #-} unzip3 (MV_3 n_ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 3 vectors zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE_STREAM zip3 #-} zip3 as bs cs = V_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs {-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs . G.stream (zip3 as bs cs) = Stream.zipWith3 (, ,) (G.stream as) (G.stream bs) (G.stream cs) #-} -- | /O(1)/ Unzip 3 vectors unzip3 :: (Unbox a, Unbox b, Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) {-# INLINE unzip3 #-} unzip3 (V_3 n_ as bs cs) = (as, bs, cs) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d) = MV_4 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) data instance Vector (a, b, c, d) = V_4 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) instance (Unbox a, Unbox b, Unbox c, Unbox d) => Unbox (a, b, c, d) instance (Unbox a, Unbox b, Unbox c, Unbox d) => M.MVector MVector (a, b, c, d) where {-# INLINE basicLength #-} basicLength (MV_4 n_ as bs cs ds) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_4 n_ as bs cs ds) = MV_4 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) {-# INLINE basicOverlaps #-} basicOverlaps (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2 bs2 cs2 ds2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ return $ MV_4 n_ as bs cs ds {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d return $ MV_4 n_ as bs cs ds {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_4 n_ as bs cs ds) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ return (a, b, c, d) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_4 n_ as bs cs ds) i_ (a, b, c, d) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d {-# INLINE basicClear #-} basicClear (MV_4 n_ as bs cs ds) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds {-# INLINE basicSet #-} basicSet (MV_4 n_ as bs cs ds) (a, b, c, d) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2 bs2 cs2 ds2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_4 n_1 as1 bs1 cs1 ds1) (MV_4 n_2 as2 bs2 cs2 ds2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_4 n_ as bs cs ds) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ return $ MV_4 (m_+n_) as' bs' cs' ds' instance (Unbox a, Unbox b, Unbox c, Unbox d) => G.Vector Vector (a, b, c, d) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_4 n_ as bs cs ds) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds return $ V_4 n_ as' bs' cs' ds' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_4 n_ as bs cs ds) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds return $ MV_4 n_ as' bs' cs' ds' {-# INLINE basicLength #-} basicLength (V_4 n_ as bs cs ds) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_4 n_ as bs cs ds) = V_4 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_4 n_ as bs cs ds) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ return (a, b, c, d) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (V_4 n_2 as2 bs2 cs2 ds2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 4 vectors zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s (a, b, c, d) {-# INLINE_STREAM zip4 #-} zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds -- | /O(1)/ Unzip 4 vectors unzip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s (a, b, c, d) -> (MVector s a, MVector s b, MVector s c, MVector s d) {-# INLINE unzip4 #-} unzip4 (MV_4 n_ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 4 vectors zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d) {-# INLINE_STREAM zip4 #-} zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds {-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds . G.stream (zip4 as bs cs ds) = Stream.zipWith4 (, , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) #-} -- | /O(1)/ Unzip 4 vectors unzip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) {-# INLINE unzip4 #-} unzip4 (V_4 n_ as bs cs ds) = (as, bs, cs, ds) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e) = MV_5 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) data instance Vector (a, b, c, d, e) = V_5 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Unbox (a, b, c, d, e) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => M.MVector MVector (a, b, c, d, e) where {-# INLINE basicLength #-} basicLength (MV_5 n_ as bs cs ds es) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_5 n_ as bs cs ds es) = MV_5 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) (M.basicUnsafeSlice i_ m_ es) {-# INLINE basicOverlaps #-} basicOverlaps (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2 bs2 cs2 ds2 es2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 || M.basicOverlaps es1 es2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ es <- M.basicUnsafeNew n_ return $ MV_5 n_ as bs cs ds es {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d, e) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d es <- M.basicUnsafeReplicate n_ e return $ MV_5 n_ as bs cs ds es {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_5 n_ as bs cs ds es) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ e <- M.basicUnsafeRead es i_ return (a, b, c, d, e) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_5 n_ as bs cs ds es) i_ (a, b, c, d, e) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d M.basicUnsafeWrite es i_ e {-# INLINE basicClear #-} basicClear (MV_5 n_ as bs cs ds es) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds M.basicClear es {-# INLINE basicSet #-} basicSet (MV_5 n_ as bs cs ds es) (a, b, c, d, e) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d M.basicSet es e {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2 bs2 cs2 ds2 es2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 M.basicUnsafeCopy es1 es2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_5 n_1 as1 bs1 cs1 ds1 es1) (MV_5 n_2 as2 bs2 cs2 ds2 es2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 M.basicUnsafeMove es1 es2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_5 n_ as bs cs ds es) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ es' <- M.basicUnsafeGrow es m_ return $ MV_5 (m_+n_) as' bs' cs' ds' es' instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => G.Vector Vector (a, b, c, d, e) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_5 n_ as bs cs ds es) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds es' <- G.basicUnsafeFreeze es return $ V_5 n_ as' bs' cs' ds' es' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_5 n_ as bs cs ds es) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds es' <- G.basicUnsafeThaw es return $ MV_5 n_ as' bs' cs' ds' es' {-# INLINE basicLength #-} basicLength (V_5 n_ as bs cs ds es) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_5 n_ as bs cs ds es) = V_5 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_5 n_ as bs cs ds es) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ e <- G.basicUnsafeIndexM es i_ return (a, b, c, d, e) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (V_5 n_2 as2 bs2 cs2 ds2 es2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 G.basicUnsafeCopy es1 es2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d, e) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d . G.elemseq (undefined :: Vector e) e #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 5 vectors zip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => MVector s a -> MVector s b -> MVector s c -> MVector s d -> MVector s e -> MVector s (a, b, c, d, e) {-# INLINE_STREAM zip5 #-} zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es -- | /O(1)/ Unzip 5 vectors unzip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => MVector s (a, b, c, d, e) -> (MVector s a, MVector s b, MVector s c, MVector s d, MVector s e) {-# INLINE unzip5 #-} unzip5 (MV_5 n_ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 5 vectors zip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e) {-# INLINE_STREAM zip5 #-} zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es {-# RULES "stream/zip5 [Vector.Unboxed]" forall as bs cs ds es . G.stream (zip5 as bs cs ds es) = Stream.zipWith5 (, , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) (G.stream es) #-} -- | /O(1)/ Unzip 5 vectors unzip5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Vector (a, b, c, d, e) -> (Vector a, Vector b, Vector c, Vector d, Vector e) {-# INLINE unzip5 #-} unzip5 (V_5 n_ as bs cs ds es) = (as, bs, cs, ds, es) #endif #ifdef DEFINE_INSTANCES data instance MVector s (a, b, c, d, e, f) = MV_6 {-# UNPACK #-} !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) !(MVector s f) data instance Vector (a, b, c, d, e, f) = V_6 {-# UNPACK #-} !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) !(Vector f) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Unbox (a, b, c, d, e, f) instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => M.MVector MVector (a, b, c, d, e, f) where {-# INLINE basicLength #-} basicLength (MV_6 n_ as bs cs ds es fs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_6 n_ as bs cs ds es fs) = MV_6 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) (M.basicUnsafeSlice i_ m_ cs) (M.basicUnsafeSlice i_ m_ ds) (M.basicUnsafeSlice i_ m_ es) (M.basicUnsafeSlice i_ m_ fs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2 bs2 cs2 ds2 es2 fs2) = M.basicOverlaps as1 as2 || M.basicOverlaps bs1 bs2 || M.basicOverlaps cs1 cs2 || M.basicOverlaps ds1 ds2 || M.basicOverlaps es1 es2 || M.basicOverlaps fs1 fs2 {-# INLINE basicUnsafeNew #-} basicUnsafeNew n_ = do as <- M.basicUnsafeNew n_ bs <- M.basicUnsafeNew n_ cs <- M.basicUnsafeNew n_ ds <- M.basicUnsafeNew n_ es <- M.basicUnsafeNew n_ fs <- M.basicUnsafeNew n_ return $ MV_6 n_ as bs cs ds es fs {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n_ (a, b, c, d, e, f) = do as <- M.basicUnsafeReplicate n_ a bs <- M.basicUnsafeReplicate n_ b cs <- M.basicUnsafeReplicate n_ c ds <- M.basicUnsafeReplicate n_ d es <- M.basicUnsafeReplicate n_ e fs <- M.basicUnsafeReplicate n_ f return $ MV_6 n_ as bs cs ds es fs {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MV_6 n_ as bs cs ds es fs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ c <- M.basicUnsafeRead cs i_ d <- M.basicUnsafeRead ds i_ e <- M.basicUnsafeRead es i_ f <- M.basicUnsafeRead fs i_ return (a, b, c, d, e, f) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_6 n_ as bs cs ds es fs) i_ (a, b, c, d, e, f) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b M.basicUnsafeWrite cs i_ c M.basicUnsafeWrite ds i_ d M.basicUnsafeWrite es i_ e M.basicUnsafeWrite fs i_ f {-# INLINE basicClear #-} basicClear (MV_6 n_ as bs cs ds es fs) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds M.basicClear es M.basicClear fs {-# INLINE basicSet #-} basicSet (MV_6 n_ as bs cs ds es fs) (a, b, c, d, e, f) = do M.basicSet as a M.basicSet bs b M.basicSet cs c M.basicSet ds d M.basicSet es e M.basicSet fs f {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2 bs2 cs2 ds2 es2 fs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 M.basicUnsafeCopy ds1 ds2 M.basicUnsafeCopy es1 es2 M.basicUnsafeCopy fs1 fs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (MV_6 n_2 as2 bs2 cs2 ds2 es2 fs2) = do M.basicUnsafeMove as1 as2 M.basicUnsafeMove bs1 bs2 M.basicUnsafeMove cs1 cs2 M.basicUnsafeMove ds1 ds2 M.basicUnsafeMove es1 es2 M.basicUnsafeMove fs1 fs2 {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow (MV_6 n_ as bs cs ds es fs) m_ = do as' <- M.basicUnsafeGrow as m_ bs' <- M.basicUnsafeGrow bs m_ cs' <- M.basicUnsafeGrow cs m_ ds' <- M.basicUnsafeGrow ds m_ es' <- M.basicUnsafeGrow es m_ fs' <- M.basicUnsafeGrow fs m_ return $ MV_6 (m_+n_) as' bs' cs' ds' es' fs' instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => G.Vector Vector (a, b, c, d, e, f) where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_6 n_ as bs cs ds es fs) = do as' <- G.basicUnsafeFreeze as bs' <- G.basicUnsafeFreeze bs cs' <- G.basicUnsafeFreeze cs ds' <- G.basicUnsafeFreeze ds es' <- G.basicUnsafeFreeze es fs' <- G.basicUnsafeFreeze fs return $ V_6 n_ as' bs' cs' ds' es' fs' {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_6 n_ as bs cs ds es fs) = do as' <- G.basicUnsafeThaw as bs' <- G.basicUnsafeThaw bs cs' <- G.basicUnsafeThaw cs ds' <- G.basicUnsafeThaw ds es' <- G.basicUnsafeThaw es fs' <- G.basicUnsafeThaw fs return $ MV_6 n_ as' bs' cs' ds' es' fs' {-# INLINE basicLength #-} basicLength (V_6 n_ as bs cs ds es fs) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_6 n_ as bs cs ds es fs) = V_6 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) (G.basicUnsafeSlice i_ m_ fs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_6 n_ as bs cs ds es fs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ c <- G.basicUnsafeIndexM cs i_ d <- G.basicUnsafeIndexM ds i_ e <- G.basicUnsafeIndexM es i_ f <- G.basicUnsafeIndexM fs i_ return (a, b, c, d, e, f) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (V_6 n_2 as2 bs2 cs2 ds2 es2 fs2) = do G.basicUnsafeCopy as1 as2 G.basicUnsafeCopy bs1 bs2 G.basicUnsafeCopy cs1 cs2 G.basicUnsafeCopy ds1 ds2 G.basicUnsafeCopy es1 es2 G.basicUnsafeCopy fs1 fs2 {-# INLINE elemseq #-} elemseq _ (a, b, c, d, e, f) = G.elemseq (undefined :: Vector a) a . G.elemseq (undefined :: Vector b) b . G.elemseq (undefined :: Vector c) c . G.elemseq (undefined :: Vector d) d . G.elemseq (undefined :: Vector e) e . G.elemseq (undefined :: Vector f) f #endif #ifdef DEFINE_MUTABLE -- | /O(1)/ Zip 6 vectors zip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox 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) {-# INLINE_STREAM zip6 #-} zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) (unsafeSlice 0 len fs) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es `delayed_min` length fs -- | /O(1)/ Unzip 6 vectors unzip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox 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) {-# INLINE unzip6 #-} unzip6 (MV_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 6 vectors zip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f) {-# INLINE_STREAM zip6 #-} zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) (unsafeSlice 0 len ds) (unsafeSlice 0 len es) (unsafeSlice 0 len fs) where len = length as `delayed_min` length bs `delayed_min` length cs `delayed_min` length ds `delayed_min` length es `delayed_min` length fs {-# RULES "stream/zip6 [Vector.Unboxed]" forall as bs cs ds es fs . G.stream (zip6 as bs cs ds es fs) = Stream.zipWith6 (, , , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds) (G.stream es) (G.stream fs) #-} -- | /O(1)/ Unzip 6 vectors unzip6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Vector (a, b, c, d, e, f) -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) {-# INLINE unzip6 #-} unzip6 (V_6 n_ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif vector-0.10.0.1/Data/0000755000000000000000000000000012035366315012274 5ustar0000000000000000vector-0.10.0.1/Data/Vector.hs0000644000000000000000000012524712035366315014105 0ustar0000000000000000{-# LANGUAGE FlexibleInstances , MultiParamTypeClasses , TypeFamilies , Rank2Types , BangPatterns #-} -- | -- Module : Data.Vector -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- A library for boxed vectors (that is, polymorphic arrays capable of -- holding any Haskell value). The vectors come in two flavours: -- -- * mutable -- -- * immutable -- -- and support a rich interface of both list-like operations, and bulk -- array operations. -- -- For unboxed arrays, use "Data.Vector.Unboxed" -- module Data.Vector ( -- * Boxed vectors Vector, MVector, -- * 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, create, -- ** Unfolding unfoldr, unfoldrN, 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, mapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, zipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, 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, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, -- ** Monadic sequencing sequence, sequence_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', -- * Conversions -- ** Lists toList, fromList, fromListN, -- ** Other vector types G.convert, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where import qualified Data.Vector.Generic as G import Data.Vector.Mutable ( MVector(..) ) import Data.Primitive.Array import qualified Data.Vector.Fusion.Stream as Stream import Control.DeepSeq ( NFData, rnf ) import Control.Monad ( MonadPlus(..), liftM, ap ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, (++), concat, head, last, init, tail, take, drop, splitAt, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, and, or, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_, sequence, sequence_ ) import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) import qualified Control.Applicative as Applicative import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable -- | Boxed vectors, supporting efficient slicing. data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(Array a) deriving ( Typeable ) instance NFData a => NFData (Vector a) where rnf (Vector i n arr) = force i where force !ix | ix < n = rnf (indexArray arr ix) `seq` force (ix+1) | otherwise = () instance Show a => Show (Vector a) where showsPrec = G.showsPrec instance Read a => Read (Vector a) where readPrec = G.readPrec readListPrec = readListPrecDefault instance Data a => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = G.mkType "Data.Vector.Vector" dataCast1 = G.dataCast type instance G.Mutable Vector = MVector instance G.Vector Vector a where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MVector i n marr) = Vector i n `liftM` unsafeFreezeArray marr {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (Vector i n arr) = MVector i n `liftM` unsafeThawArray arr {-# INLINE basicLength #-} basicLength (Vector _ n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (Vector j _ src) = copyArray dst i src j n -- See http://trac.haskell.org/vector/ticket/12 instance Eq a => Eq (Vector a) where {-# INLINE (==) #-} xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance Ord a => Ord (Vector a) where {-# INLINE compare #-} compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty {-# INLINE mappend #-} mappend = (++) {-# INLINE mconcat #-} mconcat = concat instance Functor Vector where {-# INLINE fmap #-} fmap = map instance Monad Vector where {-# INLINE return #-} return = singleton {-# INLINE (>>=) #-} (>>=) = flip concatMap instance MonadPlus Vector where {-# INLINE mzero #-} mzero = empty {-# INLINE mplus #-} mplus = (++) instance Applicative.Applicative Vector where {-# INLINE pure #-} pure = singleton {-# INLINE (<*>) #-} (<*>) = ap instance Applicative.Alternative Vector where {-# INLINE empty #-} empty = empty {-# INLINE (<|>) #-} (<|>) = (++) instance Foldable.Foldable Vector where {-# INLINE foldr #-} foldr = foldr {-# INLINE foldl #-} foldl = foldl {-# INLINE foldr1 #-} foldr1 = foldr1 {-# INLINE foldl1 #-} foldl1 = foldl1 instance Traversable.Traversable Vector where {-# INLINE traverse #-} traverse f xs = fromList Applicative.<$> Traversable.traverse f (toList xs) {-# INLINE mapM #-} mapM = mapM {-# INLINE sequence #-} sequence = sequence -- Length information -- ------------------ -- | /O(1)/ Yield the length of the vector. length :: Vector a -> Int {-# INLINE length #-} length = G.length -- | /O(1)/ Test whether a vector if empty null :: Vector a -> Bool {-# INLINE null #-} null = G.null -- Indexing -- -------- -- | O(1) Indexing (!) :: Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) -- | O(1) Safe indexing (!?) :: Vector a -> Int -> Maybe a {-# INLINE (!?) #-} (!?) = (G.!?) -- | /O(1)/ First element head :: Vector a -> a {-# INLINE head #-} head = G.head -- | /O(1)/ Last element last :: Vector a -> a {-# INLINE last #-} last = G.last -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast -- Monadic indexing -- ---------------- -- | /O(1)/ Indexing in a monad. -- -- The monad allows operations to be strict in the vector when necessary. -- Suppose vector copying is implemented like this: -- -- > copy mv v = ... write mv i (v ! i) ... -- -- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ -- would unnecessarily retain a reference to @v@ in each element written. -- -- With 'indexM', copying can be implemented like this instead: -- -- > copy mv v = ... do -- > x <- indexM v i -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the -- elements) is evaluated eagerly. -- indexM :: Monad m => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: Monad m => Vector a -> m a {-# INLINE headM #-} headM = G.headM -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: Monad m => Vector a -> m a {-# INLINE lastM #-} lastM = G.lastM -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: Monad m => Vector a -> Int -> m a {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: Monad m => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: Monad m => Vector a -> m a {-# INLINE unsafeLastM #-} unsafeLastM = G.unsafeLastM -- Extracting subvectors (slicing) -- ------------------------------- -- | /O(1)/ Yield a slice of the vector without copying it. The vector must -- contain at least @i+n@ elements. slice :: Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE slice #-} slice = G.slice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Vector a -> Vector a {-# INLINE init #-} init = G.init -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Vector a -> Vector a {-# INLINE tail #-} tail = G.tail -- | /O(1)/ Yield at the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop -- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient. {-# INLINE splitAt #-} splitAt :: Int -> Vector a -> (Vector a, Vector a) splitAt = G.splitAt -- | /O(1)/ Yield a slice of the vector without copying. The vector must -- contain at least @i+n@ elements but this is not checked. unsafeSlice :: Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- | /O(1)/ Yield the first @n@ elements without copying. The vector must -- contain at least @n@ elements but this is not checked. unsafeTake :: Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector -- must contain at least @n@ elements but this is not checked. unsafeDrop :: Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop -- Initialisation -- -------------- -- | /O(1)/ Empty vector empty :: Vector a {-# INLINE empty #-} empty = G.empty -- | /O(1)/ Vector with exactly one element singleton :: a -> Vector a {-# INLINE singleton #-} singleton = G.singleton -- | /O(n)/ Vector of the given length with the same value in each position replicate :: Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Int -> (a -> a) -> a -> Vector a {-# INLINE iterateN #-} iterateN = G.iterateN -- Unfolding -- --------- -- | /O(n)/ Construct a vector by repeatedly applying the generator function -- to a seed. The generator function yields 'Just' the next element and the -- new seed or 'Nothing' if there are no more elements. -- -- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f ; c = f in f -- constructN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-} constructN = G.constructN -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f ; c = f in f -- constructrN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-} constructrN = G.constructrN -- Enumeration -- ----------- -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7> enumFromN :: Num a => a -> Int -> Vector a {-# INLINE enumFromN #-} enumFromN = G.enumFromN -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. -- -- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> enumFromStepN :: Num a => a -> a -> Int -> Vector a {-# INLINE enumFromStepN #-} enumFromStepN = G.enumFromStepN -- | /O(n)/ Enumerate values from @x@ to @y@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromN' instead. enumFromTo :: Enum a => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: Enum a => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo -- Concatenation -- ------------- -- | /O(n)/ Prepend an element cons :: a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons -- | /O(n)/ Append an element snoc :: Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) -- | /O(n)/ Concatenate all vectors in the list concat :: [Vector a] -> Vector a {-# INLINE concat #-} concat = G.concat -- Monadic initialisation -- ---------------------- -- | /O(n)/ Execute the monadic action the given number of times and store the -- results in a vector. replicateM :: Monad m => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) {-# INLINE generateM #-} generateM = G.generateM -- | Execute the monadic action and freeze the resulting vector. -- -- @ -- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> -- @ create :: (forall s. ST s (MVector s a)) -> Vector a {-# INLINE create #-} -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p -- Restricting memory usage -- ------------------------ -- | /O(n)/ Yield the argument but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example: -- -- > force (slice 0 2 ) -- -- Here, the slice retains a reference to the huge vector. Forcing it creates -- a copy of just the elements that belong to the slice and allows the huge -- vector to be garbage collected. force :: Vector a -> Vector a {-# INLINE force #-} force = G.force -- Bulk updates -- ------------ -- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector -- element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Vector a -- ^ initial vector (of length @m@) -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE (//) #-} (//) = (G.//) -- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, -- replace the vector element at position @i@ by @a@. -- -- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> -- update :: Vector a -- ^ initial vector (of length @m@) -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) -> Vector a {-# INLINE update #-} update = G.update -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @a@ from the value vector, replace the element of the -- initial vector at position @i@ by @a@. -- -- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> -- -- The function 'update' provides the same functionality and is usually more -- convenient. -- -- @ -- update_ xs is ys = 'update' xs ('zip' is ys) -- @ update_ :: Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector a -- ^ value vector (of length @n2@) -> Vector a {-# INLINE update_ #-} update_ = G.update_ -- | Same as ('//') but without bounds checking. unsafeUpd :: Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd -- | Same as 'update' but without bounds checking. unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a {-# INLINE unsafeUpdate #-} unsafeUpdate = G.unsafeUpdate -- | Same as 'update_' but without bounds checking. unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_ -- Accumulations -- ------------- -- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element -- @a@ at position @i@ by @f a b@. -- -- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> accum :: (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE accum #-} accum = G.accum -- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector -- element @a@ at position @i@ by @f a b@. -- -- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> accumulate :: (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) -> Vector a {-# INLINE accumulate #-} accumulate = G.accumulate -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @b@ from the the value vector, -- replace the element of the initial vector at -- position @i@ by @f a b@. -- -- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> -- -- The function 'accumulate' provides the same functionality and is usually more -- convenient. -- -- @ -- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) -- @ accumulate_ :: (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector b -- ^ value vector (of length @n2@) -> Vector a {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ -- | Same as 'accum' but without bounds checking. unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum -- | Same as 'accumulate' but without bounds checking. unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a {-# INLINE unsafeAccumulate #-} unsafeAccumulate = G.unsafeAccumulate -- | Same as 'accumulate_' but without bounds checking. unsafeAccumulate_ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ = G.unsafeAccumulate_ -- Permutations -- ------------ -- | /O(n)/ Reverse a vector reverse :: Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute :: Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute -- | Same as 'backpermute' but without bounds checking. unsafeBackpermute :: Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ -- | Apply a destructive operation to a vector. The operation will be -- performed in place if it is safe to do so and will modify a copy of the -- vector otherwise. -- -- @ -- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> -- @ modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p -- Indexing -- -------- -- | /O(n)/ Pair each element in a vector with its index indexed :: Vector a -> Vector (Int,a) {-# INLINE indexed #-} indexed = G.indexed -- Mapping -- ------- -- | /O(n)/ Map a function over a vector map :: (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap -- | Map a function over a vector and concatenate the results. concatMap :: (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap -- Monadic mapping -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) {-# INLINE mapM #-} mapM = G.mapM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: Monad m => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results. Equivalent to @flip 'mapM_'@. forM_ :: Monad m => Vector a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = G.forM_ -- Zipping -- ------- -- | /O(min(m,n))/ Zip two vectors with the given function. zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-} zipWith = G.zipWith -- | Zip three vectors with the given function. zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 zipWith4 :: (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE zipWith4 #-} zipWith4 = G.zipWith4 zipWith5 :: (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE zipWith5 #-} zipWith5 = G.zipWith5 zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE zipWith6 #-} zipWith6 = G.zipWith6 -- | /O(min(m,n))/ Zip two vectors with a function that also takes the -- elements' indices. izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE izipWith #-} izipWith = G.izipWith -- | Zip three vectors and their indices with the given function. izipWith3 :: (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE izipWith3 #-} izipWith3 = G.izipWith3 izipWith4 :: (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE izipWith4 #-} izipWith4 = G.izipWith4 izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE izipWith5 #-} izipWith5 = G.izipWith5 izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 -- | Elementwise pairing of array elements. zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-} zip = G.zip -- | zip together three vectors into a vector of triples zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE zip3 #-} zip3 = G.zip3 zip4 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d) {-# INLINE zip4 #-} zip4 = G.zip4 zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e) {-# INLINE zip5 #-} zip5 = G.zip5 zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f) {-# INLINE zip6 #-} zip6 = G.zip6 -- Unzipping -- --------- -- | /O(min(m,n))/ Unzip a vector of pairs. unzip :: Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} unzip = G.unzip unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) {-# INLINE unzip3 #-} unzip3 = G.unzip3 unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) {-# INLINE unzip4 #-} unzip4 = G.unzip4 unzip5 :: Vector (a, b, c, d, e) -> (Vector a, Vector b, Vector c, Vector d, Vector e) {-# INLINE unzip5 #-} unzip5 = G.unzip5 unzip6 :: Vector (a, b, c, d, e, f) -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) {-# INLINE unzip6 #-} unzip6 = G.unzip6 -- Monadic zipping -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a -- vector of results zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE zipWithM #-} zipWithM = G.zipWithM -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ -- Filtering -- --------- -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} filterM = G.filterM -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-} takeWhile = G.takeWhile -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-} dropWhile = G.dropWhile -- Parititioning -- ------------- -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. The -- relative order of the elements is preserved at the cost of a sometimes -- reduced performance compared to 'unstablePartition'. partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE partition #-} partition = G.partition -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often -- faster than 'partition'. unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE span #-} span = G.span -- | /O(n)/ Split the vector into the longest prefix of elements that do not -- satisfy the predicate and the rest without copying. break :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE break #-} break = G.break -- Searching -- --------- infix 4 `elem` -- | /O(n)/ Check if the vector contains an element elem :: Eq a => a -> Vector a -> Bool {-# INLINE elem #-} elem = G.elem infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: Eq a => a -> Vector a -> Bool {-# INLINE notElem #-} notElem = G.notElem -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: (a -> Bool) -> Vector a -> Maybe a {-# INLINE find #-} find = G.find -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: (a -> Bool) -> Vector a -> Maybe Int {-# INLINE findIndex #-} findIndex = G.findIndex -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: (a -> Bool) -> Vector a -> Vector Int {-# INLINE findIndices #-} findIndices = G.findIndices -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: Eq a => a -> Vector a -> Maybe Int {-# INLINE elemIndex #-} elemIndex = G.elemIndex -- | /O(n)/ Yield the indices of all occurences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: Eq a => a -> Vector a -> Vector Int {-# INLINE elemIndices #-} elemIndices = G.elemIndices -- Folding -- ------- -- | /O(n)/ Left fold foldl :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-} foldl = G.foldl -- | /O(n)/ Left fold on non-empty vectors foldl1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1 -- | /O(n)/ Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-} foldl' = G.foldl' -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-} foldl1' = G.foldl1' -- | /O(n)/ Right fold foldr :: (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-} foldr = G.foldr -- | /O(n)/ Right fold on non-empty vectors foldr1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-} foldr1 = G.foldr1 -- | /O(n)/ Right fold with a strict accumulator foldr' :: (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr' #-} foldr' = G.foldr' -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: (a -> a -> a) -> Vector a -> a {-# INLINE foldr1' #-} foldr1' = G.foldr1' -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl #-} ifoldl = G.ifoldl -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl' #-} ifoldl' = G.ifoldl' -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr #-} ifoldr = G.ifoldr -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr' #-} ifoldr' = G.ifoldr' -- Specialised folds -- ----------------- -- | /O(n)/ Check if all elements satisfy the predicate. all :: (a -> Bool) -> Vector a -> Bool {-# INLINE all #-} all = G.all -- | /O(n)/ Check if any element satisfies the predicate. any :: (a -> Bool) -> Vector a -> Bool {-# INLINE any #-} any = G.any -- | /O(n)/ Check if all elements are 'True' and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and -- | /O(n)/ Check if any element is 'True' or :: Vector Bool -> Bool {-# INLINE or #-} or = G.or -- | /O(n)/ Compute the sum of the elements sum :: Num a => Vector a -> a {-# INLINE sum #-} sum = G.sum -- | /O(n)/ Compute the produce of the elements product :: Num a => Vector a -> a {-# INLINE product #-} product = G.product -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: Ord a => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy -- | /O(n)/ Yield the minimum element of the vector. The vector may not be -- empty. minimum :: Ord a => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: Ord a => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex -- | /O(n)/ Yield the index of the maximum element of the vector according to -- the given comparison function. The vector may not be empty. maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy -- | /O(n)/ Yield the index of the minimum element of the vector. The vector -- may not be empty. minIndex :: Ord a => Vector a -> Int {-# INLINE minIndex #-} minIndex = G.minIndex -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty. minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy -- Monadic folds -- ------------- -- | /O(n)/ Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM #-} foldM = G.foldM -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-} fold1M = G.fold1M -- | /O(n)/ Monadic fold with strict accumulator foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM' #-} foldM' = G.foldM' -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' -- | /O(n)/ Monadic fold that discards the result foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM_ #-} foldM_ = G.foldM_ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-} fold1M_ = G.fold1M_ -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_ -- Monadic sequencing -- ------------------ -- | Evaluate each action and collect the results sequence :: Monad m => Vector (m a) -> m (Vector a) {-# INLINE sequence #-} sequence = G.sequence -- | Evaluate each action and discard the results sequence_ :: Monad m => Vector (m a) -> m () {-# INLINE sequence_ #-} sequence_ = G.sequence_ -- Prefix sums (scans) -- ------------------- -- | /O(n)/ Prescan -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ -- -- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ -- prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-} prescanl = G.prescanl -- | /O(n)/ Prescan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-} prescanl' = G.prescanl' -- | /O(n)/ Scan -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ -- -- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ -- postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl #-} postscanl = G.postscanl -- | /O(n)/ Scan with strict accumulator postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl' #-} postscanl' = G.postscanl' -- | /O(n)/ Haskell-style scan -- -- > scanl f z = -- > where y1 = z -- > yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ -- scanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl' #-} scanl' = G.scanl' -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = -- > where y1 = x1 -- > yi = f y(i-1) xi -- scanl1 :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1 #-} scanl1 = G.scanl1 -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1' #-} scanl1' = G.scanl1' -- | /O(n)/ Right-to-left prescan -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @ -- prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-} prescanr = G.prescanr -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr' #-} prescanr' = G.prescanr' -- | /O(n)/ Right-to-left scan postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr #-} postscanr = G.postscanr -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr' #-} postscanr' = G.postscanr' -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr #-} scanr = G.scanr -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr' #-} scanr' = G.scanr' -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} scanr1 = G.scanr1 -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1' #-} scanr1' = G.scanr1' -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Vector a -> [a] {-# INLINE toList #-} toList = G.toList -- | /O(n)/ Convert a list to a vector fromList :: [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector -- -- @ -- fromListN n xs = 'fromList' ('take' n xs) -- @ fromListN :: Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN -- Conversions - Mutable vectors -- ----------------------------- -- | /O(1)/ Unsafe convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) {-# INLINE unsafeFreeze #-} unsafeFreeze = G.unsafeFreeze -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) {-# INLINE unsafeThaw #-} unsafeThaw = G.unsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) {-# INLINE thaw #-} thaw = G.thaw -- | /O(n)/ Yield an immutable copy of the mutable vector. freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) {-# INLINE freeze #-} freeze = G.freeze -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy vector-0.10.0.1/Data/Vector/0000755000000000000000000000000012035366315013536 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Storable.hs0000644000000000000000000012750012035366315015652 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Storable -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- 'Storable'-based vectors. -- module Data.Vector.Storable ( -- * Storable vectors Vector, MVector(..), Storable, -- * 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, create, -- ** Unfolding unfoldr, unfoldrN, constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- ** Concatenation cons, snoc, (++), concat, -- ** Restricting memory usage force, -- * Modifying vectors -- ** Bulk updates (//), update_, unsafeUpd, unsafeUpdate_, -- ** Accumulations accum, accumulate_, unsafeAccum, unsafeAccumulate_, -- ** Permutations reverse, backpermute, unsafeBackpermute, -- ** Safe destructive updates modify, -- * Elementwise operations -- ** Mapping map, imap, concatMap, -- ** Monadic mapping mapM, mapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, -- ** Monadic zipping zipWithM, zipWithM_, -- * Working with predicates -- ** Filtering filter, ifilter, 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, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', -- * Conversions -- ** Lists toList, fromList, fromListN, -- ** Other vector types G.convert, unsafeCast, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, -- * Raw pointers unsafeFromForeignPtr, unsafeFromForeignPtr0, unsafeToForeignPtr, unsafeToForeignPtr0, unsafeWith ) where import qualified Data.Vector.Generic as G import Data.Vector.Storable.Mutable ( MVector(..) ) import Data.Vector.Storable.Internal import qualified Data.Vector.Fusion.Stream as Stream import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray ) import Control.DeepSeq ( NFData ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, (++), concat, head, last, init, tail, take, drop, splitAt, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, and, or, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_ ) import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #include "vector.h" -- | 'Storable'-based vectors data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) instance NFData (Vector a) instance (Show a, Storable a) => Show (Vector a) where showsPrec = G.showsPrec instance (Read a, Storable a) => Read (Vector a) where readPrec = G.readPrec readListPrec = readListPrecDefault instance (Data a, Storable a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector" dataCast1 = G.dataCast type instance G.Mutable Vector = MVector instance Storable a => G.Vector Vector a where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MVector n fp) = return $ Vector n fp {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (Vector n fp) = return $ MVector n fp {-# INLINE basicLength #-} basicLength (Vector n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (Vector _ fp) i = return . unsafeInlineIO $ withForeignPtr fp $ \p -> peekElemOff p i {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector n fp) (Vector _ fq) = unsafePrimToPrim $ withForeignPtr fp $ \p -> withForeignPtr fq $ \q -> copyArray p q n {-# INLINE elemseq #-} elemseq _ = seq -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Ord a) => Ord (Vector a) where {-# INLINE compare #-} compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Storable a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty {-# INLINE mappend #-} mappend = (++) {-# INLINE mconcat #-} mconcat = concat -- Length -- ------ -- | /O(1)/ Yield the length of the vector. length :: Storable a => Vector a -> Int {-# INLINE length #-} length = G.length -- | /O(1)/ Test whether a vector if empty null :: Storable a => Vector a -> Bool {-# INLINE null #-} null = G.null -- Indexing -- -------- -- | O(1) Indexing (!) :: Storable a => Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) -- | O(1) Safe indexing (!?) :: Storable a => Vector a -> Int -> Maybe a {-# INLINE (!?) #-} (!?) = (G.!?) -- | /O(1)/ First element head :: Storable a => Vector a -> a {-# INLINE head #-} head = G.head -- | /O(1)/ Last element last :: Storable a => Vector a -> a {-# INLINE last #-} last = G.last -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Storable a => Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Storable a => Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Storable a => Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast -- Monadic indexing -- ---------------- -- | /O(1)/ Indexing in a monad. -- -- The monad allows operations to be strict in the vector when necessary. -- Suppose vector copying is implemented like this: -- -- > copy mv v = ... write mv i (v ! i) ... -- -- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ -- would unnecessarily retain a reference to @v@ in each element written. -- -- With 'indexM', copying can be implemented like this instead: -- -- > copy mv v = ... do -- > x <- indexM v i -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the -- elements) is evaluated eagerly. -- indexM :: (Storable a, Monad m) => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Storable a, Monad m) => Vector a -> m a {-# INLINE headM #-} headM = G.headM -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Storable a, Monad m) => Vector a -> m a {-# INLINE lastM #-} lastM = G.lastM -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Storable a, Monad m) => Vector a -> m a {-# INLINE unsafeLastM #-} unsafeLastM = G.unsafeLastM -- Extracting subvectors (slicing) -- ------------------------------- -- | /O(1)/ Yield a slice of the vector without copying it. The vector must -- contain at least @i+n@ elements. slice :: Storable a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE slice #-} slice = G.slice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Storable a => Vector a -> Vector a {-# INLINE init #-} init = G.init -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Storable a => Vector a -> Vector a {-# INLINE tail #-} tail = G.tail -- | /O(1)/ Yield at the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Storable a => Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Storable a => Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop -- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient. {-# INLINE splitAt #-} splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) splitAt = G.splitAt -- | /O(1)/ Yield a slice of the vector without copying. The vector must -- contain at least @i+n@ elements but this is not checked. unsafeSlice :: Storable a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Storable a => Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Storable a => Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- | /O(1)/ Yield the first @n@ elements without copying. The vector must -- contain at least @n@ elements but this is not checked. unsafeTake :: Storable a => Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector -- must contain at least @n@ elements but this is not checked. unsafeDrop :: Storable a => Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop -- Initialisation -- -------------- -- | /O(1)/ Empty vector empty :: Storable a => Vector a {-# INLINE empty #-} empty = G.empty -- | /O(1)/ Vector with exactly one element singleton :: Storable a => a -> Vector a {-# INLINE singleton #-} singleton = G.singleton -- | /O(n)/ Vector of the given length with the same value in each position replicate :: Storable a => Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Storable a => Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a {-# INLINE iterateN #-} iterateN = G.iterateN -- Unfolding -- --------- -- | /O(n)/ Construct a vector by repeatedly applying the generator function -- to a seed. The generator function yields 'Just' the next element and the -- new seed or 'Nothing' if there are no more elements. -- -- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f ; c = f in f -- constructN :: Storable a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-} constructN = G.constructN -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f ; c = f in f -- constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-} constructrN = G.constructrN -- Enumeration -- ----------- -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7> enumFromN :: (Storable a, Num a) => a -> Int -> Vector a {-# INLINE enumFromN #-} enumFromN = G.enumFromN -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. -- -- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> enumFromStepN :: (Storable a, Num a) => a -> a -> Int -> Vector a {-# INLINE enumFromStepN #-} enumFromStepN = G.enumFromStepN -- | /O(n)/ Enumerate values from @x@ to @y@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromN' instead. enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo -- Concatenation -- ------------- -- | /O(n)/ Prepend an element cons :: Storable a => a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons -- | /O(n)/ Append an element snoc :: Storable a => Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Storable a => Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) -- | /O(n)/ Concatenate all vectors in the list concat :: Storable a => [Vector a] -> Vector a {-# INLINE concat #-} concat = G.concat -- Monadic initialisation -- ---------------------- -- | /O(n)/ Execute the monadic action the given number of times and store the -- results in a vector. replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) {-# INLINE generateM #-} generateM = G.generateM -- | Execute the monadic action and freeze the resulting vector. -- -- @ -- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> -- @ create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a {-# INLINE create #-} -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p -- Restricting memory usage -- ------------------------ -- | /O(n)/ Yield the argument but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example: -- -- > force (slice 0 2 ) -- -- Here, the slice retains a reference to the huge vector. Forcing it creates -- a copy of just the elements that belong to the slice and allows the huge -- vector to be garbage collected. force :: Storable a => Vector a -> Vector a {-# INLINE force #-} force = G.force -- Bulk updates -- ------------ -- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector -- element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Storable a => Vector a -- ^ initial vector (of length @m@) -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE (//) #-} (//) = (G.//) -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @a@ from the value vector, replace the element of the -- initial vector at position @i@ by @a@. -- -- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> -- update_ :: Storable a => Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector a -- ^ value vector (of length @n2@) -> Vector a {-# INLINE update_ #-} update_ = G.update_ -- | Same as ('//') but without bounds checking. unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd -- | Same as 'update_' but without bounds checking. unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_ -- Accumulations -- ------------- -- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element -- @a@ at position @i@ by @f a b@. -- -- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> accum :: Storable a => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE accum #-} accum = G.accum -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @b@ from the the value vector, -- replace the element of the initial vector at -- position @i@ by @f a b@. -- -- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> -- accumulate_ :: (Storable a, Storable b) => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector b -- ^ value vector (of length @n2@) -> Vector a {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ -- | Same as 'accum' but without bounds checking. unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum -- | Same as 'accumulate_' but without bounds checking. unsafeAccumulate_ :: (Storable a, Storable b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ = G.unsafeAccumulate_ -- Permutations -- ------------ -- | /O(n)/ Reverse a vector reverse :: Storable a => Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute :: Storable a => Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute -- | Same as 'backpermute' but without bounds checking. unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ -- | Apply a destructive operation to a vector. The operation will be -- performed in place if it is safe to do so and will modify a copy of the -- vector otherwise. -- -- @ -- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> -- @ modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p -- Mapping -- ------- -- | /O(n)/ Map a function over a vector map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap -- | Map a function over a vector and concatenate the results. concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap -- Monadic mapping -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b) {-# INLINE mapM #-} mapM = G.mapM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Storable a) => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results. Equivalent to @flip 'mapM_'@. forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = G.forM_ -- Zipping -- ------- -- | /O(min(m,n))/ Zip two vectors with the given function. zipWith :: (Storable a, Storable b, Storable c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-} zipWith = G.zipWith -- | Zip three vectors with the given function. zipWith3 :: (Storable a, Storable b, Storable c, Storable d) => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) => (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE zipWith4 #-} zipWith4 = G.zipWith4 zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f) => (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE zipWith5 #-} zipWith5 = G.zipWith5 zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) => (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE zipWith6 #-} zipWith6 = G.zipWith6 -- | /O(min(m,n))/ Zip two vectors with a function that also takes the -- elements' indices. izipWith :: (Storable a, Storable b, Storable c) => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE izipWith #-} izipWith = G.izipWith -- | Zip three vectors and their indices with the given function. izipWith3 :: (Storable a, Storable b, Storable c, Storable d) => (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE izipWith3 #-} izipWith3 = G.izipWith3 izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) => (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE izipWith4 #-} izipWith4 = G.izipWith4 izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f) => (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE izipWith5 #-} izipWith5 = G.izipWith5 izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) => (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 -- Monadic zipping -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a -- vector of results zipWithM :: (Monad m, Storable a, Storable b, Storable c) => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE zipWithM #-} zipWithM = G.zipWithM -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Storable a, Storable b) => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ -- Filtering -- --------- -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Storable a => (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} filterM = G.filterM -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-} takeWhile = G.takeWhile -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-} dropWhile = G.dropWhile -- Parititioning -- ------------- -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. The -- relative order of the elements is preserved at the cost of a sometimes -- reduced performance compared to 'unstablePartition'. partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE partition #-} partition = G.partition -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often -- faster than 'partition'. unstablePartition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE span #-} span = G.span -- | /O(n)/ Split the vector into the longest prefix of elements that do not -- satisfy the predicate and the rest without copying. break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE break #-} break = G.break -- Searching -- --------- infix 4 `elem` -- | /O(n)/ Check if the vector contains an element elem :: (Storable a, Eq a) => a -> Vector a -> Bool {-# INLINE elem #-} elem = G.elem infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Storable a, Eq a) => a -> Vector a -> Bool {-# INLINE notElem #-} notElem = G.notElem -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Storable a => (a -> Bool) -> Vector a -> Maybe a {-# INLINE find #-} find = G.find -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int {-# INLINE findIndex #-} findIndex = G.findIndex -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int {-# INLINE findIndices #-} findIndices = G.findIndices -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int {-# INLINE elemIndex #-} elemIndex = G.elemIndex -- | /O(n)/ Yield the indices of all occurences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int {-# INLINE elemIndices #-} elemIndices = G.elemIndices -- Folding -- ------- -- | /O(n)/ Left fold foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-} foldl = G.foldl -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1 -- | /O(n)/ Left fold with strict accumulator foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-} foldl' = G.foldl' -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-} foldl1' = G.foldl1' -- | /O(n)/ Right fold foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-} foldr = G.foldr -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-} foldr1 = G.foldr1 -- | /O(n)/ Right fold with a strict accumulator foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr' #-} foldr' = G.foldr' -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1' #-} foldr1' = G.foldr1' -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl #-} ifoldl = G.ifoldl -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl' #-} ifoldl' = G.ifoldl' -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr #-} ifoldr = G.ifoldr -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr' #-} ifoldr' = G.ifoldr' -- Specialised folds -- ----------------- -- | /O(n)/ Check if all elements satisfy the predicate. all :: Storable a => (a -> Bool) -> Vector a -> Bool {-# INLINE all #-} all = G.all -- | /O(n)/ Check if any element satisfies the predicate. any :: Storable a => (a -> Bool) -> Vector a -> Bool {-# INLINE any #-} any = G.any -- | /O(n)/ Check if all elements are 'True' and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and -- | /O(n)/ Check if any element is 'True' or :: Vector Bool -> Bool {-# INLINE or #-} or = G.or -- | /O(n)/ Compute the sum of the elements sum :: (Storable a, Num a) => Vector a -> a {-# INLINE sum #-} sum = G.sum -- | /O(n)/ Compute the produce of the elements product :: (Storable a, Num a) => Vector a -> a {-# INLINE product #-} product = G.product -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Storable a, Ord a) => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy -- | /O(n)/ Yield the minimum element of the vector. The vector may not be -- empty. minimum :: (Storable a, Ord a) => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: (Storable a, Ord a) => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex -- | /O(n)/ Yield the index of the maximum element of the vector according to -- the given comparison function. The vector may not be empty. maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy -- | /O(n)/ Yield the index of the minimum element of the vector. The vector -- may not be empty. minIndex :: (Storable a, Ord a) => Vector a -> Int {-# INLINE minIndex #-} minIndex = G.minIndex -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty. minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy -- Monadic folds -- ------------- -- | /O(n)/ Monadic fold foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM #-} foldM = G.foldM -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-} fold1M = G.fold1M -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM' #-} foldM' = G.foldM' -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM_ #-} foldM_ = G.foldM_ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-} fold1M_ = G.fold1M_ -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_ -- Prefix sums (scans) -- ------------------- -- | /O(n)/ Prescan -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ -- -- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ -- prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-} prescanl = G.prescanl -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-} prescanl' = G.prescanl' -- | /O(n)/ Scan -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ -- -- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ -- postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl #-} postscanl = G.postscanl -- | /O(n)/ Scan with strict accumulator postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl' #-} postscanl' = G.postscanl' -- | /O(n)/ Haskell-style scan -- -- > scanl f z = -- > where y1 = z -- > yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ -- scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl' #-} scanl' = G.scanl' -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = -- > where y1 = x1 -- > yi = f y(i-1) xi -- scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1 #-} scanl1 = G.scanl1 -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1' #-} scanl1' = G.scanl1' -- | /O(n)/ Right-to-left prescan -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @ -- prescanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-} prescanr = G.prescanr -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr' #-} prescanr' = G.prescanr' -- | /O(n)/ Right-to-left scan postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr #-} postscanr = G.postscanr -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr' #-} postscanr' = G.postscanr' -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr #-} scanr = G.scanr -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr' #-} scanr' = G.scanr' -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} scanr1 = G.scanr1 -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1' #-} scanr1' = G.scanr1' -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Storable a => Vector a -> [a] {-# INLINE toList #-} toList = G.toList -- | /O(n)/ Convert a list to a vector fromList :: Storable a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector -- -- @ -- fromListN n xs = 'fromList' ('take' n xs) -- @ fromListN :: Storable a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN -- Conversions - Unsafe casts -- -------------------------- -- | /O(1)/ Unsafely cast a vector from one element type to another. -- The operation just changes the type of the underlying pointer and does not -- modify the elements. -- -- The resulting vector contains as many elements as can fit into the -- underlying memory block. -- unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b {-# INLINE unsafeCast #-} unsafeCast (Vector n fp) = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp) -- Conversions - Mutable vectors -- ----------------------------- -- | /O(1)/ Unsafe convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE unsafeFreeze #-} unsafeFreeze = G.unsafeFreeze -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE unsafeThaw #-} unsafeThaw = G.unsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE thaw #-} thaw = G.thaw -- | /O(n)/ Yield an immutable copy of the mutable vector. freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE freeze #-} freeze = G.freeze -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy -- Conversions - Raw pointers -- -------------------------- -- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length. -- -- The data may not be modified through the 'ForeignPtr' afterwards. -- -- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. unsafeFromForeignPtr :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ offset -> Int -- ^ length -> Vector a {-# INLINE unsafeFromForeignPtr #-} unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n where fp' = updPtr (`advancePtr` i) fp {-# RULES "unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} -- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. -- -- It is assumed the pointer points directly to the data (no offset). -- Use `unsafeFromForeignPtr` if you need to specify an offset. -- -- The data may not be modified through the 'ForeignPtr' afterwards. unsafeFromForeignPtr0 :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ length -> Vector a {-# INLINE unsafeFromForeignPtr0 #-} unsafeFromForeignPtr0 fp n = Vector n fp -- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the -- data and its length. The data may not be modified through the 'ForeignPtr'. unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} unsafeToForeignPtr (Vector n fp) = (fp, 0, n) -- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. -- -- You can assume the pointer points directly to the data (no offset). -- -- The data may not be modified through the 'ForeignPtr'. unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int) {-# INLINE unsafeToForeignPtr0 #-} unsafeToForeignPtr0 (Vector n fp) = (fp, n) -- | Pass a pointer to the vector's data to the IO action. The data may not be -- modified through the 'Ptr. unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-} unsafeWith (Vector n fp) = withForeignPtr fp vector-0.10.0.1/Data/Vector/Primitive.hs0000644000000000000000000011766212035366315016057 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} -- | -- Module : Data.Vector.Primitive -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Unboxed vectors of primitive types. The use of this module is not -- recommended except in very special cases. Adaptive unboxed vectors defined -- in "Data.Vector.Unboxed" are significantly more flexible at no performance -- cost. -- module Data.Vector.Primitive ( -- * Primitive vectors Vector, MVector(..), Prim, -- * 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, create, -- ** Unfolding unfoldr, unfoldrN, constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- ** Concatenation cons, snoc, (++), concat, -- ** Restricting memory usage force, -- * Modifying vectors -- ** Bulk updates (//), update_, unsafeUpd, unsafeUpdate_, -- ** Accumulations accum, accumulate_, unsafeAccum, unsafeAccumulate_, -- ** Permutations reverse, backpermute, unsafeBackpermute, -- ** Safe destructive updates modify, -- * Elementwise operations -- ** Mapping map, imap, concatMap, -- ** Monadic mapping mapM, mapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, -- ** Monadic zipping zipWithM, zipWithM_, -- * Working with predicates -- ** Filtering filter, ifilter, 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, sum, product, maximum, maximumBy, minimum, minimumBy, minIndex, minIndexBy, maxIndex, maxIndexBy, -- ** Monadic folds foldM, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', -- * Conversions -- ** Lists toList, fromList, fromListN, -- ** Other vector types G.convert, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where import qualified Data.Vector.Generic as G import Data.Vector.Primitive.Mutable ( MVector(..) ) import qualified Data.Vector.Fusion.Stream as Stream import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) import Control.DeepSeq ( NFData ) import Control.Monad ( liftM ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, (++), concat, head, last, init, tail, take, drop, splitAt, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_ ) import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) -- | Unboxed vectors of primitive types data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !ByteArray deriving ( Typeable ) instance NFData (Vector a) instance (Show a, Prim a) => Show (Vector a) where showsPrec = G.showsPrec instance (Read a, Prim a) => Read (Vector a) where readPrec = G.readPrec readListPrec = readListPrecDefault instance (Data a, Prim a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector" dataCast1 = G.dataCast type instance G.Mutable Vector = MVector instance Prim a => G.Vector Vector a where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MVector i n marr) = Vector i n `liftM` unsafeFreezeByteArray marr {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (Vector i n arr) = MVector i n `liftM` unsafeThawByteArray arr {-# INLINE basicLength #-} basicLength (Vector _ n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (Vector i _ arr) j = return $! indexByteArray arr (i+j) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (Vector j _ src) = copyByteArray dst (i*sz) src (j*sz) (n*sz) where sz = sizeOf (undefined :: a) {-# INLINE elemseq #-} elemseq _ = seq -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Ord a) => Ord (Vector a) where {-# INLINE compare #-} compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Prim a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty {-# INLINE mappend #-} mappend = (++) {-# INLINE mconcat #-} mconcat = concat -- Length -- ------ -- | /O(1)/ Yield the length of the vector. length :: Prim a => Vector a -> Int {-# INLINE length #-} length = G.length -- | /O(1)/ Test whether a vector if empty null :: Prim a => Vector a -> Bool {-# INLINE null #-} null = G.null -- Indexing -- -------- -- | O(1) Indexing (!) :: Prim a => Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) -- | O(1) Safe indexing (!?) :: Prim a => Vector a -> Int -> Maybe a {-# INLINE (!?) #-} (!?) = (G.!?) -- | /O(1)/ First element head :: Prim a => Vector a -> a {-# INLINE head #-} head = G.head -- | /O(1)/ Last element last :: Prim a => Vector a -> a {-# INLINE last #-} last = G.last -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Prim a => Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Prim a => Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Prim a => Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast -- Monadic indexing -- ---------------- -- | /O(1)/ Indexing in a monad. -- -- The monad allows operations to be strict in the vector when necessary. -- Suppose vector copying is implemented like this: -- -- > copy mv v = ... write mv i (v ! i) ... -- -- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ -- would unnecessarily retain a reference to @v@ in each element written. -- -- With 'indexM', copying can be implemented like this instead: -- -- > copy mv v = ... do -- > x <- indexM v i -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the -- elements) is evaluated eagerly. -- indexM :: (Prim a, Monad m) => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Prim a, Monad m) => Vector a -> m a {-# INLINE headM #-} headM = G.headM -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Prim a, Monad m) => Vector a -> m a {-# INLINE lastM #-} lastM = G.lastM -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Prim a, Monad m) => Vector a -> m a {-# INLINE unsafeLastM #-} unsafeLastM = G.unsafeLastM -- Extracting subvectors (slicing) -- ------------------------------- -- | /O(1)/ Yield a slice of the vector without copying it. The vector must -- contain at least @i+n@ elements. slice :: Prim a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE slice #-} slice = G.slice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Prim a => Vector a -> Vector a {-# INLINE init #-} init = G.init -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Prim a => Vector a -> Vector a {-# INLINE tail #-} tail = G.tail -- | /O(1)/ Yield at the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Prim a => Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Prim a => Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop -- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient. {-# INLINE splitAt #-} splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) splitAt = G.splitAt -- | /O(1)/ Yield a slice of the vector without copying. The vector must -- contain at least @i+n@ elements but this is not checked. unsafeSlice :: Prim a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Prim a => Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Prim a => Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- | /O(1)/ Yield the first @n@ elements without copying. The vector must -- contain at least @n@ elements but this is not checked. unsafeTake :: Prim a => Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector -- must contain at least @n@ elements but this is not checked. unsafeDrop :: Prim a => Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop -- Initialisation -- -------------- -- | /O(1)/ Empty vector empty :: Prim a => Vector a {-# INLINE empty #-} empty = G.empty -- | /O(1)/ Vector with exactly one element singleton :: Prim a => a -> Vector a {-# INLINE singleton #-} singleton = G.singleton -- | /O(n)/ Vector of the given length with the same value in each position replicate :: Prim a => Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Prim a => Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a {-# INLINE iterateN #-} iterateN = G.iterateN -- Unfolding -- --------- -- | /O(n)/ Construct a vector by repeatedly applying the generator function -- to a seed. The generator function yields 'Just' the next element and the -- new seed or 'Nothing' if there are no more elements. -- -- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f ; c = f in f -- constructN :: Prim a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-} constructN = G.constructN -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f ; c = f in f -- constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-} constructrN = G.constructrN -- Enumeration -- ----------- -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7> enumFromN :: (Prim a, Num a) => a -> Int -> Vector a {-# INLINE enumFromN #-} enumFromN = G.enumFromN -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. -- -- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> enumFromStepN :: (Prim a, Num a) => a -> a -> Int -> Vector a {-# INLINE enumFromStepN #-} enumFromStepN = G.enumFromStepN -- | /O(n)/ Enumerate values from @x@ to @y@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromN' instead. enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo -- Concatenation -- ------------- -- | /O(n)/ Prepend an element cons :: Prim a => a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons -- | /O(n)/ Append an element snoc :: Prim a => Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Prim a => Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) -- | /O(n)/ Concatenate all vectors in the list concat :: Prim a => [Vector a] -> Vector a {-# INLINE concat #-} concat = G.concat -- Monadic initialisation -- ---------------------- -- | /O(n)/ Execute the monadic action the given number of times and store the -- results in a vector. replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) {-# INLINE generateM #-} generateM = G.generateM -- | Execute the monadic action and freeze the resulting vector. -- -- @ -- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> -- @ create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a {-# INLINE create #-} -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p -- Restricting memory usage -- ------------------------ -- | /O(n)/ Yield the argument but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example: -- -- > force (slice 0 2 ) -- -- Here, the slice retains a reference to the huge vector. Forcing it creates -- a copy of just the elements that belong to the slice and allows the huge -- vector to be garbage collected. force :: Prim a => Vector a -> Vector a {-# INLINE force #-} force = G.force -- Bulk updates -- ------------ -- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector -- element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Prim a => Vector a -- ^ initial vector (of length @m@) -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE (//) #-} (//) = (G.//) -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @a@ from the value vector, replace the element of the -- initial vector at position @i@ by @a@. -- -- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> -- update_ :: Prim a => Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector a -- ^ value vector (of length @n2@) -> Vector a {-# INLINE update_ #-} update_ = G.update_ -- | Same as ('//') but without bounds checking. unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd -- | Same as 'update_' but without bounds checking. unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_ -- Accumulations -- ------------- -- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element -- @a@ at position @i@ by @f a b@. -- -- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> accum :: Prim a => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE accum #-} accum = G.accum -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @b@ from the the value vector, -- replace the element of the initial vector at -- position @i@ by @f a b@. -- -- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> -- accumulate_ :: (Prim a, Prim b) => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector b -- ^ value vector (of length @n2@) -> Vector a {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ -- | Same as 'accum' but without bounds checking. unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum -- | Same as 'accumulate_' but without bounds checking. unsafeAccumulate_ :: (Prim a, Prim b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ = G.unsafeAccumulate_ -- Permutations -- ------------ -- | /O(n)/ Reverse a vector reverse :: Prim a => Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute :: Prim a => Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute -- | Same as 'backpermute' but without bounds checking. unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ -- | Apply a destructive operation to a vector. The operation will be -- performed in place if it is safe to do so and will modify a copy of the -- vector otherwise. -- -- @ -- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> -- @ modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p -- Mapping -- ------- -- | /O(n)/ Map a function over a vector map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap -- | Map a function over a vector and concatenate the results. concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap -- Monadic mapping -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b) {-# INLINE mapM #-} mapM = G.mapM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Prim a) => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results. Equivalent to @flip 'mapM_'@. forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = G.forM_ -- Zipping -- ------- -- | /O(min(m,n))/ Zip two vectors with the given function. zipWith :: (Prim a, Prim b, Prim c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-} zipWith = G.zipWith -- | Zip three vectors with the given function. zipWith3 :: (Prim a, Prim b, Prim c, Prim d) => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) => (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE zipWith4 #-} zipWith4 = G.zipWith4 zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f) => (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE zipWith5 #-} zipWith5 = G.zipWith5 zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g) => (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE zipWith6 #-} zipWith6 = G.zipWith6 -- | /O(min(m,n))/ Zip two vectors with a function that also takes the -- elements' indices. izipWith :: (Prim a, Prim b, Prim c) => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE izipWith #-} izipWith = G.izipWith -- | Zip three vectors and their indices with the given function. izipWith3 :: (Prim a, Prim b, Prim c, Prim d) => (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE izipWith3 #-} izipWith3 = G.izipWith3 izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) => (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE izipWith4 #-} izipWith4 = G.izipWith4 izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f) => (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE izipWith5 #-} izipWith5 = G.izipWith5 izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, Prim f, Prim g) => (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 -- Monadic zipping -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a -- vector of results zipWithM :: (Monad m, Prim a, Prim b, Prim c) => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE zipWithM #-} zipWithM = G.zipWithM -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Prim a, Prim b) => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ -- Filtering -- --------- -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Prim a => (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} filterM = G.filterM -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-} takeWhile = G.takeWhile -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-} dropWhile = G.dropWhile -- Parititioning -- ------------- -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. The -- relative order of the elements is preserved at the cost of a sometimes -- reduced performance compared to 'unstablePartition'. partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE partition #-} partition = G.partition -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often -- faster than 'partition'. unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE span #-} span = G.span -- | /O(n)/ Split the vector into the longest prefix of elements that do not -- satisfy the predicate and the rest without copying. break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE break #-} break = G.break -- Searching -- --------- infix 4 `elem` -- | /O(n)/ Check if the vector contains an element elem :: (Prim a, Eq a) => a -> Vector a -> Bool {-# INLINE elem #-} elem = G.elem infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Prim a, Eq a) => a -> Vector a -> Bool {-# INLINE notElem #-} notElem = G.notElem -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Prim a => (a -> Bool) -> Vector a -> Maybe a {-# INLINE find #-} find = G.find -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int {-# INLINE findIndex #-} findIndex = G.findIndex -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int {-# INLINE findIndices #-} findIndices = G.findIndices -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int {-# INLINE elemIndex #-} elemIndex = G.elemIndex -- | /O(n)/ Yield the indices of all occurences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int {-# INLINE elemIndices #-} elemIndices = G.elemIndices -- Folding -- ------- -- | /O(n)/ Left fold foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-} foldl = G.foldl -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1 -- | /O(n)/ Left fold with strict accumulator foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-} foldl' = G.foldl' -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-} foldl1' = G.foldl1' -- | /O(n)/ Right fold foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-} foldr = G.foldr -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-} foldr1 = G.foldr1 -- | /O(n)/ Right fold with a strict accumulator foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr' #-} foldr' = G.foldr' -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1' #-} foldr1' = G.foldr1' -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl #-} ifoldl = G.ifoldl -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl' #-} ifoldl' = G.ifoldl' -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr #-} ifoldr = G.ifoldr -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr' #-} ifoldr' = G.ifoldr' -- Specialised folds -- ----------------- -- | /O(n)/ Check if all elements satisfy the predicate. all :: Prim a => (a -> Bool) -> Vector a -> Bool {-# INLINE all #-} all = G.all -- | /O(n)/ Check if any element satisfies the predicate. any :: Prim a => (a -> Bool) -> Vector a -> Bool {-# INLINE any #-} any = G.any -- | /O(n)/ Compute the sum of the elements sum :: (Prim a, Num a) => Vector a -> a {-# INLINE sum #-} sum = G.sum -- | /O(n)/ Compute the produce of the elements product :: (Prim a, Num a) => Vector a -> a {-# INLINE product #-} product = G.product -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Prim a, Ord a) => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy -- | /O(n)/ Yield the minimum element of the vector. The vector may not be -- empty. minimum :: (Prim a, Ord a) => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: (Prim a, Ord a) => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex -- | /O(n)/ Yield the index of the maximum element of the vector according to -- the given comparison function. The vector may not be empty. maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy -- | /O(n)/ Yield the index of the minimum element of the vector. The vector -- may not be empty. minIndex :: (Prim a, Ord a) => Vector a -> Int {-# INLINE minIndex #-} minIndex = G.minIndex -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty. minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy -- Monadic folds -- ------------- -- | /O(n)/ Monadic fold foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM #-} foldM = G.foldM -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-} fold1M = G.fold1M -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM' #-} foldM' = G.foldM' -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM_ #-} foldM_ = G.foldM_ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-} fold1M_ = G.fold1M_ -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_ -- Prefix sums (scans) -- ------------------- -- | /O(n)/ Prescan -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ -- -- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ -- prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-} prescanl = G.prescanl -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-} prescanl' = G.prescanl' -- | /O(n)/ Scan -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ -- -- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ -- postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl #-} postscanl = G.postscanl -- | /O(n)/ Scan with strict accumulator postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl' #-} postscanl' = G.postscanl' -- | /O(n)/ Haskell-style scan -- -- > scanl f z = -- > where y1 = z -- > yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ -- scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl' #-} scanl' = G.scanl' -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = -- > where y1 = x1 -- > yi = f y(i-1) xi -- scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1 #-} scanl1 = G.scanl1 -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1' #-} scanl1' = G.scanl1' -- | /O(n)/ Right-to-left prescan -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @ -- prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-} prescanr = G.prescanr -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr' #-} prescanr' = G.prescanr' -- | /O(n)/ Right-to-left scan postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr #-} postscanr = G.postscanr -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr' #-} postscanr' = G.postscanr' -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr #-} scanr = G.scanr -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr' #-} scanr' = G.scanr' -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} scanr1 = G.scanr1 -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1' #-} scanr1' = G.scanr1' -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Prim a => Vector a -> [a] {-# INLINE toList #-} toList = G.toList -- | /O(n)/ Convert a list to a vector fromList :: Prim a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector -- -- @ -- fromListN n xs = 'fromList' ('take' n xs) -- @ fromListN :: Prim a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN -- Conversions - Mutable vectors -- ----------------------------- -- | /O(1)/ Unsafe convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE unsafeFreeze #-} unsafeFreeze = G.unsafeFreeze -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE unsafeThaw #-} unsafeThaw = G.unsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE thaw #-} thaw = G.thaw -- | /O(n)/ Yield an immutable copy of the mutable vector. freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE freeze #-} freeze = G.freeze -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy vector-0.10.0.1/Data/Vector/Unboxed.hs0000644000000000000000000012325212035366315015503 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} -- | -- Module : Data.Vector.Unboxed -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Adaptive unboxed vectors. The implementation is based on type families -- and picks an efficient, specialised representation for every element type. -- In particular, unboxed vectors of pairs are represented as pairs of unboxed -- vectors. -- -- Implementing unboxed vectors for new data types can be very easy. Here is -- how the library does this for 'Complex' by simply wrapping vectors of -- pairs. -- -- @ -- newtype instance 'MVector' s ('Complex' a) = MV_Complex ('MVector' s (a,a)) -- newtype instance 'Vector' ('Complex' a) = V_Complex ('Vector' (a,a)) -- -- instance ('RealFloat' a, 'Unbox' a) => 'Data.Vector.Generic.Mutable.MVector' 'MVector' ('Complex' a) where -- {-\# INLINE basicLength \#-} -- basicLength (MV_Complex v) = 'Data.Vector.Generic.Mutable.basicLength' v -- ... -- -- instance ('RealFloat' a, 'Unbox' a) => Data.Vector.Generic.Vector 'Vector' ('Complex' a) where -- {-\# INLINE basicLength \#-} -- basicLength (V_Complex v) = Data.Vector.Generic.basicLength v -- ... -- -- instance ('RealFloat' a, 'Unbox' a) => 'Unbox' ('Complex' a) -- @ module Data.Vector.Unboxed ( -- * Unboxed vectors Vector, MVector(..), Unbox, -- * 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, create, -- ** Unfolding unfoldr, unfoldrN, 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, mapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, zipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, 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, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', -- * Conversions -- ** Lists toList, fromList, fromListN, -- ** Other vector types G.convert, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic as G import qualified Data.Vector.Fusion.Stream as Stream import Data.Vector.Fusion.Util ( delayed_min ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, (++), concat, head, last, init, tail, take, drop, splitAt, reverse, map, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, and, or, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_ ) import qualified Prelude import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #include "vector.h" -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Ord a) => Ord (Vector a) where {-# INLINE compare #-} compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Unbox a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty {-# INLINE mappend #-} mappend = (++) {-# INLINE mconcat #-} mconcat = concat instance (Show a, Unbox a) => Show (Vector a) where showsPrec = G.showsPrec instance (Read a, Unbox a) => Read (Vector a) where readPrec = G.readPrec readListPrec = readListPrecDefault -- Length information -- ------------------ -- | /O(1)/ Yield the length of the vector. length :: Unbox a => Vector a -> Int {-# INLINE length #-} length = G.length -- | /O(1)/ Test whether a vector if empty null :: Unbox a => Vector a -> Bool {-# INLINE null #-} null = G.null -- Indexing -- -------- -- | O(1) Indexing (!) :: Unbox a => Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) -- | O(1) Safe indexing (!?) :: Unbox a => Vector a -> Int -> Maybe a {-# INLINE (!?) #-} (!?) = (G.!?) -- | /O(1)/ First element head :: Unbox a => Vector a -> a {-# INLINE head #-} head = G.head -- | /O(1)/ Last element last :: Unbox a => Vector a -> a {-# INLINE last #-} last = G.last -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Unbox a => Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Unbox a => Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Unbox a => Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast -- Monadic indexing -- ---------------- -- | /O(1)/ Indexing in a monad. -- -- The monad allows operations to be strict in the vector when necessary. -- Suppose vector copying is implemented like this: -- -- > copy mv v = ... write mv i (v ! i) ... -- -- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ -- would unnecessarily retain a reference to @v@ in each element written. -- -- With 'indexM', copying can be implemented like this instead: -- -- > copy mv v = ... do -- > x <- indexM v i -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the -- elements) is evaluated eagerly. -- indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Unbox a, Monad m) => Vector a -> m a {-# INLINE headM #-} headM = G.headM -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Unbox a, Monad m) => Vector a -> m a {-# INLINE lastM #-} lastM = G.lastM -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a {-# INLINE unsafeLastM #-} unsafeLastM = G.unsafeLastM -- Extracting subvectors (slicing) -- ------------------------------- -- | /O(1)/ Yield a slice of the vector without copying it. The vector must -- contain at least @i+n@ elements. slice :: Unbox a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE slice #-} slice = G.slice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Unbox a => Vector a -> Vector a {-# INLINE init #-} init = G.init -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Unbox a => Vector a -> Vector a {-# INLINE tail #-} tail = G.tail -- | /O(1)/ Yield at the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Unbox a => Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Unbox a => Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop -- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient. {-# INLINE splitAt #-} splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) splitAt = G.splitAt -- | /O(1)/ Yield a slice of the vector without copying. The vector must -- contain at least @i+n@ elements but this is not checked. unsafeSlice :: Unbox a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a -> Vector a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Unbox a => Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Unbox a => Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- | /O(1)/ Yield the first @n@ elements without copying. The vector must -- contain at least @n@ elements but this is not checked. unsafeTake :: Unbox a => Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector -- must contain at least @n@ elements but this is not checked. unsafeDrop :: Unbox a => Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop -- Initialisation -- -------------- -- | /O(1)/ Empty vector empty :: Unbox a => Vector a {-# INLINE empty #-} empty = G.empty -- | /O(1)/ Vector with exactly one element singleton :: Unbox a => a -> Vector a {-# INLINE singleton #-} singleton = G.singleton -- | /O(n)/ Vector of the given length with the same value in each position replicate :: Unbox a => Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Unbox a => Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a {-# INLINE iterateN #-} iterateN = G.iterateN -- Unfolding -- --------- -- | /O(n)/ Construct a vector by repeatedly applying the generator function -- to a seed. The generator function yields 'Just' the next element and the -- new seed or 'Nothing' if there are no more elements. -- -- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f ; c = f in f -- constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-} constructN = G.constructN -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f ; c = f in f -- constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-} constructrN = G.constructrN -- Enumeration -- ----------- -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7> enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a {-# INLINE enumFromN #-} enumFromN = G.enumFromN -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. -- -- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> Vector a {-# INLINE enumFromStepN #-} enumFromStepN = G.enumFromStepN -- | /O(n)/ Enumerate values from @x@ to @y@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromN' instead. enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a {-# INLINE enumFromTo #-} enumFromTo = G.enumFromTo -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-} enumFromThenTo = G.enumFromThenTo -- Concatenation -- ------------- -- | /O(n)/ Prepend an element cons :: Unbox a => a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons -- | /O(n)/ Append an element snoc :: Unbox a => Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Unbox a => Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) -- | /O(n)/ Concatenate all vectors in the list concat :: Unbox a => [Vector a] -> Vector a {-# INLINE concat #-} concat = G.concat -- Monadic initialisation -- ---------------------- -- | /O(n)/ Execute the monadic action the given number of times and store the -- results in a vector. replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) {-# INLINE generateM #-} generateM = G.generateM -- | Execute the monadic action and freeze the resulting vector. -- -- @ -- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> -- @ create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a {-# INLINE create #-} -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p -- Restricting memory usage -- ------------------------ -- | /O(n)/ Yield the argument but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example: -- -- > force (slice 0 2 ) -- -- Here, the slice retains a reference to the huge vector. Forcing it creates -- a copy of just the elements that belong to the slice and allows the huge -- vector to be garbage collected. force :: Unbox a => Vector a -> Vector a {-# INLINE force #-} force = G.force -- Bulk updates -- ------------ -- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector -- element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Unbox a => Vector a -- ^ initial vector (of length @m@) -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE (//) #-} (//) = (G.//) -- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, -- replace the vector element at position @i@ by @a@. -- -- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> -- update :: Unbox a => Vector a -- ^ initial vector (of length @m@) -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) -> Vector a {-# INLINE update #-} update = G.update -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @a@ from the value vector, replace the element of the -- initial vector at position @i@ by @a@. -- -- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> -- -- The function 'update' provides the same functionality and is usually more -- convenient. -- -- @ -- update_ xs is ys = 'update' xs ('zip' is ys) -- @ update_ :: Unbox a => Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector a -- ^ value vector (of length @n2@) -> Vector a {-# INLINE update_ #-} update_ = G.update_ -- | Same as ('//') but without bounds checking. unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd -- | Same as 'update' but without bounds checking. unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a {-# INLINE unsafeUpdate #-} unsafeUpdate = G.unsafeUpdate -- | Same as 'update_' but without bounds checking. unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_ -- Accumulations -- ------------- -- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element -- @a@ at position @i@ by @f a b@. -- -- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> accum :: Unbox a => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> Vector a {-# INLINE accum #-} accum = G.accum -- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector -- element @a@ at position @i@ by @f a b@. -- -- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> accumulate :: (Unbox a, Unbox b) => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) -> Vector a {-# INLINE accumulate #-} accumulate = G.accumulate -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @b@ from the the value vector, -- replace the element of the initial vector at -- position @i@ by @f a b@. -- -- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> -- -- The function 'accumulate' provides the same functionality and is usually more -- convenient. -- -- @ -- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) -- @ accumulate_ :: (Unbox a, Unbox b) => (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector Int -- ^ index vector (of length @n1@) -> Vector b -- ^ value vector (of length @n2@) -> Vector a {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ -- | Same as 'accum' but without bounds checking. unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum -- | Same as 'accumulate' but without bounds checking. unsafeAccumulate :: (Unbox a, Unbox b) => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a {-# INLINE unsafeAccumulate #-} unsafeAccumulate = G.unsafeAccumulate -- | Same as 'accumulate_' but without bounds checking. unsafeAccumulate_ :: (Unbox a, Unbox b) => (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ = G.unsafeAccumulate_ -- Permutations -- ------------ -- | /O(n)/ Reverse a vector reverse :: Unbox a => Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute :: Unbox a => Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute -- | Same as 'backpermute' but without bounds checking. unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute -- Safe destructive updates -- ------------------------ -- | Apply a destructive operation to a vector. The operation will be -- performed in place if it is safe to do so and will modify a copy of the -- vector otherwise. -- -- @ -- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> -- @ modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a {-# INLINE modify #-} modify p = G.modify p -- Indexing -- -------- -- | /O(n)/ Pair each element in a vector with its index indexed :: Unbox a => Vector a -> Vector (Int,a) {-# INLINE indexed #-} indexed = G.indexed -- Mapping -- ------- -- | /O(n)/ Map a function over a vector map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap -- | Map a function over a vector and concatenate the results. concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap -- Monadic mapping -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b) {-# INLINE mapM #-} mapM = G.mapM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Unbox a) => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results. Equivalent to @flip 'mapM_'@. forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ = G.forM_ -- Zipping -- ------- -- | /O(min(m,n))/ Zip two vectors with the given function. zipWith :: (Unbox a, Unbox b, Unbox c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-} zipWith = G.zipWith -- | Zip three vectors with the given function. zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE zipWith4 #-} zipWith4 = G.zipWith4 zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => (a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE zipWith5 #-} zipWith5 = G.zipWith5 zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) => (a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE zipWith6 #-} zipWith6 = G.zipWith6 -- | /O(min(m,n))/ Zip two vectors with a function that also takes the -- elements' indices. izipWith :: (Unbox a, Unbox b, Unbox c) => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE izipWith #-} izipWith = G.izipWith -- | Zip three vectors and their indices with the given function. izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) => (Int -> a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE izipWith3 #-} izipWith3 = G.izipWith3 izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => (Int -> a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE izipWith4 #-} izipWith4 = G.izipWith4 izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => (Int -> a -> b -> c -> d -> e -> f) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f {-# INLINE izipWith5 #-} izipWith5 = G.izipWith5 izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) => (Int -> a -> b -> c -> d -> e -> f -> g) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f -> Vector g {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 -- Monadic zipping -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a -- vector of results zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE zipWithM #-} zipWithM = G.zipWithM -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Unbox a, Unbox b) => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ -- Filtering -- --------- -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} filterM = G.filterM -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-} takeWhile = G.takeWhile -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-} dropWhile = G.dropWhile -- Parititioning -- ------------- -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. The -- relative order of the elements is preserved at the cost of a sometimes -- reduced performance compared to 'unstablePartition'. partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE partition #-} partition = G.partition -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often -- faster than 'partition'. unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE span #-} span = G.span -- | /O(n)/ Split the vector into the longest prefix of elements that do not -- satisfy the predicate and the rest without copying. break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE break #-} break = G.break -- Searching -- --------- infix 4 `elem` -- | /O(n)/ Check if the vector contains an element elem :: (Unbox a, Eq a) => a -> Vector a -> Bool {-# INLINE elem #-} elem = G.elem infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool {-# INLINE notElem #-} notElem = G.notElem -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a {-# INLINE find #-} find = G.find -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int {-# INLINE findIndex #-} findIndex = G.findIndex -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int {-# INLINE findIndices #-} findIndices = G.findIndices -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int {-# INLINE elemIndex #-} elemIndex = G.elemIndex -- | /O(n)/ Yield the indices of all occurences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int {-# INLINE elemIndices #-} elemIndices = G.elemIndices -- Folding -- ------- -- | /O(n)/ Left fold foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-} foldl = G.foldl -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1 -- | /O(n)/ Left fold with strict accumulator foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-} foldl' = G.foldl' -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-} foldl1' = G.foldl1' -- | /O(n)/ Right fold foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-} foldr = G.foldr -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-} foldr1 = G.foldr1 -- | /O(n)/ Right fold with a strict accumulator foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr' #-} foldr' = G.foldr' -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a {-# INLINE foldr1' #-} foldr1' = G.foldr1' -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl #-} ifoldl = G.ifoldl -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl' #-} ifoldl' = G.ifoldl' -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr #-} ifoldr = G.ifoldr -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr' #-} ifoldr' = G.ifoldr' -- Specialised folds -- ----------------- -- | /O(n)/ Check if all elements satisfy the predicate. all :: Unbox a => (a -> Bool) -> Vector a -> Bool {-# INLINE all #-} all = G.all -- | /O(n)/ Check if any element satisfies the predicate. any :: Unbox a => (a -> Bool) -> Vector a -> Bool {-# INLINE any #-} any = G.any -- | /O(n)/ Check if all elements are 'True' and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and -- | /O(n)/ Check if any element is 'True' or :: Vector Bool -> Bool {-# INLINE or #-} or = G.or -- | /O(n)/ Compute the sum of the elements sum :: (Unbox a, Num a) => Vector a -> a {-# INLINE sum #-} sum = G.sum -- | /O(n)/ Compute the produce of the elements product :: (Unbox a, Num a) => Vector a -> a {-# INLINE product #-} product = G.product -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Unbox a, Ord a) => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy -- | /O(n)/ Yield the minimum element of the vector. The vector may not be -- empty. minimum :: (Unbox a, Ord a) => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: (Unbox a, Ord a) => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex -- | /O(n)/ Yield the index of the maximum element of the vector according to -- the given comparison function. The vector may not be empty. maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy -- | /O(n)/ Yield the index of the minimum element of the vector. The vector -- may not be empty. minIndex :: (Unbox a, Ord a) => Vector a -> Int {-# INLINE minIndex #-} minIndex = G.minIndex -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty. minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy -- Monadic folds -- ------------- -- | /O(n)/ Monadic fold foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM #-} foldM = G.foldM -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-} fold1M = G.fold1M -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM' #-} foldM' = G.foldM' -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM_ #-} foldM_ = G.foldM_ -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-} fold1M_ = G.fold1M_ -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_ -- Prefix sums (scans) -- ------------------- -- | /O(n)/ Prescan -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ -- -- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ -- prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-} prescanl = G.prescanl -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-} prescanl' = G.prescanl' -- | /O(n)/ Scan -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ -- -- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ -- postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl #-} postscanl = G.postscanl -- | /O(n)/ Scan with strict accumulator postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl' #-} postscanl' = G.postscanl' -- | /O(n)/ Haskell-style scan -- -- > scanl f z = -- > where y1 = z -- > yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ -- scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl' #-} scanl' = G.scanl' -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = -- > where y1 = x1 -- > yi = f y(i-1) xi -- scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1 #-} scanl1 = G.scanl1 -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1' #-} scanl1' = G.scanl1' -- | /O(n)/ Right-to-left prescan -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @ -- prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-} prescanr = G.prescanr -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr' #-} prescanr' = G.prescanr' -- | /O(n)/ Right-to-left scan postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr #-} postscanr = G.postscanr -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr' #-} postscanr' = G.postscanr' -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr #-} scanr = G.scanr -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr' #-} scanr' = G.scanr' -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} scanr1 = G.scanr1 -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1' #-} scanr1' = G.scanr1' -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Unbox a => Vector a -> [a] {-# INLINE toList #-} toList = G.toList -- | /O(n)/ Convert a list to a vector fromList :: Unbox a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector -- -- @ -- fromListN n xs = 'fromList' ('take' n xs) -- @ fromListN :: Unbox a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN -- Conversions - Mutable vectors -- ----------------------------- -- | /O(1)/ Unsafe convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE unsafeFreeze #-} unsafeFreeze = G.unsafeFreeze -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE unsafeThaw #-} unsafeThaw = G.unsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) {-# INLINE thaw #-} thaw = G.thaw -- | /O(n)/ Yield an immutable copy of the mutable vector. freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) {-# INLINE freeze #-} freeze = G.freeze -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy #define DEFINE_IMMUTABLE #include "unbox-tuple-instances" vector-0.10.0.1/Data/Vector/Generic.hs0000644000000000000000000020356112035366315015455 0ustar0000000000000000{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, ScopedTypeVariables, BangPatterns #-} -- | -- Module : Data.Vector.Generic -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Generic interface to pure vectors. -- module Data.Vector.Generic ( -- * Immutable vectors Vector(..), Mutable, -- * 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, create, -- ** Unfolding unfoldr, unfoldrN, 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, mapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, zipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, 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, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_, fold1M'_, -- ** Monadic sequencing sequence, sequence_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', -- * Conversions -- ** Lists toList, fromList, fromListN, -- ** Different vector types convert, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, -- * Fusion support -- ** Conversion to/from Streams stream, unstream, streamR, unstreamR, -- ** Recycling support new, clone, -- * Utilities -- ** Comparisons eq, cmp, -- ** Show and Read showsPrec, readPrec, -- ** @Data@ and @Typeable@ gfoldl, dataCast, mkType ) where import Data.Vector.Generic.Base import Data.Vector.Generic.Mutable ( MVector ) import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic.New as New import Data.Vector.Generic.New ( New ) import qualified Data.Vector.Fusion.Stream as Stream import Data.Vector.Fusion.Stream ( Stream, MStream, Step(..), inplace, liftStream ) import qualified Data.Vector.Fusion.Stream.Monadic as MStream import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive import qualified Control.Monad as Monad import qualified Data.List as List import Prelude hiding ( length, null, replicate, (++), concat, head, last, init, tail, take, drop, splitAt, reverse, map, concat, concatMap, zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, and, or, sum, product, maximum, minimum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_, sequence, sequence_, showsPrec ) import qualified Text.Read as Read import Data.Typeable ( Typeable1, gcast1 ) #include "vector.h" import Data.Data ( Data, DataType ) #if MIN_VERSION_base(4,2,0) import Data.Data ( mkNoRepType ) #else import Data.Data ( mkNorepType ) mkNoRepType :: String -> DataType mkNoRepType = mkNorepType #endif -- Length information -- ------------------ -- | /O(1)/ Yield the length of the vector. length :: Vector v a => v a -> Int {-# INLINE_STREAM length #-} length v = basicLength v {-# RULES "length/unstream [Vector]" forall s. length (new (New.unstream s)) = Stream.length s #-} -- | /O(1)/ Test whether a vector if empty null :: Vector v a => v a -> Bool {-# INLINE_STREAM null #-} null v = basicLength v == 0 {-# RULES "null/unstream [Vector]" forall s. null (new (New.unstream s)) = Stream.null s #-} -- Indexing -- -------- infixl 9 ! -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a {-# INLINE_STREAM (!) #-} (!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) $ unId (basicUnsafeIndexM v i) infixl 9 !? -- | O(1) Safe indexing (!?) :: Vector v a => v a -> Int -> Maybe a {-# INLINE_STREAM (!?) #-} v !? i | i < 0 || i >= length v = Nothing | otherwise = Just $ unsafeIndex v i -- | /O(1)/ First element head :: Vector v a => v a -> a {-# INLINE_STREAM head #-} head v = v ! 0 -- | /O(1)/ Last element last :: Vector v a => v a -> a {-# INLINE_STREAM last #-} last v = v ! (length v - 1) -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Vector v a => v a -> Int -> a {-# INLINE_STREAM unsafeIndex #-} unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v) $ unId (basicUnsafeIndexM v i) -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Vector v a => v a -> a {-# INLINE_STREAM unsafeHead #-} unsafeHead v = unsafeIndex v 0 -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Vector v a => v a -> a {-# INLINE_STREAM unsafeLast #-} unsafeLast v = unsafeIndex v (length v - 1) {-# RULES "(!)/unstream [Vector]" forall i s. new (New.unstream s) ! i = s Stream.!! i "(!?)/unstream [Vector]" forall i s. new (New.unstream s) !? i = s Stream.!? i "head/unstream [Vector]" forall s. head (new (New.unstream s)) = Stream.head s "last/unstream [Vector]" forall s. last (new (New.unstream s)) = Stream.last s "unsafeIndex/unstream [Vector]" forall i s. unsafeIndex (new (New.unstream s)) i = s Stream.!! i "unsafeHead/unstream [Vector]" forall s. unsafeHead (new (New.unstream s)) = Stream.head s "unsafeLast/unstream [Vector]" forall s. unsafeLast (new (New.unstream s)) = Stream.last s #-} -- Monadic indexing -- ---------------- -- | /O(1)/ Indexing in a monad. -- -- The monad allows operations to be strict in the vector when necessary. -- Suppose vector copying is implemented like this: -- -- > copy mv v = ... write mv i (v ! i) ... -- -- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ -- would unnecessarily retain a reference to @v@ in each element written. -- -- With 'indexM', copying can be implemented like this instead: -- -- > copy mv v = ... do -- > x <- indexM v i -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the -- elements) is evaluated eagerly. -- indexM :: (Vector v a, Monad m) => v a -> Int -> m a {-# INLINE_STREAM indexM #-} indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v) $ basicUnsafeIndexM v i -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Vector v a, Monad m) => v a -> m a {-# INLINE_STREAM headM #-} headM v = indexM v 0 -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Vector v a, Monad m) => v a -> m a {-# INLINE_STREAM lastM #-} lastM v = indexM v (length v - 1) -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a {-# INLINE_STREAM unsafeIndexM #-} unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v) $ basicUnsafeIndexM v i -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Vector v a, Monad m) => v a -> m a {-# INLINE_STREAM unsafeHeadM #-} unsafeHeadM v = unsafeIndexM v 0 -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Vector v a, Monad m) => v a -> m a {-# INLINE_STREAM unsafeLastM #-} unsafeLastM v = unsafeIndexM v (length v - 1) {-# RULES "indexM/unstream [Vector]" forall s i. indexM (new (New.unstream s)) i = liftStream s MStream.!! i "headM/unstream [Vector]" forall s. headM (new (New.unstream s)) = MStream.head (liftStream s) "lastM/unstream [Vector]" forall s. lastM (new (New.unstream s)) = MStream.last (liftStream s) "unsafeIndexM/unstream [Vector]" forall s i. unsafeIndexM (new (New.unstream s)) i = liftStream s MStream.!! i "unsafeHeadM/unstream [Vector]" forall s. unsafeHeadM (new (New.unstream s)) = MStream.head (liftStream s) "unsafeLastM/unstream [Vector]" forall s. unsafeLastM (new (New.unstream s)) = MStream.last (liftStream s) #-} -- Extracting subvectors (slicing) -- ------------------------------- -- | /O(1)/ Yield a slice of the vector without copying it. The vector must -- contain at least @i+n@ elements. slice :: Vector v a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> v a -> v a {-# INLINE_STREAM slice #-} slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) $ basicUnsafeSlice i n v -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Vector v a => v a -> v a {-# INLINE_STREAM init #-} init v = slice 0 (length v - 1) v -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Vector v a => v a -> v a {-# INLINE_STREAM tail #-} tail v = slice 1 (length v - 1) v -- | /O(1)/ Yield the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Vector v a => Int -> v a -> v a {-# INLINE_STREAM take #-} take n v = unsafeSlice 0 (delay_inline min n' (length v)) v where n' = max n 0 -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Vector v a => Int -> v a -> v a {-# INLINE_STREAM drop #-} drop n v = unsafeSlice (delay_inline min n' len) (delay_inline max 0 (len - n')) v where n' = max n 0 len = length v -- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient. {-# INLINE_STREAM splitAt #-} splitAt :: Vector v a => Int -> v a -> (v a, v a) splitAt n v = ( unsafeSlice 0 m v , unsafeSlice m (delay_inline max 0 (len - n')) v ) where m = delay_inline min n' len n' = max n 0 len = length v -- | /O(1)/ Yield a slice of the vector without copying. The vector must -- contain at least @i+n@ elements but this is not checked. unsafeSlice :: Vector v a => Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> v a -> v a {-# INLINE_STREAM unsafeSlice #-} unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) $ basicUnsafeSlice i n v -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Vector v a => v a -> v a {-# INLINE_STREAM unsafeInit #-} unsafeInit v = unsafeSlice 0 (length v - 1) v -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Vector v a => v a -> v a {-# INLINE_STREAM unsafeTail #-} unsafeTail v = unsafeSlice 1 (length v - 1) v -- | /O(1)/ Yield the first @n@ elements without copying. The vector must -- contain at least @n@ elements but this is not checked. unsafeTake :: Vector v a => Int -> v a -> v a {-# INLINE unsafeTake #-} unsafeTake n v = unsafeSlice 0 n v -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector -- must contain at least @n@ elements but this is not checked. unsafeDrop :: Vector v a => Int -> v a -> v a {-# INLINE unsafeDrop #-} unsafeDrop n v = unsafeSlice n (length v - n) v {-# RULES "slice/new [Vector]" forall i n p. slice i n (new p) = new (New.slice i n p) "init/new [Vector]" forall p. init (new p) = new (New.init p) "tail/new [Vector]" forall p. tail (new p) = new (New.tail p) "take/new [Vector]" forall n p. take n (new p) = new (New.take n p) "drop/new [Vector]" forall n p. drop n (new p) = new (New.drop n p) "unsafeSlice/new [Vector]" forall i n p. unsafeSlice i n (new p) = new (New.unsafeSlice i n p) "unsafeInit/new [Vector]" forall p. unsafeInit (new p) = new (New.unsafeInit p) "unsafeTail/new [Vector]" forall p. unsafeTail (new p) = new (New.unsafeTail p) #-} -- Initialisation -- -------------- -- | /O(1)/ Empty vector empty :: Vector v a => v a {-# INLINE empty #-} empty = unstream Stream.empty -- | /O(1)/ Vector with exactly one element singleton :: forall v a. Vector v a => a -> v a {-# INLINE singleton #-} singleton x = elemseq (undefined :: v a) x $ unstream (Stream.singleton x) -- | /O(n)/ Vector of the given length with the same value in each position replicate :: forall v a. Vector v a => Int -> a -> v a {-# INLINE replicate #-} replicate n x = elemseq (undefined :: v a) x $ unstream $ Stream.replicate n x -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Vector v a => Int -> (Int -> a) -> v a {-# INLINE generate #-} generate n f = unstream (Stream.generate n f) -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Vector v a => Int -> (a -> a) -> a -> v a {-# INLINE iterateN #-} iterateN n f x = unstream (Stream.iterateN n f x) -- Unfolding -- --------- -- | /O(n)/ Construct a vector by repeatedly applying the generator function -- to a seed. The generator function yields 'Just' the next element and the -- new seed or 'Nothing' if there are no more elements. -- -- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldr #-} unfoldr f = unstream . Stream.unfoldr f -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldrN #-} unfoldrN n f = unstream . Stream.unfoldrN n f -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f ; c = f in f -- constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a {-# INLINE constructN #-} -- NOTE: We *CANNOT* wrap this in New and then fuse because the elements -- might contain references to the immutable vector! constructN !n f = runST ( do v <- M.new n v' <- unsafeFreeze v fill v' 0 ) where fill :: forall s. v a -> Int -> ST s (v a) fill !v i | i < n = let x = f (unsafeTake i v) in elemseq v x $ do v' <- unsafeThaw v M.unsafeWrite v' i x v'' <- unsafeFreeze v' fill v'' (i+1) fill v i = return v -- | /O(n)/ Construct a vector with @n@ elements from right to left by -- repeatedly applying the generator function to the already constructed part -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f ; c = f in f -- constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a {-# INLINE constructrN #-} -- NOTE: We *CANNOT* wrap this in New and then fuse because the elements -- might contain references to the immutable vector! constructrN !n f = runST ( do v <- n `seq` M.new n v' <- unsafeFreeze v fill v' 0 ) where fill :: forall s. v a -> Int -> ST s (v a) fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) in elemseq v x $ do v' <- unsafeThaw v M.unsafeWrite v' (n-i-1) x v'' <- unsafeFreeze v' fill v'' (i+1) fill v i = return v -- Enumeration -- ----------- -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7> enumFromN :: (Vector v a, Num a) => a -> Int -> v a {-# INLINE enumFromN #-} enumFromN x n = enumFromStepN x 1 n -- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. -- -- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> enumFromStepN :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a {-# INLINE enumFromStepN #-} enumFromStepN x y n = elemseq (undefined :: v a) x $ elemseq (undefined :: v a) y $ unstream $ Stream.enumFromStepN x y n -- | /O(n)/ Enumerate values from @x@ to @y@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromN' instead. enumFromTo :: (Vector v a, Enum a) => a -> a -> v a {-# INLINE enumFromTo #-} enumFromTo x y = unstream (Stream.enumFromTo x y) -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a {-# INLINE enumFromThenTo #-} enumFromThenTo x y z = unstream (Stream.enumFromThenTo x y z) -- Concatenation -- ------------- -- | /O(n)/ Prepend an element cons :: forall v a. Vector v a => a -> v a -> v a {-# INLINE cons #-} cons x v = elemseq (undefined :: v a) x $ unstream $ Stream.cons x $ stream v -- | /O(n)/ Append an element snoc :: forall v a. Vector v a => v a -> a -> v a {-# INLINE snoc #-} snoc v x = elemseq (undefined :: v a) x $ unstream $ Stream.snoc (stream v) x infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Vector v a => v a -> v a -> v a {-# INLINE (++) #-} v ++ w = unstream (stream v Stream.++ stream w) -- | /O(n)/ Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a {-# INLINE concat #-} concat vs = unstream (Stream.flatten mk step (Exact n) (Stream.fromList vs)) where n = List.foldl' (\k v -> k + length v) 0 vs {-# INLINE_INNER step #-} step (v,i,k) | i < k = case unsafeIndexM v i of Box x -> Stream.Yield x (v,i+1,k) | otherwise = Stream.Done {-# INLINE mk #-} mk v = let k = length v in k `seq` (v,0,k) -- Monadic initialisation -- ---------------------- -- | /O(n)/ Execute the monadic action the given number of times and store the -- results in a vector. replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) {-# INLINE replicateM #-} replicateM n m = unstreamM (MStream.replicateM n m) -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) {-# INLINE generateM #-} generateM n f = unstreamM (MStream.generateM n f) -- | Execute the monadic action and freeze the resulting vector. -- -- @ -- create (do { v \<- 'M.new' 2; 'M.write' v 0 \'a\'; 'M.write' v 1 \'b\'; return v }) = \<'a','b'\> -- @ create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a {-# INLINE create #-} create p = new (New.create p) -- Restricting memory usage -- ------------------------ -- | /O(n)/ Yield the argument but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example: -- -- > force (slice 0 2 ) -- -- Here, the slice retains a reference to the huge vector. Forcing it creates -- a copy of just the elements that belong to the slice and allows the huge -- vector to be garbage collected. force :: Vector v a => v a -> v a -- FIXME: we probably ought to inline this later as the rules still might fire -- otherwise {-# INLINE_STREAM force #-} force v = new (clone v) -- Bulk updates -- ------------ -- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector -- element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> -- (//) :: Vector v a => v a -- ^ initial vector (of length @m@) -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> v a {-# INLINE (//) #-} v // us = update_stream v (Stream.fromList us) -- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, -- replace the vector element at position @i@ by @a@. -- -- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> -- update :: (Vector v a, Vector v (Int, a)) => v a -- ^ initial vector (of length @m@) -> v (Int, a) -- ^ vector of index/value pairs (of length @n@) -> v a {-# INLINE update #-} update v w = update_stream v (stream w) -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @a@ from the value vector, replace the element of the -- initial vector at position @i@ by @a@. -- -- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> -- -- This function is useful for instances of 'Vector' that cannot store pairs. -- Otherwise, 'update' is probably more convenient. -- -- @ -- update_ xs is ys = 'update' xs ('zip' is ys) -- @ update_ :: (Vector v a, Vector v Int) => v a -- ^ initial vector (of length @m@) -> v Int -- ^ index vector (of length @n1@) -> v a -- ^ value vector (of length @n2@) -> v a {-# INLINE update_ #-} update_ v is w = update_stream v (Stream.zipWith (,) (stream is) (stream w)) update_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE update_stream #-} update_stream = modifyWithStream M.update -- | Same as ('//') but without bounds checking. unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE unsafeUpd #-} unsafeUpd v us = unsafeUpdate_stream v (Stream.fromList us) -- | Same as 'update' but without bounds checking. unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a {-# INLINE unsafeUpdate #-} unsafeUpdate v w = unsafeUpdate_stream v (stream w) -- | Same as 'update_' but without bounds checking. unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ v is w = unsafeUpdate_stream v (Stream.zipWith (,) (stream is) (stream w)) unsafeUpdate_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE unsafeUpdate_stream #-} unsafeUpdate_stream = modifyWithStream M.unsafeUpdate -- Accumulations -- ------------- -- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element -- @a@ at position @i@ by @f a b@. -- -- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> accum :: Vector v a => (a -> b -> a) -- ^ accumulating function @f@ -> v a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> v a {-# INLINE accum #-} accum f v us = accum_stream f v (Stream.fromList us) -- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector -- element @a@ at position @i@ by @f a b@. -- -- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> accumulate :: (Vector v a, Vector v (Int, b)) => (a -> b -> a) -- ^ accumulating function @f@ -> v a -- ^ initial vector (of length @m@) -> v (Int,b) -- ^ vector of index/value pairs (of length @n@) -> v a {-# INLINE accumulate #-} accumulate f v us = accum_stream f v (stream us) -- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the -- corresponding value @b@ from the the value vector, -- replace the element of the initial vector at -- position @i@ by @f a b@. -- -- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> -- -- This function is useful for instances of 'Vector' that cannot store pairs. -- Otherwise, 'accumulate' is probably more convenient: -- -- @ -- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) -- @ accumulate_ :: (Vector v a, Vector v Int, Vector v b) => (a -> b -> a) -- ^ accumulating function @f@ -> v a -- ^ initial vector (of length @m@) -> v Int -- ^ index vector (of length @n1@) -> v b -- ^ value vector (of length @n2@) -> v a {-# INLINE accumulate_ #-} accumulate_ f v is xs = accum_stream f v (Stream.zipWith (,) (stream is) (stream xs)) accum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE accum_stream #-} accum_stream f = modifyWithStream (M.accum f) -- | Same as 'accum' but without bounds checking. unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE unsafeAccum #-} unsafeAccum f v us = unsafeAccum_stream f v (Stream.fromList us) -- | Same as 'accumulate' but without bounds checking. unsafeAccumulate :: (Vector v a, Vector v (Int, b)) => (a -> b -> a) -> v a -> v (Int,b) -> v a {-# INLINE unsafeAccumulate #-} unsafeAccumulate f v us = unsafeAccum_stream f v (stream us) -- | Same as 'accumulate_' but without bounds checking. unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b) => (a -> b -> a) -> v a -> v Int -> v b -> v a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ f v is xs = unsafeAccum_stream f v (Stream.zipWith (,) (stream is) (stream xs)) unsafeAccum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE unsafeAccum_stream #-} unsafeAccum_stream f = modifyWithStream (M.unsafeAccum f) -- Permutations -- ------------ -- | /O(n)/ Reverse a vector reverse :: (Vector v a) => v a -> v a {-# INLINE reverse #-} -- FIXME: make this fuse better, add support for recycling reverse = unstream . streamR -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the -- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is -- often much more efficient. -- -- > backpermute <0,3,2,3,1,0> = backpermute :: (Vector v a, Vector v Int) => v a -- ^ @xs@ value vector -> v Int -- ^ @is@ index vector (of length @n@) -> v a {-# INLINE backpermute #-} -- This somewhat non-intuitive definition ensures that the resulting vector -- does not retain references to the original one even if it is lazy in its -- elements. This would not be the case if we simply used map (v!) backpermute v is = seq v $ seq n $ unstream $ Stream.unbox $ Stream.map index $ stream is where n = length v {-# INLINE index #-} -- NOTE: we do it this way to avoid triggering LiberateCase on n in -- polymorphic code index i = BOUNDS_CHECK(checkIndex) "backpermute" i n $ basicUnsafeIndexM v i -- | Same as 'backpermute' but without bounds checking. unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a {-# INLINE unsafeBackpermute #-} unsafeBackpermute v is = seq v $ seq n $ unstream $ Stream.unbox $ Stream.map index $ stream is where n = length v {-# INLINE index #-} -- NOTE: we do it this way to avoid triggering LiberateCase on n in -- polymorphic code index i = UNSAFE_CHECK(checkIndex) "unsafeBackpermute" i n $ basicUnsafeIndexM v i -- Safe destructive updates -- ------------------------ -- | Apply a destructive operation to a vector. The operation will be -- performed in place if it is safe to do so and will modify a copy of the -- vector otherwise. -- -- @ -- modify (\\v -> 'M.write' v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> -- @ modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a {-# INLINE modify #-} modify p = new . New.modify p . clone -- We have to make sure that this is strict in the stream but we can't seq on -- it while fusion is happening. Hence this ugliness. modifyWithStream :: Vector v a => (forall s. Mutable v s a -> Stream b -> ST s ()) -> v a -> Stream b -> v a {-# INLINE modifyWithStream #-} modifyWithStream p v s = new (New.modifyWithStream p (clone v) s) -- Indexing -- -------- -- | /O(n)/ Pair each element in a vector with its index indexed :: (Vector v a, Vector v (Int,a)) => v a -> v (Int,a) {-# INLINE indexed #-} indexed = unstream . Stream.indexed . stream -- Mapping -- ------- -- | /O(n)/ Map a function over a vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b {-# INLINE map #-} map f = unstream . inplace (MStream.map f) . stream -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b {-# INLINE imap #-} imap f = unstream . inplace (MStream.map (uncurry f) . MStream.indexed) . stream -- | Map a function over a vector and concatenate the results. concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b {-# INLINE concatMap #-} -- NOTE: We can't fuse concatMap anyway so don't pretend we do. -- This seems to be slightly slower -- concatMap f = concat . Stream.toList . Stream.map f . stream -- Slowest -- concatMap f = unstream . Stream.concatMap (stream . f) . stream -- Seems to be fastest concatMap f = unstream . Stream.flatten mk step Unknown . stream where {-# INLINE_INNER step #-} step (v,i,k) | i < k = case unsafeIndexM v i of Box x -> Stream.Yield x (v,i+1,k) | otherwise = Stream.Done {-# INLINE mk #-} mk x = let v = f x k = length v in k `seq` (v,0,k) -- Monadic mapping -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b) {-# INLINE mapM #-} mapM f = unstreamM . Stream.mapM f . stream -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m () {-# INLINE mapM_ #-} mapM_ f = Stream.mapM_ f . stream -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@. forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) {-# INLINE forM #-} forM as f = mapM f as -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results. Equivalent to @flip 'mapM_'@. forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m () {-# INLINE forM_ #-} forM_ as f = mapM_ f as -- Zipping -- ------- -- | /O(min(m,n))/ Zip two vectors with the given function. zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v c {-# INLINE zipWith #-} zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) -- | Zip three vectors with the given function. zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) => (a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE zipWith3 #-} zipWith3 f as bs cs = unstream (Stream.zipWith3 f (stream as) (stream bs) (stream cs)) zipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE zipWith4 #-} zipWith4 f as bs cs ds = unstream (Stream.zipWith4 f (stream as) (stream bs) (stream cs) (stream ds)) zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f) => (a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e -> v f {-# INLINE zipWith5 #-} zipWith5 f as bs cs ds es = unstream (Stream.zipWith5 f (stream as) (stream bs) (stream cs) (stream ds) (stream es)) zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f, Vector v g) => (a -> b -> c -> d -> e -> f -> g) -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE zipWith6 #-} zipWith6 f as bs cs ds es fs = unstream (Stream.zipWith6 f (stream as) (stream bs) (stream cs) (stream ds) (stream es) (stream fs)) -- | /O(min(m,n))/ Zip two vectors with a function that also takes the -- elements' indices. izipWith :: (Vector v a, Vector v b, Vector v c) => (Int -> a -> b -> c) -> v a -> v b -> v c {-# INLINE izipWith #-} izipWith f xs ys = unstream (Stream.zipWith (uncurry f) (Stream.indexed (stream xs)) (stream ys)) izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE izipWith3 #-} izipWith3 f as bs cs = unstream (Stream.zipWith3 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs)) izipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE izipWith4 #-} izipWith4 f as bs cs ds = unstream (Stream.zipWith4 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds)) izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f) => (Int -> a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e -> v f {-# INLINE izipWith5 #-} izipWith5 f as bs cs ds es = unstream (Stream.zipWith5 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds) (stream es)) izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f, Vector v g) => (Int -> a -> b -> c -> d -> e -> f -> g) -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE izipWith6 #-} izipWith6 f as bs cs ds es fs = unstream (Stream.zipWith6 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds) (stream es) (stream fs)) -- | /O(min(m,n))/ Zip two vectors zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) {-# INLINE zip #-} zip = zipWith (,) zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v a -> v b -> v c -> v (a, b, c) {-# INLINE zip3 #-} zip3 = zipWith3 (,,) zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) => v a -> v b -> v c -> v d -> v (a, b, c, d) {-# INLINE zip4 #-} zip4 = zipWith4 (,,,) zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v (a, b, c, d, e)) => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e) {-# INLINE zip5 #-} zip5 = zipWith5 (,,,,) zip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f, Vector v (a, b, c, d, e, f)) => v a -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f) {-# INLINE zip6 #-} zip6 = zipWith6 (,,,,,) -- Monadic zipping -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a -- vector of results zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) => (a -> b -> m c) -> v a -> v b -> m (v c) -- FIXME: specialise for ST and IO? {-# INLINE zipWithM #-} zipWithM f as bs = unstreamM $ Stream.zipWithM f (stream as) (stream bs) -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Vector v a, Vector v b) => (a -> b -> m c) -> v a -> v b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f as bs = Stream.zipWithM_ f (stream as) (stream bs) -- Unzipping -- --------- -- | /O(min(m,n))/ Unzip a vector of pairs. unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) {-# INLINE unzip #-} unzip xs = (map fst xs, map snd xs) unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v (a, b, c) -> (v a, v b, v c) {-# INLINE unzip3 #-} unzip3 xs = (map (\(a, b, c) -> a) xs, map (\(a, b, c) -> b) xs, map (\(a, b, c) -> c) xs) unzip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) => v (a, b, c, d) -> (v a, v b, v c, v d) {-# INLINE unzip4 #-} unzip4 xs = (map (\(a, b, c, d) -> a) xs, map (\(a, b, c, d) -> b) xs, map (\(a, b, c, d) -> c) xs, map (\(a, b, c, d) -> d) xs) unzip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v (a, b, c, d, e)) => v (a, b, c, d, e) -> (v a, v b, v c, v d, v e) {-# INLINE unzip5 #-} unzip5 xs = (map (\(a, b, c, d, e) -> a) xs, map (\(a, b, c, d, e) -> b) xs, map (\(a, b, c, d, e) -> c) xs, map (\(a, b, c, d, e) -> d) xs, map (\(a, b, c, d, e) -> e) xs) unzip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, Vector v f, Vector v (a, b, c, d, e, f)) => v (a, b, c, d, e, f) -> (v a, v b, v c, v d, v e, v f) {-# INLINE unzip6 #-} unzip6 xs = (map (\(a, b, c, d, e, f) -> a) xs, map (\(a, b, c, d, e, f) -> b) xs, map (\(a, b, c, d, e, f) -> c) xs, map (\(a, b, c, d, e, f) -> d) xs, map (\(a, b, c, d, e, f) -> e) xs, map (\(a, b, c, d, e, f) -> f) xs) -- Filtering -- --------- -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE filter #-} filter f = unstream . inplace (MStream.filter f) . stream -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a {-# INLINE ifilter #-} ifilter f = unstream . inplace (MStream.map snd . MStream.filter (uncurry f) . MStream.indexed) . stream -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a) {-# INLINE filterM #-} filterM f = unstreamM . Stream.filterM f . stream -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE takeWhile #-} takeWhile f = unstream . Stream.takeWhile f . stream -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE dropWhile #-} dropWhile f = unstream . Stream.dropWhile f . stream -- Parititioning -- ------------- -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. The -- relative order of the elements is preserved at the cost of a sometimes -- reduced performance compared to 'unstablePartition'. partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) {-# INLINE partition #-} partition f = partition_stream f . stream -- FIXME: Make this inplace-fusible (look at how stable_partition is -- implemented in C++) partition_stream :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a) {-# INLINE_STREAM partition_stream #-} partition_stream f s = s `seq` runST ( do (mv1,mv2) <- M.partitionStream f s v1 <- unsafeFreeze mv1 v2 <- unsafeFreeze mv2 return (v1,v2)) -- | /O(n)/ Split the vector in two parts, the first one containing those -- elements that satisfy the predicate and the second one those that don't. -- The order of the elements is not preserved but the operation is often -- faster than 'partition'. unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) {-# INLINE unstablePartition #-} unstablePartition f = unstablePartition_stream f . stream unstablePartition_stream :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a) {-# INLINE_STREAM unstablePartition_stream #-} unstablePartition_stream f s = s `seq` runST ( do (mv1,mv2) <- M.unstablePartitionStream f s v1 <- unsafeFreeze mv1 v2 <- unsafeFreeze mv2 return (v1,v2)) unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a) {-# INLINE_STREAM unstablePartition_new #-} unstablePartition_new f (New.New p) = runST ( do mv <- p i <- M.unstablePartition f mv v <- unsafeFreeze mv return (unsafeTake i v, unsafeDrop i v)) {-# RULES "unstablePartition" forall f p. unstablePartition_stream f (stream (new p)) = unstablePartition_new f p #-} -- FIXME: make span and break fusible -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: Vector v a => (a -> Bool) -> v a -> (v a, v a) {-# INLINE span #-} span f = break (not . f) -- | /O(n)/ Split the vector into the longest prefix of elements that do not -- satisfy the predicate and the rest without copying. break :: Vector v a => (a -> Bool) -> v a -> (v a, v a) {-# INLINE break #-} break f xs = case findIndex f xs of Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs) Nothing -> (xs, empty) -- Searching -- --------- infix 4 `elem` -- | /O(n)/ Check if the vector contains an element elem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE elem #-} elem x = Stream.elem x . stream infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE notElem #-} notElem x = Stream.notElem x . stream -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Vector v a => (a -> Bool) -> v a -> Maybe a {-# INLINE find #-} find f = Stream.find f . stream -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int {-# INLINE findIndex #-} findIndex f = Stream.findIndex f . stream -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int {-# INLINE findIndices #-} findIndices f = unstream . inplace (MStream.map fst . MStream.filter (f . snd) . MStream.indexed) . stream -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int {-# INLINE elemIndex #-} elemIndex x = findIndex (x==) -- | /O(n)/ Yield the indices of all occurences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int {-# INLINE elemIndices #-} elemIndices x = findIndices (x==) -- Folding -- ------- -- | /O(n)/ Left fold foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl #-} foldl f z = Stream.foldl f z . stream -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-} foldl1 f = Stream.foldl1 f . stream -- | /O(n)/ Left fold with strict accumulator foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl' #-} foldl' f z = Stream.foldl' f z . stream -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1' #-} foldl1' f = Stream.foldl1' f . stream -- | /O(n)/ Right fold foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-} foldr f z = Stream.foldr f z . stream -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1 #-} foldr1 f = Stream.foldr1 f . stream -- | /O(n)/ Right fold with a strict accumulator foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr' #-} foldr' f z = Stream.foldl' (flip f) z . streamR -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1' #-} foldr1' f = Stream.foldl1' (flip f) . streamR -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl #-} ifoldl f z = Stream.foldl (uncurry . f) z . Stream.indexed . stream -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl' #-} ifoldl' f z = Stream.foldl' (uncurry . f) z . Stream.indexed . stream -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr #-} ifoldr f z = Stream.foldr (uncurry f) z . Stream.indexed . stream -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr' #-} ifoldr' f z xs = Stream.foldl' (flip (uncurry f)) z $ Stream.indexedR (length xs) $ streamR xs -- Specialised folds -- ----------------- -- | /O(n)/ Check if all elements satisfy the predicate. all :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE all #-} all f = Stream.and . Stream.map f . stream -- | /O(n)/ Check if any element satisfies the predicate. any :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE any #-} any f = Stream.or . Stream.map f . stream -- | /O(n)/ Check if all elements are 'True' and :: Vector v Bool => v Bool -> Bool {-# INLINE and #-} and = Stream.and . stream -- | /O(n)/ Check if any element is 'True' or :: Vector v Bool => v Bool -> Bool {-# INLINE or #-} or = Stream.or . stream -- | /O(n)/ Compute the sum of the elements sum :: (Vector v a, Num a) => v a -> a {-# INLINE sum #-} sum = Stream.foldl' (+) 0 . stream -- | /O(n)/ Compute the produce of the elements product :: (Vector v a, Num a) => v a -> a {-# INLINE product #-} product = Stream.foldl' (*) 1 . stream -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Vector v a, Ord a) => v a -> a {-# INLINE maximum #-} maximum = Stream.foldl1' max . stream -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE maximumBy #-} maximumBy cmp = Stream.foldl1' maxBy . stream where {-# INLINE maxBy #-} maxBy x y = case cmp x y of LT -> y _ -> x -- | /O(n)/ Yield the minimum element of the vector. The vector may not be -- empty. minimum :: (Vector v a, Ord a) => v a -> a {-# INLINE minimum #-} minimum = Stream.foldl1' min . stream -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE minimumBy #-} minimumBy cmp = Stream.foldl1' minBy . stream where {-# INLINE minBy #-} minBy x y = case cmp x y of GT -> y _ -> x -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: (Vector v a, Ord a) => v a -> Int {-# INLINE maxIndex #-} maxIndex = maxIndexBy compare -- | /O(n)/ Yield the index of the maximum element of the vector according to -- the given comparison function. The vector may not be empty. maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE maxIndexBy #-} maxIndexBy cmp = fst . Stream.foldl1' imax . Stream.indexed . stream where imax (i,x) (j,y) = i `seq` j `seq` case cmp x y of LT -> (j,y) _ -> (i,x) -- | /O(n)/ Yield the index of the minimum element of the vector. The vector -- may not be empty. minIndex :: (Vector v a, Ord a) => v a -> Int {-# INLINE minIndex #-} minIndex = minIndexBy compare -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty. minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE minIndexBy #-} minIndexBy cmp = fst . Stream.foldl1' imin . Stream.indexed . stream where imin (i,x) (j,y) = i `seq` j `seq` case cmp x y of GT -> (j,y) _ -> (i,x) -- Monadic folds -- ------------- -- | /O(n)/ Monadic fold foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM #-} foldM m z = Stream.foldM m z . stream -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M #-} fold1M m = Stream.fold1M m . stream -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM' #-} foldM' m z = Stream.foldM' m z . stream -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M' #-} fold1M' m = Stream.fold1M' m . stream discard :: Monad m => m a -> m () {-# INLINE discard #-} discard m = m >> return () -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM_ #-} foldM_ m z = discard . Stream.foldM m z . stream -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M_ #-} fold1M_ m = discard . Stream.fold1M m . stream -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM'_ #-} foldM'_ m z = discard . Stream.foldM' m z . stream -- | /O(n)/ Monad fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M'_ #-} fold1M'_ m = discard . Stream.fold1M' m . stream -- Monadic sequencing -- ------------------ -- | Evaluate each action and collect the results sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) {-# INLINE sequence #-} sequence = mapM id -- | Evaluate each action and discard the results sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () {-# INLINE sequence_ #-} sequence_ = mapM_ id -- Prefix sums (scans) -- ------------------- -- | /O(n)/ Prescan -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ -- -- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ -- prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl #-} prescanl f z = unstream . inplace (MStream.prescanl f z) . stream -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl' #-} prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream -- | /O(n)/ Scan -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ -- -- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ -- postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl #-} postscanl f z = unstream . inplace (MStream.postscanl f z) . stream -- | /O(n)/ Scan with strict accumulator postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl' #-} postscanl' f z = unstream . inplace (MStream.postscanl' f z) . stream -- | /O(n)/ Haskell-style scan -- -- > scanl f z = -- > where y1 = z -- > yi = f y(i-1) x(i-1) -- -- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ -- scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl #-} scanl f z = unstream . Stream.scanl f z . stream -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl' #-} scanl' f z = unstream . Stream.scanl' f z . stream -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = -- > where y1 = x1 -- > yi = f y(i-1) xi -- scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1 #-} scanl1 f = unstream . inplace (MStream.scanl1 f) . stream -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1' #-} scanl1' f = unstream . inplace (MStream.scanl1' f) . stream -- | /O(n)/ Right-to-left prescan -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @ -- prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr #-} prescanr f z = unstreamR . inplace (MStream.prescanl (flip f) z) . streamR -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr' #-} prescanr' f z = unstreamR . inplace (MStream.prescanl' (flip f) z) . streamR -- | /O(n)/ Right-to-left scan postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr #-} postscanr f z = unstreamR . inplace (MStream.postscanl (flip f) z) . streamR -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr' #-} postscanr' f z = unstreamR . inplace (MStream.postscanl' (flip f) z) . streamR -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr #-} scanr f z = unstreamR . Stream.scanl (flip f) z . streamR -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr' #-} scanr' f z = unstreamR . Stream.scanl' (flip f) z . streamR -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1 #-} scanr1 f = unstreamR . inplace (MStream.scanl1 (flip f)) . streamR -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1' #-} scanr1' f = unstreamR . inplace (MStream.scanl1' (flip f)) . streamR -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Vector v a => v a -> [a] {-# INLINE toList #-} toList = Stream.toList . stream -- | /O(n)/ Convert a list to a vector fromList :: Vector v a => [a] -> v a {-# INLINE fromList #-} fromList = unstream . Stream.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector -- -- @ -- fromListN n xs = 'fromList' ('take' n xs) -- @ fromListN :: Vector v a => Int -> [a] -> v a {-# INLINE fromListN #-} fromListN n = unstream . Stream.fromListN n -- Conversions - Immutable vectors -- ------------------------------- -- | /O(n)/ Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a {-# INLINE convert #-} convert = unstream . stream -- Conversions - Mutable vectors -- ----------------------------- -- | /O(1)/ Unsafe convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) {-# INLINE unsafeFreeze #-} unsafeFreeze = basicUnsafeFreeze -- | /O(n)/ Yield an immutable copy of the mutable vector. freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) {-# INLINE freeze #-} freeze mv = unsafeFreeze =<< M.clone mv -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) {-# INLINE_STREAM unsafeThaw #-} unsafeThaw = basicUnsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) {-# INLINE_STREAM thaw #-} thaw v = do mv <- M.unsafeNew (length v) unsafeCopy mv v return mv {-# RULES "unsafeThaw/new [Vector]" forall p. unsafeThaw (new p) = New.runPrim p "thaw/new [Vector]" forall p. thaw (new p) = New.runPrim p #-} {- -- | /O(n)/ Yield a mutable vector containing copies of each vector in the -- list. thawMany :: (PrimMonad m, Vector v a) => [v a] -> m (Mutable v (PrimState m) a) {-# INLINE_STREAM thawMany #-} -- FIXME: add rule for (stream (new (New.create (thawMany vs)))) -- NOTE: We don't try to consume the list lazily as this wouldn't significantly -- change the space requirements anyway. thawMany vs = do mv <- M.new n thaw_loop mv vs return mv where n = List.foldl' (\k v -> k + length v) 0 vs thaw_loop mv [] = mv `seq` return () thaw_loop mv (v:vs) = do let n = length v unsafeCopy (M.unsafeTake n mv) v thaw_loop (M.unsafeDrop n mv) vs -} -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. copy :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () {-# INLINE copy #-} copy dst src = BOUNDS_CHECK(check) "copy" "length mismatch" (M.length dst == length src) $ unsafeCopy dst src -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () {-# INLINE unsafeCopy #-} unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" (M.length dst == length src) $ (dst `seq` src `seq` basicUnsafeCopy dst src) -- Conversions to/from Streams -- --------------------------- -- | /O(1)/ Convert a vector to a 'Stream' stream :: Vector v a => v a -> Stream a {-# INLINE_STREAM stream #-} stream v = v `seq` n `seq` (Stream.unfoldr get 0 `Stream.sized` Exact n) where n = length v -- NOTE: the False case comes first in Core so making it the recursive one -- makes the code easier to read {-# INLINE get #-} get i | i >= n = Nothing | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1) -- | /O(n)/ Construct a vector from a 'Stream' unstream :: Vector v a => Stream a -> v a {-# INLINE unstream #-} unstream s = new (New.unstream s) {-# RULES "stream/unstream [Vector]" forall s. stream (new (New.unstream s)) = s "New.unstream/stream [Vector]" forall v. New.unstream (stream v) = clone v "clone/new [Vector]" forall p. clone (new p) = p "inplace [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) m. New.unstream (inplace f (stream (new m))) = New.transform f m "uninplace [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) m. stream (new (New.transform f m)) = inplace f (stream (new m)) #-} -- | /O(1)/ Convert a vector to a 'Stream', proceeding from right to left streamR :: Vector v a => v a -> Stream a {-# INLINE_STREAM streamR #-} streamR v = v `seq` n `seq` (Stream.unfoldr get n `Stream.sized` Exact n) where n = length v {-# INLINE get #-} get 0 = Nothing get i = let i' = i-1 in case basicUnsafeIndexM v i' of Box x -> Just (x, i') -- | /O(n)/ Construct a vector from a 'Stream', proceeding from right to left unstreamR :: Vector v a => Stream a -> v a {-# INLINE unstreamR #-} unstreamR s = new (New.unstreamR s) {-# RULES "streamR/unstreamR [Vector]" forall s. streamR (new (New.unstreamR s)) = s "New.unstreamR/streamR/new [Vector]" forall p. New.unstreamR (streamR (new p)) = p "New.unstream/streamR/new [Vector]" forall p. New.unstream (streamR (new p)) = New.modify M.reverse p "New.unstreamR/stream/new [Vector]" forall p. New.unstreamR (stream (new p)) = New.modify M.reverse p "inplace right [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) m. New.unstreamR (inplace f (streamR (new m))) = New.transformR f m "uninplace right [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) m. streamR (new (New.transformR f m)) = inplace f (streamR (new m)) #-} unstreamM :: (Monad m, Vector v a) => MStream m a -> m (v a) {-# INLINE_STREAM unstreamM #-} unstreamM s = do xs <- MStream.toList s return $ unstream $ Stream.unsafeFromList (MStream.size s) xs unstreamPrimM :: (PrimMonad m, Vector v a) => MStream m a -> m (v a) {-# INLINE_STREAM unstreamPrimM #-} unstreamPrimM s = M.munstream s >>= unsafeFreeze -- FIXME: the next two functions are only necessary for the specialisations unstreamPrimM_IO :: Vector v a => MStream IO a -> IO (v a) {-# INLINE unstreamPrimM_IO #-} unstreamPrimM_IO = unstreamPrimM unstreamPrimM_ST :: Vector v a => MStream (ST s) a -> ST s (v a) {-# INLINE unstreamPrimM_ST #-} unstreamPrimM_ST = unstreamPrimM {-# RULES "unstreamM[IO]" unstreamM = unstreamPrimM_IO "unstreamM[ST]" unstreamM = unstreamPrimM_ST #-} -- Recycling support -- ----------------- -- | Construct a vector from a monadic initialiser. new :: Vector v a => New v a -> v a {-# INLINE_STREAM new #-} new m = m `seq` runST (unsafeFreeze =<< New.run m) -- | Convert a vector to an initialiser which, when run, produces a copy of -- the vector. clone :: Vector v a => v a -> New v a {-# INLINE_STREAM clone #-} clone v = v `seq` New.create ( do mv <- M.new (length v) unsafeCopy mv v return mv) -- Comparisons -- ----------- -- | /O(n)/ Check if two vectors are equal. All 'Vector' instances are also -- instances of 'Eq' and it is usually more appropriate to use those. This -- function is primarily intended for implementing 'Eq' instances for new -- vector types. eq :: (Vector v a, Eq a) => v a -> v a -> Bool {-# INLINE eq #-} xs `eq` ys = stream xs == stream ys -- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are -- also instances of 'Ord' and it is usually more appropriate to use those. This -- function is primarily intended for implementing 'Ord' instances for new -- vector types. cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering {-# INLINE cmp #-} cmp xs ys = compare (stream xs) (stream ys) -- Show -- ---- -- | Generic definition of 'Prelude.showsPrec' showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS {-# INLINE showsPrec #-} showsPrec p v = showParen (p > 10) $ showString "fromList " . shows (toList v) -- | Generic definition of 'Text.Read.readPrec' readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) {-# INLINE readPrec #-} readPrec = Read.parens $ Read.prec 10 $ do Read.Ident "fromList" <- Read.lexP xs <- Read.readPrec return (fromList xs) -- Data and Typeable -- ----------------- -- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a -- list. gfoldl :: (Vector v a, Data a) => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> v a -> c (v a) {-# INLINE gfoldl #-} gfoldl f z v = z fromList `f` toList v mkType :: String -> DataType {-# INLINE mkType #-} mkType = mkNoRepType dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) => (forall d. Data d => c (t d)) -> Maybe (c (v a)) {-# INLINE dataCast #-} dataCast f = gcast1 f vector-0.10.0.1/Data/Vector/Mutable.hs0000644000000000000000000003043112035366315015464 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns #-} -- | -- Module : Data.Vector.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Mutable boxed vectors. -- module Data.Vector.Mutable ( -- * Mutable boxed vectors MVector(..), IOVector, STVector, -- * Accessors -- ** Length information length, null, -- ** Extracting subvectors 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, -- * Accessing individual elements read, write, swap, unsafeRead, unsafeWrite, unsafeSwap, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove ) where import Control.Monad (when) import qualified Data.Vector.Generic.Mutable as G import Data.Primitive.Array import Control.Monad.Primitive import Control.DeepSeq ( NFData, rnf ) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail ) import Data.Typeable ( Typeable ) #include "vector.h" -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableArray s a) deriving ( Typeable ) type IOVector = MVector RealWorld type STVector s = MVector s -- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54 {- instance NFData a => NFData (MVector s a) where rnf (MVector i n arr) = unsafeInlineST $ force i where force !ix | ix < n = do x <- readArray arr ix rnf x `seq` force (ix+1) | otherwise = return () -} instance G.MVector MVector a where {-# INLINE basicLength #-} basicLength (MVector _ n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j m (MVector i n arr) = MVector (i+j) m arr {-# INLINE basicOverlaps #-} basicOverlaps (MVector i m arr1) (MVector j n arr2) = sameMutableArray arr1 arr2 && (between i j (j+n) || between j i (i+m)) where between x y z = x >= y && x < z {-# INLINE basicUnsafeNew #-} basicUnsafeNew n = do arr <- newArray n uninitialised return (MVector 0 n arr) {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n x = do arr <- newArray n x return (MVector 0 n arr) {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MVector i n arr) j = readArray arr (i+j) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector i n arr) j x = writeArray arr (i+j) x {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (MVector j _ src) = copyMutableArray dst i src j n basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc) = case n of 0 -> return () 1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst 2 -> do x <- readArray arrSrc iSrc y <- readArray arrSrc (iSrc + 1) writeArray arrDst iDst x writeArray arrDst (iDst + 1) y _ | overlaps dst src -> case compare iDst iSrc of LT -> moveBackwards arrDst iDst iSrc n EQ -> return () GT | (iDst - iSrc) * 2 < n -> moveForwardsLargeOverlap arrDst iDst iSrc n | otherwise -> moveForwardsSmallOverlap arrDst iDst iSrc n | otherwise -> G.basicUnsafeCopy dst src {-# INLINE basicClear #-} basicClear v = G.set v uninitialised {-# INLINE moveBackwards #-} moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveBackwards !arr !dstOff !srcOff !len = INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff) $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) {-# INLINE moveForwardsSmallOverlap #-} -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveForwardsSmallOverlap !arr !dstOff !srcOff !len = INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff) $ do tmp <- newArray overlap uninitialised loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i) where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveForwardsLargeOverlap !arr !dstOff !srcOff !len = INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff) $ do queue <- newArray nonOverlap uninitialised loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i let mov !i !qTop = when (i < dstOff + len) $ do x <- readArray arr i y <- readArray queue qTop writeArray arr i y writeArray queue qTop x mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1) mov dstOff 0 where nonOverlap = dstOff - srcOff {-# INLINE loopM #-} loopM :: Monad m => Int -> (Int -> m a) -> m () loopM !n k = let go i = when (i < n) (k i >> go (i+1)) in go 0 uninitialised :: a uninitialised = error "Data.Vector.Mutable: uninitialised element" -- Length information -- ------------------ -- | Length of the mutable vector. length :: MVector s a -> Int {-# INLINE length #-} length = G.length -- | Check whether the vector is empty null :: MVector s a -> Bool {-# INLINE null #-} null = G.null -- Extracting subvectors -- --------------------- -- | Yield a part of the mutable vector without copying it. slice :: Int -> Int -> MVector s a -> MVector s a {-# INLINE slice #-} slice = G.slice take :: Int -> MVector s a -> MVector s a {-# INLINE take #-} take = G.take drop :: Int -> MVector s a -> MVector s a {-# INLINE drop #-} drop = G.drop {-# INLINE splitAt #-} splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) splitAt = G.splitAt init :: MVector s a -> MVector s a {-# INLINE init #-} init = G.init tail :: MVector s a -> MVector s a {-# INLINE tail #-} tail = G.tail -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed. unsafeSlice :: Int -- ^ starting index -> Int -- ^ length of the slice -> MVector s a -> MVector s a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice unsafeTake :: Int -> MVector s a -> MVector s a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake unsafeDrop :: Int -> MVector s a -> MVector s a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop unsafeInit :: MVector s a -> MVector s a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit unsafeTail :: MVector s a -> MVector s a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- Overlapping -- ----------- -- Check whether two vectors overlap. overlaps :: MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps -- Initialisation -- -------------- -- | Create a mutable vector of the given length. new :: PrimMonad m => Int -> m (MVector (PrimState m) a) {-# INLINE new #-} new = G.new -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with an initial value. replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) {-# INLINE replicate #-} replicate = G.replicate -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | Create a copy of a mutable vector. clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) {-# INLINE clone #-} clone = G.clone -- Growing -- ------- -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: PrimMonad m => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: PrimMonad m => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow -- Restricting memory usage -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed vectors. clear :: PrimMonad m => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear -- Accessing individual elements -- ----------------------------- -- | Yield the element at the given position. read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a {-# INLINE read #-} read = G.read -- | Replace the element at the given position. write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE write #-} write = G.write -- | Swap the elements at the given positions. swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-} swap = G.swap -- | Yield the element at the given position. No bounds checks are performed. unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead = G.unsafeRead -- | Replace the element at the given position. No bounds checks are performed. unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-} unsafeSwap = G.unsafeSwap -- Filling and copying -- ------------------- -- | Set all elements of the vector to the given value. set :: PrimMonad m => MVector (PrimState m) a -> a -> m () {-# INLINE set #-} set = G.set -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: PrimMonad m => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy -- | Copy a vector. The two vectors must have the same length and may not -- overlap. This is not checked. unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | Move the contents of a vector. The two vectors must have the same -- length. -- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: PrimMonad m => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE move #-} move = G.move -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked. -- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove vector-0.10.0.1/Data/Vector/Storable/0000755000000000000000000000000012035366315015311 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Storable/Mutable.hs0000644000000000000000000003567512035366315017256 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Storable.Mutable -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Mutable vectors based on Storable. -- module Data.Vector.Storable.Mutable( -- * Mutable vectors of 'Storable' types MVector(..), IOVector, STVector, Storable, -- * Accessors -- ** Length information length, null, -- ** Extracting subvectors 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, -- * Accessing individual elements read, write, swap, unsafeRead, unsafeWrite, unsafeSwap, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove, -- * Unsafe conversions unsafeCast, -- * Raw pointers unsafeFromForeignPtr, unsafeFromForeignPtr0, unsafeToForeignPtr, unsafeToForeignPtr0, unsafeWith ) where import Control.DeepSeq ( NFData ) import qualified Data.Vector.Generic.Mutable as G import Data.Vector.Storable.Internal import Foreign.Storable import Foreign.ForeignPtr #if __GLASGOW_HASKELL__ >= 605 import GHC.ForeignPtr (mallocPlainForeignPtrBytes) #endif import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) import Foreign.C.Types ( CInt ) import Control.Monad.Primitive import Data.Primitive.Addr import Data.Primitive.Types (Prim) import GHC.Word (Word8, Word16, Word32, Word64) import GHC.Ptr (Ptr(..)) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail ) import Data.Typeable ( Typeable ) #include "vector.h" -- | Mutable 'Storable'-based vectors data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) type IOVector = MVector RealWorld type STVector s = MVector s instance NFData (MVector s a) instance Storable a => G.MVector MVector a where {-# INLINE basicLength #-} basicLength (MVector n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j m (MVector n fp) = MVector m (updPtr (`advancePtr` j) fp) -- FIXME: this relies on non-portable pointer comparisons {-# INLINE basicOverlaps #-} basicOverlaps (MVector m fp) (MVector n fq) = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) where between x y z = x >= y && x < z p = getPtr fp q = getPtr fq {-# INLINE basicUnsafeNew #-} basicUnsafeNew n = unsafePrimToPrim $ do fp <- mallocVector n return $ MVector n fp {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MVector _ fp) i = unsafePrimToPrim $ withForeignPtr fp (`peekElemOff` i) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector _ fp) i x = unsafePrimToPrim $ withForeignPtr fp $ \p -> pokeElemOff p i x {-# INLINE basicSet #-} basicSet = storableSet {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector n fp) (MVector _ fq) = unsafePrimToPrim $ withForeignPtr fp $ \p -> withForeignPtr fq $ \q -> copyArray p q n {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MVector n fp) (MVector _ fq) = unsafePrimToPrim $ withForeignPtr fp $ \p -> withForeignPtr fq $ \q -> moveArray p q n storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m () {-# INLINE storableSet #-} storableSet v@(MVector n fp) x | n == 0 = return () | otherwise = unsafePrimToPrim $ case sizeOf x of 1 -> storableSetAsPrim n fp x (undefined :: Word8) 2 -> storableSetAsPrim n fp x (undefined :: Word16) 4 -> storableSetAsPrim n fp x (undefined :: Word32) 8 -> storableSetAsPrim n fp x (undefined :: Word64) _ -> withForeignPtr fp $ \p -> do poke p x let do_set i | 2*i < n = do copyArray (p `advancePtr` i) p i do_set (2*i) | otherwise = copyArray (p `advancePtr` i) p (n-i) do_set 1 storableSetAsPrim :: (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () {-# INLINE [0] storableSetAsPrim #-} storableSetAsPrim n fp x y = withForeignPtr fp $ \(Ptr p) -> do poke (Ptr p) x let q = Addr p w <- readOffAddr q 0 setAddr (q `plusAddr` sizeOf x) (n-1) (w `asTypeOf` y) {-# INLINE mallocVector #-} mallocVector :: Storable a => Int -> IO (ForeignPtr a) mallocVector = #if __GLASGOW_HASKELL__ >= 605 doMalloc undefined where doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) doMalloc dummy size = mallocPlainForeignPtrBytes (size * sizeOf dummy) #else mallocForeignPtrArray #endif -- Length information -- ------------------ -- | Length of the mutable vector. length :: Storable a => MVector s a -> Int {-# INLINE length #-} length = G.length -- | Check whether the vector is empty null :: Storable a => MVector s a -> Bool {-# INLINE null #-} null = G.null -- Extracting subvectors -- --------------------- -- | Yield a part of the mutable vector without copying it. slice :: Storable a => Int -> Int -> MVector s a -> MVector s a {-# INLINE slice #-} slice = G.slice take :: Storable a => Int -> MVector s a -> MVector s a {-# INLINE take #-} take = G.take drop :: Storable a => Int -> MVector s a -> MVector s a {-# INLINE drop #-} drop = G.drop splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) {-# INLINE splitAt #-} splitAt = G.splitAt init :: Storable a => MVector s a -> MVector s a {-# INLINE init #-} init = G.init tail :: Storable a => MVector s a -> MVector s a {-# INLINE tail #-} tail = G.tail -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed. unsafeSlice :: Storable a => Int -- ^ starting index -> Int -- ^ length of the slice -> MVector s a -> MVector s a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice unsafeTake :: Storable a => Int -> MVector s a -> MVector s a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop unsafeInit :: Storable a => MVector s a -> MVector s a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit unsafeTail :: Storable a => MVector s a -> MVector s a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- Overlapping -- ----------- -- Check whether two vectors overlap. overlaps :: Storable a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps -- Initialisation -- -------------- -- | Create a mutable vector of the given length. new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) {-# INLINE new #-} new = G.new -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with an initial value. replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) {-# INLINE replicate #-} replicate = G.replicate -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) {-# INLINE clone #-} clone = G.clone -- Growing -- ------- -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow -- Restricting memory usage -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear -- Accessing individual elements -- ----------------------------- -- | Yield the element at the given position. read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a {-# INLINE read #-} read = G.read -- | Replace the element at the given position. write :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE write #-} write = G.write -- | Swap the elements at the given positions. swap :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-} swap = G.swap -- | Yield the element at the given position. No bounds checks are performed. unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead = G.unsafeRead -- | Replace the element at the given position. No bounds checks are performed. unsafeWrite :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-} unsafeSwap = G.unsafeSwap -- Filling and copying -- ------------------- -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () {-# INLINE set #-} set = G.set -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy -- | Copy a vector. The two vectors must have the same length and may not -- overlap. This is not checked. unsafeCopy :: (PrimMonad m, Storable a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | Move the contents of a vector. The two vectors must have the same -- length. -- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE move #-} move = G.move -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked. -- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: (PrimMonad m, Storable a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove -- Unsafe conversions -- ------------------ -- | /O(1)/ Unsafely cast a mutable vector from one element type to another. -- The operation just changes the type of the underlying pointer and does not -- modify the elements. -- -- The resulting vector contains as many elements as can fit into the -- underlying memory block. -- unsafeCast :: forall a b s. (Storable a, Storable b) => MVector s a -> MVector s b {-# INLINE unsafeCast #-} unsafeCast (MVector n fp) = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp) -- Raw pointers -- ------------ -- | Create a mutable vector from a 'ForeignPtr' with an offset and a length. -- -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector -- could have been frozen before the modification. -- -- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. unsafeFromForeignPtr :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ offset -> Int -- ^ length -> MVector s a {-# INLINE unsafeFromForeignPtr #-} unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n where fp' = updPtr (`advancePtr` i) fp {-# RULES "unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} -- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. -- -- It is assumed the pointer points directly to the data (no offset). -- Use `unsafeFromForeignPtr` if you need to specify an offset. -- -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector -- could have been frozen before the modification. unsafeFromForeignPtr0 :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ length -> MVector s a {-# INLINE unsafeFromForeignPtr0 #-} unsafeFromForeignPtr0 fp n = MVector n fp -- | Yield the underlying 'ForeignPtr' together with the offset to the data -- and its length. Modifying the data through the 'ForeignPtr' is -- unsafe if the vector could have frozen before the modification. unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} unsafeToForeignPtr (MVector n fp) = (fp, 0, n) -- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. -- -- You can assume the pointer points directly to the data (no offset). -- -- Modifying the data through the 'ForeignPtr' is unsafe if the vector could -- have frozen before the modification. unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int) {-# INLINE unsafeToForeignPtr0 #-} unsafeToForeignPtr0 (MVector n fp) = (fp, n) -- | Pass a pointer to the vector's data to the IO action. Modifying data -- through the pointer is unsafe if the vector could have been frozen before -- the modification. unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-} unsafeWith (MVector n fp) = withForeignPtr fp vector-0.10.0.1/Data/Vector/Storable/Internal.hs0000644000000000000000000000204612035366315017423 0ustar0000000000000000-- | -- Module : Data.Vector.Storable.Internal -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Ugly internal utility functions for implementing 'Storable'-based vectors. -- module Data.Vector.Storable.Internal ( getPtr, setPtr, updPtr ) where import Control.Monad.Primitive ( unsafeInlineIO ) import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr ) import GHC.Base ( quotInt ) import GHC.ForeignPtr ( ForeignPtr(..) ) import GHC.Ptr ( Ptr(..) ) getPtr :: ForeignPtr a -> Ptr a {-# INLINE getPtr #-} getPtr (ForeignPtr addr _) = Ptr addr setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a {-# INLINE setPtr #-} setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a {-# INLINE updPtr #-} updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } vector-0.10.0.1/Data/Vector/Generic/0000755000000000000000000000000012035366315015112 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Generic/New.hs0000644000000000000000000001165712035366315016211 0ustar0000000000000000{-# LANGUAGE Rank2Types, FlexibleContexts #-} -- | -- Module : Data.Vector.Generic.New -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Purely functional interface to initialisation of mutable vectors -- module Data.Vector.Generic.New ( New(..), create, run, runPrim, apply, modify, modifyWithStream, unstream, transform, unstreamR, transformR, slice, init, tail, take, drop, unsafeSlice, unsafeInit, unsafeTail ) where import qualified Data.Vector.Generic.Mutable as MVector import Data.Vector.Generic.Mutable ( MVector ) import Data.Vector.Generic.Base ( Vector, Mutable ) import Data.Vector.Fusion.Stream ( Stream, MStream ) import qualified Data.Vector.Fusion.Stream as Stream import Control.Monad.Primitive import Control.Monad.ST ( ST ) import Control.Monad ( liftM ) import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) #include "vector.h" data New v a = New (forall s. ST s (Mutable v s a)) create :: (forall s. ST s (Mutable v s a)) -> New v a {-# INLINE create #-} create p = New p run :: New v a -> ST s (Mutable v s a) {-# INLINE run #-} run (New p) = p runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) {-# INLINE runPrim #-} runPrim (New p) = primToPrim p apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a {-# INLINE apply #-} apply f (New p) = New (liftM f p) modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a {-# INLINE modify #-} modify f (New p) = New (do { v <- p; f v; return v }) modifyWithStream :: (forall s. Mutable v s a -> Stream b -> ST s ()) -> New v a -> Stream b -> New v a {-# INLINE_STREAM modifyWithStream #-} modifyWithStream f (New p) s = s `seq` New (do { v <- p; f v s; return v }) unstream :: Vector v a => Stream a -> New v a {-# INLINE_STREAM unstream #-} unstream s = s `seq` New (MVector.unstream s) transform :: Vector v a => (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a {-# INLINE_STREAM transform #-} transform f (New p) = New (MVector.transform f =<< p) {-# RULES "transform/transform [New]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) (g :: forall m. Monad m => MStream m a -> MStream m a) p . transform f (transform g p) = transform (f . g) p "transform/unstream [New]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) s. transform f (unstream s) = unstream (f s) #-} unstreamR :: Vector v a => Stream a -> New v a {-# INLINE_STREAM unstreamR #-} unstreamR s = s `seq` New (MVector.unstreamR s) transformR :: Vector v a => (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a {-# INLINE_STREAM transformR #-} transformR f (New p) = New (MVector.transformR f =<< p) {-# RULES "transformR/transformR [New]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) (g :: forall m. Monad m => MStream m a -> MStream m a) p . transformR f (transformR g p) = transformR (f . g) p "transformR/unstreamR [New]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) s. transformR f (unstreamR s) = unstreamR (f s) #-} slice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_STREAM slice #-} slice i n m = apply (MVector.slice i n) m init :: Vector v a => New v a -> New v a {-# INLINE_STREAM init #-} init m = apply MVector.init m tail :: Vector v a => New v a -> New v a {-# INLINE_STREAM tail #-} tail m = apply MVector.tail m take :: Vector v a => Int -> New v a -> New v a {-# INLINE_STREAM take #-} take n m = apply (MVector.take n) m drop :: Vector v a => Int -> New v a -> New v a {-# INLINE_STREAM drop #-} drop n m = apply (MVector.drop n) m unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_STREAM unsafeSlice #-} unsafeSlice i n m = apply (MVector.unsafeSlice i n) m unsafeInit :: Vector v a => New v a -> New v a {-# INLINE_STREAM unsafeInit #-} unsafeInit m = apply MVector.unsafeInit m unsafeTail :: Vector v a => New v a -> New v a {-# INLINE_STREAM unsafeTail #-} unsafeTail m = apply MVector.unsafeTail m {-# RULES "slice/unstream [New]" forall i n s. slice i n (unstream s) = unstream (Stream.slice i n s) "init/unstream [New]" forall s. init (unstream s) = unstream (Stream.init s) "tail/unstream [New]" forall s. tail (unstream s) = unstream (Stream.tail s) "take/unstream [New]" forall n s. take n (unstream s) = unstream (Stream.take n s) "drop/unstream [New]" forall n s. drop n (unstream s) = unstream (Stream.drop n s) "unsafeSlice/unstream [New]" forall i n s. unsafeSlice i n (unstream s) = unstream (Stream.slice i n s) "unsafeInit/unstream [New]" forall s. unsafeInit (unstream s) = unstream (Stream.init s) "unsafeTail/unstream [New]" forall s. unsafeTail (unstream s) = unstream (Stream.tail s) #-} vector-0.10.0.1/Data/Vector/Generic/Mutable.hs0000644000000000000000000007502112035366315017044 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, BangPatterns, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Generic.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Generic interface to mutable vectors -- module Data.Vector.Generic.Mutable ( -- * Class of mutable vector types MVector(..), -- * Accessors -- ** Length information length, null, -- ** Extracting subvectors 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, -- * Accessing individual elements read, write, swap, unsafeRead, unsafeWrite, unsafeSwap, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove, -- * Internal operations mstream, mstreamR, unstream, unstreamR, munstream, munstreamR, transform, transformR, fill, fillR, unsafeAccum, accum, unsafeUpdate, update, reverse, unstablePartition, unstablePartitionStream, partitionStream ) where import qualified Data.Vector.Fusion.Stream as Stream import Data.Vector.Fusion.Stream ( Stream, MStream ) import qualified Data.Vector.Fusion.Stream.Monadic as MStream import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util ( delay_inline ) import Control.Monad.Primitive ( PrimMonad, PrimState ) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail ) #include "vector.h" -- | Class of mutable vectors parametrised with a primitive state token. -- -- Minimum complete implementation: -- -- * 'basicLength' -- -- * 'basicUnsafeSlice' -- -- * 'basicOverlaps' -- -- * 'basicUnsafeNew' -- -- * 'basicUnsafeRead' -- -- * 'basicUnsafeWrite' -- class MVector v a where -- | Length of the mutable vector. This method should not be -- called directly, use 'length' instead. basicLength :: v s a -> Int -- | Yield a part of the mutable vector without copying it. This method -- should not be called directly, use 'unsafeSlice' instead. basicUnsafeSlice :: Int -- ^ starting index -> Int -- ^ length of the slice -> v s a -> v s a -- Check whether two vectors overlap. This method should not be -- called directly, use 'overlaps' instead. basicOverlaps :: v s a -> v s a -> Bool -- | Create a mutable vector of the given length. This method should not be -- called directly, use 'unsafeNew' instead. basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) -- | Create a mutable vector of the given length and fill it with an -- initial value. This method should not be called directly, use -- 'replicate' instead. basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a) -- | Yield the element at the given position. This method should not be -- called directly, use 'unsafeRead' instead. basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a -- | Replace the element at the given position. This method should not be -- called directly, use 'unsafeWrite' instead. basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed -- vectors. This method should not be called directly, use 'clear' instead. basicClear :: PrimMonad m => v (PrimState m) a -> m () -- | Set all elements of the vector to the given value. This method should -- not be called directly, use 'set' instead. basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () -- | Copy a vector. The two vectors may not overlap. This method should not -- be called directly, use 'unsafeCopy' instead. basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target -> v (PrimState m) a -- ^ source -> m () -- | Move the contents of a vector. The two vectors may overlap. This method -- should not be called directly, use 'unsafeMove' instead. basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target -> v (PrimState m) a -- ^ source -> m () -- | Grow a vector by the given number of elements. This method should not be -- called directly, use 'unsafeGrow' instead. basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n x = do v <- basicUnsafeNew n basicSet v x return v {-# INLINE basicClear #-} basicClear _ = return () {-# INLINE basicSet #-} basicSet !v x | n == 0 = return () | otherwise = do basicUnsafeWrite v 0 x do_set 1 where !n = basicLength v do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) (basicUnsafeSlice 0 i v) do_set (2*i) | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) (basicUnsafeSlice 0 (n-i) v) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy !dst !src = do_copy 0 where !n = basicLength src do_copy i | i < n = do x <- basicUnsafeRead src i basicUnsafeWrite dst i x do_copy (i+1) | otherwise = return () {-# INLINE basicUnsafeMove #-} basicUnsafeMove !dst !src | basicOverlaps dst src = do srcCopy <- clone src basicUnsafeCopy dst srcCopy | otherwise = basicUnsafeCopy dst src {-# INLINE basicUnsafeGrow #-} basicUnsafeGrow v by = do v' <- basicUnsafeNew (n+by) basicUnsafeCopy (basicUnsafeSlice 0 n v') v return v' where n = basicLength v -- ------------------ -- Internal functions -- ------------------ unsafeAppend1 :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a) {-# INLINE_INNER unsafeAppend1 #-} -- NOTE: The case distinction has to be on the outside because -- GHC creates a join point for the unsafeWrite even when everything -- is inlined. This is bad because with the join point, v isn't getting -- unboxed. unsafeAppend1 v i x | i < length v = do unsafeWrite v i x return v | otherwise = do v' <- enlarge v INTERNAL_CHECK(checkIndex) "unsafeAppend1" i (length v') $ unsafeWrite v' i x return v' unsafePrepend1 :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int) {-# INLINE_INNER unsafePrepend1 #-} unsafePrepend1 v i x | i /= 0 = do let i' = i-1 unsafeWrite v i' x return (v, i') | otherwise = do (v', i) <- enlargeFront v let i' = i-1 INTERNAL_CHECK(checkIndex) "unsafePrepend1" i' (length v') $ unsafeWrite v' i' x return (v', i') mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a {-# INLINE mstream #-} mstream v = v `seq` n `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n) where n = length v {-# INLINE_INNER get #-} get i | i < n = do x <- unsafeRead v i return $ Just (x, i+1) | otherwise = return $ Nothing fill :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) {-# INLINE fill #-} fill v s = v `seq` do n' <- MStream.foldM put 0 s return $ unsafeSlice 0 n' v where {-# INLINE_INNER put #-} put i x = do INTERNAL_CHECK(checkIndex) "fill" i (length v) $ unsafeWrite v i x return (i+1) transform :: (PrimMonad m, MVector v a) => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_STREAM transform #-} transform f v = fill v (f (mstream v)) mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a {-# INLINE mstreamR #-} mstreamR v = v `seq` n `seq` (MStream.unfoldrM get n `MStream.sized` Exact n) where n = length v {-# INLINE_INNER get #-} get i | j >= 0 = do x <- unsafeRead v j return $ Just (x,j) | otherwise = return Nothing where j = i-1 fillR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) {-# INLINE fillR #-} fillR v s = v `seq` do i <- MStream.foldM put n s return $ unsafeSlice i (n-i) v where n = length v {-# INLINE_INNER put #-} put i x = do unsafeWrite v j x return j where j = i-1 transformR :: (PrimMonad m, MVector v a) => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_STREAM transformR #-} transformR f v = fillR v (f (mstreamR v)) -- | Create a new mutable vector and fill it with elements from the 'Stream'. -- The vector will grow exponentially if the maximum size of the 'Stream' is -- unknown. unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) -- NOTE: replace INLINE_STREAM by INLINE? (also in unstreamR) {-# INLINE_STREAM unstream #-} unstream s = munstream (Stream.liftStream s) -- | Create a new mutable vector and fill it with elements from the monadic -- stream. The vector will grow exponentially if the maximum size of the stream -- is unknown. munstream :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE_STREAM munstream #-} munstream s = case upperBound (MStream.size s) of Just n -> munstreamMax s n Nothing -> munstreamUnknown s -- FIXME: I can't think of how to prevent GHC from floating out -- unstreamUnknown. That is bad because SpecConstr then generates two -- specialisations: one for when it is called from unstream (it doesn't know -- the shape of the vector) and one for when the vector has grown. To see the -- problem simply compile this: -- -- fromList = Data.Vector.Unboxed.unstream . Stream.fromList -- -- I'm not sure this still applies (19/04/2010) munstreamMax :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamMax #-} munstreamMax s n = do v <- INTERNAL_CHECK(checkLength) "munstreamMax" n $ unsafeNew n let put i x = do INTERNAL_CHECK(checkIndex) "munstreamMax" i n $ unsafeWrite v i x return (i+1) n' <- MStream.foldM' put 0 s return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n $ unsafeSlice 0 n' v munstreamUnknown :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE munstreamUnknown #-} munstreamUnknown s = do v <- unsafeNew 0 (v', n) <- MStream.foldM put (v, 0) s return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') $ unsafeSlice 0 n v' where {-# INLINE_INNER put #-} put (v,i) x = do v' <- unsafeAppend1 v i x return (v',i+1) -- | Create a new mutable vector and fill it with elements from the 'Stream' -- from right to left. The vector will grow exponentially if the maximum size -- of the 'Stream' is unknown. unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a) -- NOTE: replace INLINE_STREAM by INLINE? (also in unstream) {-# INLINE_STREAM unstreamR #-} unstreamR s = munstreamR (Stream.liftStream s) -- | Create a new mutable vector and fill it with elements from the monadic -- stream from right to left. The vector will grow exponentially if the maximum -- size of the stream is unknown. munstreamR :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE_STREAM munstreamR #-} munstreamR s = case upperBound (MStream.size s) of Just n -> munstreamRMax s n Nothing -> munstreamRUnknown s munstreamRMax :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamRMax #-} munstreamRMax s n = do v <- INTERNAL_CHECK(checkLength) "munstreamRMax" n $ unsafeNew n let put i x = do let i' = i-1 INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n $ unsafeWrite v i' x return i' i <- MStream.foldM' put n s return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n $ unsafeSlice i (n-i) v munstreamRUnknown :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE munstreamRUnknown #-} munstreamRUnknown s = do v <- unsafeNew 0 (v', i) <- MStream.foldM put (v, 0) s let n = length v' return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n $ unsafeSlice i (n-i) v' where {-# INLINE_INNER put #-} put (v,i) x = unsafePrepend1 v i x -- Length -- ------ -- | Length of the mutable vector. length :: MVector v a => v s a -> Int {-# INLINE length #-} length = basicLength -- | Check whether the vector is empty null :: MVector v a => v s a -> Bool {-# INLINE null #-} null v = length v == 0 -- Extracting subvectors -- --------------------- -- | Yield a part of the mutable vector without copying it. slice :: MVector v a => Int -> Int -> v s a -> v s a {-# INLINE slice #-} slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) $ unsafeSlice i n v take :: MVector v a => Int -> v s a -> v s a {-# INLINE take #-} take n v = unsafeSlice 0 (min (max n 0) (length v)) v drop :: MVector v a => Int -> v s a -> v s a {-# INLINE drop #-} drop n v = unsafeSlice (min m n') (max 0 (m - n')) v where n' = max n 0 m = length v {-# INLINE splitAt #-} splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) splitAt n v = ( unsafeSlice 0 m v , unsafeSlice m (max 0 (len - n')) v ) where m = min n' len n' = max n 0 len = length v init :: MVector v a => v s a -> v s a {-# INLINE init #-} init v = slice 0 (length v - 1) v tail :: MVector v a => v s a -> v s a {-# INLINE tail #-} tail v = slice 1 (length v - 1) v -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed. unsafeSlice :: MVector v a => Int -- ^ starting index -> Int -- ^ length of the slice -> v s a -> v s a {-# INLINE unsafeSlice #-} unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) $ basicUnsafeSlice i n v unsafeInit :: MVector v a => v s a -> v s a {-# INLINE unsafeInit #-} unsafeInit v = unsafeSlice 0 (length v - 1) v unsafeTail :: MVector v a => v s a -> v s a {-# INLINE unsafeTail #-} unsafeTail v = unsafeSlice 1 (length v - 1) v unsafeTake :: MVector v a => Int -> v s a -> v s a {-# INLINE unsafeTake #-} unsafeTake n v = unsafeSlice 0 n v unsafeDrop :: MVector v a => Int -> v s a -> v s a {-# INLINE unsafeDrop #-} unsafeDrop n v = unsafeSlice n (length v - n) v -- Overlapping -- ----------- -- Check whether two vectors overlap. overlaps :: MVector v a => v s a -> v s a -> Bool {-# INLINE overlaps #-} overlaps = basicOverlaps -- Initialisation -- -------------- -- | Create a mutable vector of the given length. new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) {-# INLINE new #-} new n = BOUNDS_CHECK(checkLength) "new" n $ unsafeNew n -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n $ basicUnsafeNew n -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with an initial value. replicate :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) {-# INLINE replicate #-} replicate n x = basicUnsafeReplicate (delay_inline max 0 n) x -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, MVector v a) => Int -> m a -> m (v (PrimState m) a) {-# INLINE replicateM #-} replicateM n m = munstream (MStream.replicateM n m) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE clone #-} clone v = do v' <- unsafeNew (length v) unsafeCopy v' v return v' -- Growing -- ------- -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE grow #-} grow v by = BOUNDS_CHECK(checkLength) "grow" by $ unsafeGrow v by growFront :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE growFront #-} growFront v by = BOUNDS_CHECK(checkLength) "growFront" by $ unsafeGrowFront v by enlarge_delta v = max (length v) 1 -- | Grow a vector logarithmically enlarge :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE enlarge #-} enlarge v = unsafeGrow v (enlarge_delta v) enlargeFront :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a, Int) {-# INLINE enlargeFront #-} enlargeFront v = do v' <- unsafeGrowFront v by return (v', by) where by = enlarge_delta v -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n $ basicUnsafeGrow v n unsafeGrowFront :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m (v (PrimState m) a) {-# INLINE unsafeGrowFront #-} unsafeGrowFront v by = UNSAFE_CHECK(checkLength) "unsafeGrowFront" by $ do let n = length v v' <- basicUnsafeNew (by+n) basicUnsafeCopy (basicUnsafeSlice by n v') v return v' -- Restricting memory usage -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () {-# INLINE clear #-} clear = basicClear -- Accessing individual elements -- ----------------------------- -- | Yield the element at the given position. read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a {-# INLINE read #-} read v i = BOUNDS_CHECK(checkIndex) "read" i (length v) $ unsafeRead v i -- | Replace the element at the given position. write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () {-# INLINE write #-} write v i x = BOUNDS_CHECK(checkIndex) "write" i (length v) $ unsafeWrite v i x -- | Swap the elements at the given positions. swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-} swap v i j = BOUNDS_CHECK(checkIndex) "swap" i (length v) $ BOUNDS_CHECK(checkIndex) "swap" j (length v) $ unsafeSwap v i j -- | Replace the element at the give position and return the old element. exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a {-# INLINE exchange #-} exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v) $ unsafeExchange v i x -- | Yield the element at the given position. No bounds checks are performed. unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead v i = UNSAFE_CHECK(checkIndex) "unsafeRead" i (length v) $ basicUnsafeRead v i -- | Replace the element at the given position. No bounds checks are performed. unsafeWrite :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite v i x = UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v) $ basicUnsafeWrite v i x -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-} unsafeSwap v i j = UNSAFE_CHECK(checkIndex) "unsafeSwap" i (length v) $ UNSAFE_CHECK(checkIndex) "unsafeSwap" j (length v) $ do x <- unsafeRead v i y <- unsafeRead v j unsafeWrite v i y unsafeWrite v j x -- | Replace the element at the give position and return the old element. No -- bounds checks are performed. unsafeExchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a {-# INLINE unsafeExchange #-} unsafeExchange v i x = UNSAFE_CHECK(checkIndex) "unsafeExchange" i (length v) $ do y <- unsafeRead v i unsafeWrite v i x return y -- Filling and copying -- ------------------- -- | Set all elements of the vector to the given value. set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () {-# INLINE set #-} set = basicSet -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, MVector v a) => v (PrimState m) a -> v (PrimState m) a -> m () {-# INLINE copy #-} copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors" (not (dst `overlaps` src)) $ BOUNDS_CHECK(check) "copy" "length mismatch" (length dst == length src) $ unsafeCopy dst src -- | Move the contents of a vector. The two vectors must have the same -- length. -- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, MVector v a) => v (PrimState m) a -> v (PrimState m) a -> m () {-# INLINE move #-} move dst src = BOUNDS_CHECK(check) "move" "length mismatch" (length dst == length src) $ unsafeMove dst src -- | Copy a vector. The two vectors must have the same length and may not -- overlap. This is not checked. unsafeCopy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target -> v (PrimState m) a -- ^ source -> m () {-# INLINE unsafeCopy #-} unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" (length dst == length src) $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors" (not (dst `overlaps` src)) $ (dst `seq` src `seq` basicUnsafeCopy dst src) -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked. -- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target -> v (PrimState m) a -- ^ source -> m () {-# INLINE unsafeMove #-} unsafeMove dst src = UNSAFE_CHECK(check) "unsafeMove" "length mismatch" (length dst == length src) $ (dst `seq` src `seq` basicUnsafeMove dst src) -- Permutations -- ------------ accum :: (PrimMonad m, MVector v a) => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () {-# INLINE accum #-} accum f !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = do a <- BOUNDS_CHECK(checkIndex) "accum" i n $ unsafeRead v i unsafeWrite v i (f a b) !n = length v update :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream (Int, a) -> m () {-# INLINE update #-} update !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n $ unsafeWrite v i b !n = length v unsafeAccum :: (PrimMonad m, MVector v a) => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () {-# INLINE unsafeAccum #-} unsafeAccum f !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = do a <- UNSAFE_CHECK(checkIndex) "accum" i n $ unsafeRead v i unsafeWrite v i (f a b) !n = length v unsafeUpdate :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream (Int, a) -> m () {-# INLINE unsafeUpdate #-} unsafeUpdate !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n $ unsafeWrite v i b !n = length v reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () {-# INLINE reverse #-} reverse !v = reverse_loop 0 (length v - 1) where reverse_loop i j | i < j = do unsafeSwap v i j reverse_loop (i + 1) (j - 1) reverse_loop _ _ = return () unstablePartition :: forall m v a. (PrimMonad m, MVector v a) => (a -> Bool) -> v (PrimState m) a -> m Int {-# INLINE unstablePartition #-} unstablePartition f !v = from_left 0 (length v) where -- NOTE: GHC 6.10.4 panics without the signatures on from_left and -- from_right from_left :: Int -> Int -> m Int from_left i j | i == j = return i | otherwise = do x <- unsafeRead v i if f x then from_left (i+1) j else from_right i (j-1) from_right :: Int -> Int -> m Int from_right i j | i == j = return i | otherwise = do x <- unsafeRead v j if f x then do y <- unsafeRead v i unsafeWrite v i x unsafeWrite v j y from_left (i+1) j else from_right i (j-1) unstablePartitionStream :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE unstablePartitionStream #-} unstablePartitionStream f s = case upperBound (Stream.size s) of Just n -> unstablePartitionMax f s n Nothing -> partitionUnknown f s unstablePartitionMax :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE unstablePartitionMax #-} unstablePartitionMax f s n = do v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n $ unsafeNew n let {-# INLINE_INNER put #-} put (i, j) x | f x = do unsafeWrite v i x return (i+1, j) | otherwise = do unsafeWrite v (j-1) x return (i, j-1) (i,j) <- Stream.foldM' put (0, n) s return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) partitionStream :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionStream #-} partitionStream f s = case upperBound (Stream.size s) of Just n -> partitionMax f s n Nothing -> partitionUnknown f s partitionMax :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionMax #-} partitionMax f s n = do v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n $ unsafeNew n let {-# INLINE_INNER put #-} put (i,j) x | f x = do unsafeWrite v i x return (i+1,j) | otherwise = let j' = j-1 in do unsafeWrite v j' x return (i,j') (i,j) <- Stream.foldM' put (0,n) s INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j) $ return () let l = unsafeSlice 0 i v r = unsafeSlice j (n-j) v reverse r return (l,r) partitionUnknown :: (PrimMonad m, MVector v a) => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionUnknown #-} partitionUnknown f s = do v1 <- unsafeNew 0 v2 <- unsafeNew 0 (v1', n1, v2', n2) <- Stream.foldM' put (v1, 0, v2, 0) s INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1') $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2') $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') where -- NOTE: The case distinction has to be on the outside because -- GHC creates a join point for the unsafeWrite even when everything -- is inlined. This is bad because with the join point, v isn't getting -- unboxed. {-# INLINE_INNER put #-} put (v1, i1, v2, i2) x | f x = do v1' <- unsafeAppend1 v1 i1 x return (v1', i1+1, v2, i2) | otherwise = do v2' <- unsafeAppend1 v2 i2 x return (v1, i1, v2', i2+1) vector-0.10.0.1/Data/Vector/Generic/Base.hs0000644000000000000000000001063512035366315016325 0ustar0000000000000000{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, ScopedTypeVariables, BangPatterns #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Vector.Generic.Base -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Class of pure vectors -- module Data.Vector.Generic.Base ( Vector(..), Mutable ) where import Data.Vector.Generic.Mutable ( MVector ) import qualified Data.Vector.Generic.Mutable as M import Control.Monad.Primitive -- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with -- the state token @s@ -- type family Mutable (v :: * -> *) :: * -> * -> * -- | Class of immutable vectors. Every immutable vector is associated with its -- mutable version through the 'Mutable' type family. Methods of this class -- should not be used directly. Instead, "Data.Vector.Generic" and other -- Data.Vector modules provide safe and fusible wrappers. -- -- Minimum complete implementation: -- -- * 'basicUnsafeFreeze' -- -- * 'basicUnsafeThaw' -- -- * 'basicLength' -- -- * 'basicUnsafeSlice' -- -- * 'basicUnsafeIndexM' -- class MVector (Mutable v) a => Vector v a where -- | /Assumed complexity: O(1)/ -- -- Unsafely convert a mutable vector to its immutable version -- without copying. The mutable vector may not be used after -- this operation. basicUnsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) -- | /Assumed complexity: O(1)/ -- -- Unsafely convert an immutable vector to its mutable version without -- copying. The immutable vector may not be used after this operation. basicUnsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a) -- | /Assumed complexity: O(1)/ -- -- Yield the length of the vector. basicLength :: v a -> Int -- | /Assumed complexity: O(1)/ -- -- Yield a slice of the vector without copying it. No range checks are -- performed. basicUnsafeSlice :: Int -- ^ starting index -> Int -- ^ length -> v a -> v a -- | /Assumed complexity: O(1)/ -- -- Yield the element at the given position in a monad. No range checks are -- performed. -- -- The monad allows us to be strict in the vector if we want. Suppose we had -- -- > unsafeIndex :: v a -> Int -> a -- -- instead. Now, if we wanted to copy a vector, we'd do something like -- -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ... -- -- For lazy vectors, the indexing would not be evaluated which means that we -- would retain a reference to the original vector in each element we write. -- This is not what we want! -- -- With 'basicUnsafeIndexM', we can do -- -- > copy mv v ... = ... case basicUnsafeIndexM v i of -- > Box x -> unsafeWrite mv i x ... -- -- which does not have this problem because indexing (but not the returned -- element!) is evaluated immediately. -- basicUnsafeIndexM :: Monad m => v a -> Int -> m a -- | /Assumed complexity: O(n)/ -- -- Copy an immutable vector into a mutable one. The two vectors must have -- the same length but this is not checked. -- -- Instances of 'Vector' should redefine this method if they wish to support -- an efficient block copy operation. -- -- Default definition: copying basic on 'basicUnsafeIndexM' and -- 'basicUnsafeWrite'. basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m () {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy !dst !src = do_copy 0 where !n = basicLength src do_copy i | i < n = do x <- basicUnsafeIndexM src i M.basicUnsafeWrite dst i x do_copy (i+1) | otherwise = return () -- | Evaluate @a@ as far as storing it in a vector would and yield @b@. -- The @v a@ argument only fixes the type and is not touched. The method is -- only used for optimisation purposes. Thus, it is safe for instances of -- 'Vector' to evaluate @a@ less than it would be when stored in a vector -- although this might result in suboptimal code. -- -- > elemseq v x y = (singleton x `asTypeOf` v) `seq` y -- -- Default defintion: @a@ is not evaluated at all -- elemseq :: v a -> a -> b -> b {-# INLINE elemseq #-} elemseq _ = \_ x -> x vector-0.10.0.1/Data/Vector/Internal/0000755000000000000000000000000012035366315015312 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Internal/Check.hs0000644000000000000000000001002212035366315016656 0ustar0000000000000000-- | -- Module : Data.Vector.Internal.Check -- Copyright : (c) Roman Leshchinskiy 2009 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Bounds checking infrastructure -- {-# LANGUAGE MagicHash #-} module Data.Vector.Internal.Check ( Checks(..), doChecks, error, internalError, check, checkIndex, checkLength, checkSlice ) where import GHC.Base( Int(..) ) import GHC.Prim( Int# ) import Prelude hiding( error, (&&), (||), not ) import qualified Prelude as P -- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline -- these functions into unfoldings which makes the intermediate code size -- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. infixr 2 || infixr 3 && not :: Bool -> Bool {-# INLINE not #-} not True = False not False = True (&&) :: Bool -> Bool -> Bool {-# INLINE (&&) #-} False && x = False True && x = x (||) :: Bool -> Bool -> Bool {-# INLINE (||) #-} True || x = True False || x = x data Checks = Bounds | Unsafe | Internal deriving( Eq ) doBoundsChecks :: Bool #ifdef VECTOR_BOUNDS_CHECKS doBoundsChecks = True #else doBoundsChecks = False #endif doUnsafeChecks :: Bool #ifdef VECTOR_UNSAFE_CHECKS doUnsafeChecks = True #else doUnsafeChecks = False #endif doInternalChecks :: Bool #ifdef VECTOR_INTERNAL_CHECKS doInternalChecks = True #else doInternalChecks = False #endif doChecks :: Checks -> Bool {-# INLINE doChecks #-} doChecks Bounds = doBoundsChecks doChecks Unsafe = doUnsafeChecks doChecks Internal = doInternalChecks error_msg :: String -> Int -> String -> String -> String error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg error :: String -> Int -> String -> String -> a {-# NOINLINE error #-} error file line loc msg = P.error $ error_msg file line loc msg internalError :: String -> Int -> String -> String -> a {-# NOINLINE internalError #-} internalError file line loc msg = P.error $ unlines ["*** Internal error in package vector ***" ,"*** Please submit a bug report at http://trac.haskell.org/vector" ,error_msg file line loc msg] checkError :: String -> Int -> Checks -> String -> String -> a {-# NOINLINE checkError #-} checkError file line kind loc msg = case kind of Internal -> internalError file line loc msg _ -> error file line loc msg check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a {-# INLINE check #-} check file line kind loc msg cond x | not (doChecks kind) || cond = x | otherwise = checkError file line kind loc msg checkIndex_msg :: Int -> Int -> String {-# INLINE checkIndex_msg #-} checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# checkIndex_msg# :: Int# -> Int# -> String {-# NOINLINE checkIndex_msg# #-} checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#) checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a {-# INLINE checkIndex #-} checkIndex file line kind loc i n x = check file line kind loc (checkIndex_msg i n) (i >= 0 && i String {-# INLINE checkLength_msg #-} checkLength_msg (I# n#) = checkLength_msg# n# checkLength_msg# :: Int# -> String {-# NOINLINE checkLength_msg# #-} checkLength_msg# n# = "negative length " ++ show (I# n#) checkLength :: String -> Int -> Checks -> String -> Int -> a -> a {-# INLINE checkLength #-} checkLength file line kind loc n x = check file line kind loc (checkLength_msg n) (n >= 0) x checkSlice_msg :: Int -> Int -> Int -> String {-# INLINE checkSlice_msg #-} checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n# checkSlice_msg# :: Int# -> Int# -> Int# -> String {-# NOINLINE checkSlice_msg# #-} checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a {-# INLINE checkSlice #-} checkSlice file line kind loc i m n x = check file line kind loc (checkSlice_msg i m n) (i >= 0 && m >= 0 && i+m <= n) x vector-0.10.0.1/Data/Vector/Fusion/0000755000000000000000000000000012035366315015001 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Fusion/Stream.hs0000644000000000000000000004046712035366315016603 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, Rank2Types, BangPatterns #-} -- | -- Module : Data.Vector.Fusion.Stream -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Streams for stream fusion -- module Data.Vector.Fusion.Stream ( -- * Types Step(..), Stream, MStream, -- * In-place markers inplace, -- * Size hints size, sized, -- * Length information length, null, -- * Construction empty, singleton, cons, snoc, replicate, generate, (++), -- * Accessing individual elements head, last, (!!), (!?), -- * Substreams slice, init, tail, take, drop, -- * Mapping map, concatMap, flatten, unbox, -- * Zipping indexed, indexedR, zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zip, zip3, zip4, zip5, zip6, -- * Filtering filter, takeWhile, dropWhile, -- * Searching elem, notElem, find, findIndex, -- * Folding foldl, foldl1, foldl', foldl1', foldr, foldr1, -- * Specialised folds and, or, -- * Unfolding unfoldr, unfoldrN, iterateN, -- * Scans prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', -- * Enumerations enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversions toList, fromList, fromListN, unsafeFromList, liftStream, -- * Monadic combinators mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', eq, cmp ) where import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util import Data.Vector.Fusion.Stream.Monadic ( Step(..), SPEC(..) ) import qualified Data.Vector.Fusion.Stream.Monadic as M import Prelude hiding ( length, null, replicate, (++), head, last, (!!), init, tail, take, drop, map, concatMap, zipWith, zipWith3, zip, zip3, filter, takeWhile, dropWhile, elem, notElem, foldl, foldl1, foldr, foldr1, and, or, scanl, scanl1, enumFromTo, enumFromThenTo, mapM, mapM_ ) import GHC.Base ( build ) #include "vector.h" -- | The type of pure streams type Stream = M.Stream Id -- | Alternative name for monadic streams type MStream = M.Stream inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m b) -> Stream a -> Stream b {-# INLINE_STREAM inplace #-} inplace f s = s `seq` f s {-# RULES "inplace/inplace [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) (g :: forall m. Monad m => MStream m a -> MStream m a) s. inplace f (inplace g s) = inplace (f . g) s #-} -- | Convert a pure stream to a monadic stream liftStream :: Monad m => Stream a -> M.Stream m a {-# INLINE_STREAM liftStream #-} liftStream (M.Stream step s sz) = M.Stream (return . unId . step) s sz -- | 'Size' hint of a 'Stream' size :: Stream a -> Size {-# INLINE size #-} size = M.size -- | Attach a 'Size' hint to a 'Stream' sized :: Stream a -> Size -> Stream a {-# INLINE sized #-} sized = M.sized -- Length -- ------ -- | Length of a 'Stream' length :: Stream a -> Int {-# INLINE length #-} length = unId . M.length -- | Check if a 'Stream' is empty null :: Stream a -> Bool {-# INLINE null #-} null = unId . M.null -- Construction -- ------------ -- | Empty 'Stream' empty :: Stream a {-# INLINE empty #-} empty = M.empty -- | Singleton 'Stream' singleton :: a -> Stream a {-# INLINE singleton #-} singleton = M.singleton -- | Replicate a value to a given length replicate :: Int -> a -> Stream a {-# INLINE replicate #-} replicate = M.replicate -- | Generate a stream from its indices generate :: Int -> (Int -> a) -> Stream a {-# INLINE generate #-} generate = M.generate -- | Prepend an element cons :: a -> Stream a -> Stream a {-# INLINE cons #-} cons = M.cons -- | Append an element snoc :: Stream a -> a -> Stream a {-# INLINE snoc #-} snoc = M.snoc infixr 5 ++ -- | Concatenate two 'Stream's (++) :: Stream a -> Stream a -> Stream a {-# INLINE (++) #-} (++) = (M.++) -- Accessing elements -- ------------------ -- | First element of the 'Stream' or error if empty head :: Stream a -> a {-# INLINE head #-} head = unId . M.head -- | Last element of the 'Stream' or error if empty last :: Stream a -> a {-# INLINE last #-} last = unId . M.last infixl 9 !! -- | Element at the given position (!!) :: Stream a -> Int -> a {-# INLINE (!!) #-} s !! i = unId (s M.!! i) infixl 9 !? -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Stream a -> Int -> Maybe a {-# INLINE (!?) #-} s !? i = unId (s M.!? i) -- Substreams -- ---------- -- | Extract a substream of the given length starting at the given position. slice :: Int -- ^ starting index -> Int -- ^ length -> Stream a -> Stream a {-# INLINE slice #-} slice = M.slice -- | All but the last element init :: Stream a -> Stream a {-# INLINE init #-} init = M.init -- | All but the first element tail :: Stream a -> Stream a {-# INLINE tail #-} tail = M.tail -- | The first @n@ elements take :: Int -> Stream a -> Stream a {-# INLINE take #-} take = M.take -- | All but the first @n@ elements drop :: Int -> Stream a -> Stream a {-# INLINE drop #-} drop = M.drop -- Mapping -- --------------- -- | Map a function over a 'Stream' map :: (a -> b) -> Stream a -> Stream b {-# INLINE map #-} map = M.map unbox :: Stream (Box a) -> Stream a {-# INLINE unbox #-} unbox = M.unbox concatMap :: (a -> Stream b) -> Stream a -> Stream b {-# INLINE concatMap #-} concatMap = M.concatMap -- Zipping -- ------- -- | Pair each element in a 'Stream' with its index indexed :: Stream a -> Stream (Int,a) {-# INLINE indexed #-} indexed = M.indexed -- | Pair each element in a 'Stream' with its index, starting from the right -- and counting down indexedR :: Int -> Stream a -> Stream (Int,a) {-# INLINE_STREAM indexedR #-} indexedR = M.indexedR -- | Zip two 'Stream's with the given function zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c {-# INLINE zipWith #-} zipWith = M.zipWith -- | Zip three 'Stream's with the given function zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d {-# INLINE zipWith3 #-} zipWith3 = M.zipWith3 zipWith4 :: (a -> b -> c -> d -> e) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e {-# INLINE zipWith4 #-} zipWith4 = M.zipWith4 zipWith5 :: (a -> b -> c -> d -> e -> f) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f {-# INLINE zipWith5 #-} zipWith5 = M.zipWith5 zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> Stream g {-# INLINE zipWith6 #-} zipWith6 = M.zipWith6 zip :: Stream a -> Stream b -> Stream (a,b) {-# INLINE zip #-} zip = M.zip zip3 :: Stream a -> Stream b -> Stream c -> Stream (a,b,c) {-# INLINE zip3 #-} zip3 = M.zip3 zip4 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream (a,b,c,d) {-# INLINE zip4 #-} zip4 = M.zip4 zip5 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream (a,b,c,d,e) {-# INLINE zip5 #-} zip5 = M.zip5 zip6 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> Stream (a,b,c,d,e,f) {-# INLINE zip6 #-} zip6 = M.zip6 -- Filtering -- --------- -- | Drop elements which do not satisfy the predicate filter :: (a -> Bool) -> Stream a -> Stream a {-# INLINE filter #-} filter = M.filter -- | Longest prefix of elements that satisfy the predicate takeWhile :: (a -> Bool) -> Stream a -> Stream a {-# INLINE takeWhile #-} takeWhile = M.takeWhile -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: (a -> Bool) -> Stream a -> Stream a {-# INLINE dropWhile #-} dropWhile = M.dropWhile -- Searching -- --------- infix 4 `elem` -- | Check whether the 'Stream' contains an element elem :: Eq a => a -> Stream a -> Bool {-# INLINE elem #-} elem x = unId . M.elem x infix 4 `notElem` -- | Inverse of `elem` notElem :: Eq a => a -> Stream a -> Bool {-# INLINE notElem #-} notElem x = unId . M.notElem x -- | Yield 'Just' the first element matching the predicate or 'Nothing' if no -- such element exists. find :: (a -> Bool) -> Stream a -> Maybe a {-# INLINE find #-} find f = unId . M.find f -- | Yield 'Just' the index of the first element matching the predicate or -- 'Nothing' if no such element exists. findIndex :: (a -> Bool) -> Stream a -> Maybe Int {-# INLINE findIndex #-} findIndex f = unId . M.findIndex f -- Folding -- ------- -- | Left fold foldl :: (a -> b -> a) -> a -> Stream b -> a {-# INLINE foldl #-} foldl f z = unId . M.foldl f z -- | Left fold on non-empty 'Stream's foldl1 :: (a -> a -> a) -> Stream a -> a {-# INLINE foldl1 #-} foldl1 f = unId . M.foldl1 f -- | Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Stream b -> a {-# INLINE foldl' #-} foldl' f z = unId . M.foldl' f z -- | Left fold on non-empty 'Stream's with strict accumulator foldl1' :: (a -> a -> a) -> Stream a -> a {-# INLINE foldl1' #-} foldl1' f = unId . M.foldl1' f -- | Right fold foldr :: (a -> b -> b) -> b -> Stream a -> b {-# INLINE foldr #-} foldr f z = unId . M.foldr f z -- | Right fold on non-empty 'Stream's foldr1 :: (a -> a -> a) -> Stream a -> a {-# INLINE foldr1 #-} foldr1 f = unId . M.foldr1 f -- Specialised folds -- ----------------- and :: Stream Bool -> Bool {-# INLINE and #-} and = unId . M.and or :: Stream Bool -> Bool {-# INLINE or #-} or = unId . M.or -- Unfolding -- --------- -- | Unfold unfoldr :: (s -> Maybe (a, s)) -> s -> Stream a {-# INLINE unfoldr #-} unfoldr = M.unfoldr -- | Unfold at most @n@ elements unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Stream a {-# INLINE unfoldrN #-} unfoldrN = M.unfoldrN -- | Apply function n-1 times to value. Zeroth element is original value. iterateN :: Int -> (a -> a) -> a -> Stream a {-# INLINE iterateN #-} iterateN = M.iterateN -- Scans -- ----- -- | Prefix scan prescanl :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE prescanl #-} prescanl = M.prescanl -- | Prefix scan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE prescanl' #-} prescanl' = M.prescanl' -- | Suffix scan postscanl :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE postscanl #-} postscanl = M.postscanl -- | Suffix scan with strict accumulator postscanl' :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE postscanl' #-} postscanl' = M.postscanl' -- | Haskell-style scan scanl :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE scanl #-} scanl = M.scanl -- | Haskell-style scan with strict accumulator scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a {-# INLINE scanl' #-} scanl' = M.scanl' -- | Scan over a non-empty 'Stream' scanl1 :: (a -> a -> a) -> Stream a -> Stream a {-# INLINE scanl1 #-} scanl1 = M.scanl1 -- | Scan over a non-empty 'Stream' with a strict accumulator scanl1' :: (a -> a -> a) -> Stream a -> Stream a {-# INLINE scanl1' #-} scanl1' = M.scanl1' -- Comparisons -- ----------- -- FIXME: Move these to Monadic -- | Check if two 'Stream's are equal eq :: Eq a => Stream a -> Stream a -> Bool {-# INLINE_STREAM eq #-} eq (M.Stream step1 s1 _) (M.Stream step2 s2 _) = eq_loop0 SPEC s1 s2 where eq_loop0 !sPEC s1 s2 = case unId (step1 s1) of Yield x s1' -> eq_loop1 SPEC x s1' s2 Skip s1' -> eq_loop0 SPEC s1' s2 Done -> null (M.Stream step2 s2 Unknown) eq_loop1 !sPEC x s1 s2 = case unId (step2 s2) of Yield y s2' -> x == y && eq_loop0 SPEC s1 s2' Skip s2' -> eq_loop1 SPEC x s1 s2' Done -> False -- | Lexicographically compare two 'Stream's cmp :: Ord a => Stream a -> Stream a -> Ordering {-# INLINE_STREAM cmp #-} cmp (M.Stream step1 s1 _) (M.Stream step2 s2 _) = cmp_loop0 SPEC s1 s2 where cmp_loop0 !sPEC s1 s2 = case unId (step1 s1) of Yield x s1' -> cmp_loop1 SPEC x s1' s2 Skip s1' -> cmp_loop0 SPEC s1' s2 Done -> if null (M.Stream step2 s2 Unknown) then EQ else LT cmp_loop1 !sPEC x s1 s2 = case unId (step2 s2) of Yield y s2' -> case x `compare` y of EQ -> cmp_loop0 SPEC s1 s2' c -> c Skip s2' -> cmp_loop1 SPEC x s1 s2' Done -> GT instance Eq a => Eq (M.Stream Id a) where {-# INLINE (==) #-} (==) = eq instance Ord a => Ord (M.Stream Id a) where {-# INLINE compare #-} compare = cmp -- Monadic combinators -- ------------------- -- | Apply a monadic action to each element of the stream, producing a monadic -- stream of results mapM :: Monad m => (a -> m b) -> Stream a -> M.Stream m b {-# INLINE mapM #-} mapM f = M.mapM f . liftStream -- | Apply a monadic action to each element of the stream mapM_ :: Monad m => (a -> m b) -> Stream a -> m () {-# INLINE mapM_ #-} mapM_ f = M.mapM_ f . liftStream zipWithM :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> M.Stream m c {-# INLINE zipWithM #-} zipWithM f as bs = M.zipWithM f (liftStream as) (liftStream bs) zipWithM_ :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f as bs = M.zipWithM_ f (liftStream as) (liftStream bs) -- | Yield a monadic stream of elements that satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream a -> M.Stream m a {-# INLINE filterM #-} filterM f = M.filterM f . liftStream -- | Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a {-# INLINE foldM #-} foldM m z = M.foldM m z . liftStream -- | Monadic fold over non-empty stream fold1M :: Monad m => (a -> a -> m a) -> Stream a -> m a {-# INLINE fold1M #-} fold1M m = M.fold1M m . liftStream -- | Monadic fold with strict accumulator foldM' :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a {-# INLINE foldM' #-} foldM' m z = M.foldM' m z . liftStream -- | Monad fold over non-empty stream with strict accumulator fold1M' :: Monad m => (a -> a -> m a) -> Stream a -> m a {-# INLINE fold1M' #-} fold1M' m = M.fold1M' m . liftStream -- Enumerations -- ------------ -- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. enumFromStepN :: Num a => a -> a -> Int -> Stream a {-# INLINE enumFromStepN #-} enumFromStepN = M.enumFromStepN -- | Enumerate values -- -- /WARNING:/ This operations can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromTo :: Enum a => a -> a -> Stream a {-# INLINE enumFromTo #-} enumFromTo = M.enumFromTo -- | Enumerate values with a given step. -- -- /WARNING:/ This operations is very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: Enum a => a -> a -> a -> Stream a {-# INLINE enumFromThenTo #-} enumFromThenTo = M.enumFromThenTo -- Conversions -- ----------- -- | Convert a 'Stream' to a list toList :: Stream a -> [a] {-# INLINE toList #-} -- toList s = unId (M.toList s) toList s = build (\c n -> toListFB c n s) -- This supports foldr/build list fusion that GHC implements toListFB :: (a -> b -> b) -> b -> Stream a -> b {-# INLINE [0] toListFB #-} toListFB c n (M.Stream step s _) = go s where go s = case unId (step s) of Yield x s' -> x `c` go s' Skip s' -> go s' Done -> n -- | Create a 'Stream' from a list fromList :: [a] -> Stream a {-# INLINE fromList #-} fromList = M.fromList -- | Create a 'Stream' from the first @n@ elements of a list -- -- > fromListN n xs = fromList (take n xs) fromListN :: Int -> [a] -> Stream a {-# INLINE fromListN #-} fromListN = M.fromListN unsafeFromList :: Size -> [a] -> Stream a {-# INLINE unsafeFromList #-} unsafeFromList = M.unsafeFromList -- | Create a 'Stream' of values from a 'Stream' of streamable things flatten :: (a -> s) -> (s -> Step s b) -> Size -> Stream a -> Stream b {-# INLINE_STREAM flatten #-} flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . liftStream vector-0.10.0.1/Data/Vector/Fusion/Util.hs0000644000000000000000000000173412035366315016257 0ustar0000000000000000-- | -- Module : Data.Vector.Fusion.Util -- Copyright : (c) Roman Leshchinskiy 2009 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Fusion-related utility types -- module Data.Vector.Fusion.Util ( Id(..), Box(..), delay_inline, delayed_min ) where -- | Identity monad newtype Id a = Id { unId :: a } instance Functor Id where fmap f (Id x) = Id (f x) instance Monad Id where return = Id Id x >>= f = f x -- | Box monad data Box a = Box { unBox :: a } instance Functor Box where fmap f (Box x) = Box (f x) instance Monad Box where return = Box Box x >>= f = f x -- | Delay inlining a function until late in the game (simplifier phase 0). delay_inline :: (a -> b) -> a -> b {-# INLINE [0] delay_inline #-} delay_inline f = f -- | `min` inlined in phase 0 delayed_min :: Int -> Int -> Int {-# INLINE [0] delayed_min #-} delayed_min m n = min m n vector-0.10.0.1/Data/Vector/Fusion/Stream/0000755000000000000000000000000012035366315016234 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Fusion/Stream/Size.hs0000644000000000000000000000467012035366315017511 0ustar0000000000000000-- | -- Module : Data.Vector.Fusion.Stream.Size -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Size hints for streams. -- module Data.Vector.Fusion.Stream.Size ( Size(..), smaller, larger, toMax, upperBound ) where import Data.Vector.Fusion.Util ( delay_inline ) -- | Size hint data Size = Exact Int -- ^ Exact size | Max Int -- ^ Upper bound on the size | Unknown -- ^ Unknown size deriving( Eq, Show ) instance Num Size where Exact m + Exact n = Exact (m+n) Exact m + Max n = Max (m+n) Max m + Exact n = Max (m+n) Max m + Max n = Max (m+n) _ + _ = Unknown Exact m - Exact n = Exact (m-n) Exact m - Max n = Max m Max m - Exact n = Max (m-n) Max m - Max n = Max m Max m - Unknown = Max m _ - _ = Unknown fromInteger n = Exact (fromInteger n) -- | Minimum of two size hints smaller :: Size -> Size -> Size {-# INLINE smaller #-} smaller (Exact m) (Exact n) = Exact (delay_inline min m n) smaller (Exact m) (Max n) = Max (delay_inline min m n) smaller (Exact m) Unknown = Max m smaller (Max m) (Exact n) = Max (delay_inline min m n) smaller (Max m) (Max n) = Max (delay_inline min m n) smaller (Max m) Unknown = Max m smaller Unknown (Exact n) = Max n smaller Unknown (Max n) = Max n smaller Unknown Unknown = Unknown -- | Maximum of two size hints larger :: Size -> Size -> Size {-# INLINE larger #-} larger (Exact m) (Exact n) = Exact (delay_inline max m n) larger (Exact m) (Max n) | m >= n = Exact m | otherwise = Max n larger (Max m) (Exact n) | n >= m = Exact n | otherwise = Max m larger (Max m) (Max n) = Max (delay_inline max m n) larger _ _ = Unknown -- | Convert a size hint to an upper bound toMax :: Size -> Size toMax (Exact n) = Max n toMax (Max n) = Max n toMax Unknown = Unknown -- | Compute the minimum size from a size hint lowerBound :: Size -> Int lowerBound (Exact n) = n lowerBound _ = 0 -- | Compute the maximum size from a size hint if possible upperBound :: Size -> Maybe Int upperBound (Exact n) = Just n upperBound (Max n) = Just n upperBound Unknown = Nothing vector-0.10.0.1/Data/Vector/Fusion/Stream/Monadic.hs0000644000000000000000000014001312035366315020141 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification, Rank2Types, BangPatterns #-} -- | -- Module : Data.Vector.Fusion.Stream.Monadic -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Monadic stream combinators. -- module Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..), -- * Size hints size, sized, -- * Length length, null, -- * Construction empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), -- * Accessing elements head, last, (!!), (!?), -- * Substreams slice, init, tail, take, drop, -- * Mapping map, mapM, mapM_, trans, unbox, concatMap, flatten, -- * Zipping indexed, indexedR, zipWithM_, zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zip, zip3, zip4, zip5, zip6, -- * Filtering filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, -- * Searching elem, notElem, find, findM, findIndex, findIndexM, -- * Folding foldl, foldlM, foldl1, foldl1M, foldM, fold1M, foldl', foldlM', foldl1', foldl1M', foldM', fold1M', foldr, foldrM, foldr1, foldr1M, -- * Specialised folds and, or, concatMapM, -- * Unfolding unfoldr, unfoldrM, unfoldrN, unfoldrNM, iterateN, iterateNM, -- * Scans prescanl, prescanlM, prescanl', prescanlM', postscanl, postscanlM, postscanl', postscanlM', scanl, scanlM, scanl', scanlM', scanl1, scanl1M, scanl1', scanl1M', -- * Enumerations enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversions toList, fromList, fromListN, unsafeFromList ) where import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util ( Box(..), delay_inline ) import Data.Char ( ord ) import GHC.Base ( unsafeChr ) import Control.Monad ( liftM ) import Prelude hiding ( length, null, replicate, (++), head, last, (!!), init, tail, take, drop, map, mapM, mapM_, concatMap, zipWith, zipWith3, zip, zip3, filter, takeWhile, dropWhile, elem, notElem, foldl, foldl1, foldr, foldr1, and, or, scanl, scanl1, enumFromTo, enumFromThenTo ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word, Word64 ) #if __GLASGOW_HASKELL__ >= 700 import GHC.Exts ( SpecConstrAnnotation(..) ) #endif #include "vector.h" data SPEC = SPEC | SPEC2 #if __GLASGOW_HASKELL__ >= 700 {-# ANN type SPEC ForceSpecConstr #-} #endif emptyStream :: String {-# NOINLINE emptyStream #-} emptyStream = "empty stream" #define EMPTY_STREAM (\s -> ERROR s emptyStream) -- | Result of taking a single step in a stream data Step s a = Yield a s -- ^ a new element and a new seed | Skip s -- ^ just a new seed | Done -- ^ end of stream -- | Monadic streams data Stream m a = forall s. Stream (s -> m (Step s a)) s Size -- | 'Size' hint of a 'Stream' size :: Stream m a -> Size {-# INLINE size #-} size (Stream _ _ sz) = sz -- | Attach a 'Size' hint to a 'Stream' sized :: Stream m a -> Size -> Stream m a {-# INLINE_STREAM sized #-} sized (Stream step s _) sz = Stream step s sz -- Length -- ------ -- | Length of a 'Stream' length :: Monad m => Stream m a -> m Int {-# INLINE_STREAM length #-} length s = foldl' (\n _ -> n+1) 0 s -- | Check if a 'Stream' is empty null :: Monad m => Stream m a -> m Bool {-# INLINE_STREAM null #-} null s = foldr (\_ _ -> False) True s -- Construction -- ------------ -- | Empty 'Stream' empty :: Monad m => Stream m a {-# INLINE_STREAM empty #-} empty = Stream (const (return Done)) () (Exact 0) -- | Singleton 'Stream' singleton :: Monad m => a -> Stream m a {-# INLINE_STREAM singleton #-} singleton x = Stream (return . step) True (Exact 1) where {-# INLINE_INNER step #-} step True = Yield x False step False = Done -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a {-# INLINE replicate #-} replicate n x = replicateM n (return x) -- | Yield a 'Stream' of values obtained by performing the monadic action the -- given number of times replicateM :: Monad m => Int -> m a -> Stream m a {-# INLINE_STREAM replicateM #-} -- NOTE: We delay inlining max here because GHC will create a join point for -- the call to newArray# otherwise which is not really nice. replicateM n p = Stream step n (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step i | i <= 0 = return Done | otherwise = do { x <- p; return $ Yield x (i-1) } generate :: Monad m => Int -> (Int -> a) -> Stream m a {-# INLINE generate #-} generate n f = generateM n (return . f) -- | Generate a stream from its indices generateM :: Monad m => Int -> (Int -> m a) -> Stream m a {-# INLINE_STREAM generateM #-} generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step i | i < n = do x <- f i return $ Yield x (i+1) | otherwise = return Done -- | Prepend an element cons :: Monad m => a -> Stream m a -> Stream m a {-# INLINE cons #-} cons x s = singleton x ++ s -- | Append an element snoc :: Monad m => Stream m a -> a -> Stream m a {-# INLINE snoc #-} snoc s x = s ++ singleton x infixr 5 ++ -- | Concatenate two 'Stream's (++) :: Monad m => Stream m a -> Stream m a -> Stream m a {-# INLINE_STREAM (++) #-} Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb) where {-# INLINE_INNER step #-} step (Left sa) = do r <- stepa sa case r of Yield x sa' -> return $ Yield x (Left sa') Skip sa' -> return $ Skip (Left sa') Done -> return $ Skip (Right sb) step (Right sb) = do r <- stepb sb case r of Yield x sb' -> return $ Yield x (Right sb') Skip sb' -> return $ Skip (Right sb') Done -> return $ Done -- Accessing elements -- ------------------ -- | First element of the 'Stream' or error if empty head :: Monad m => Stream m a -> m a {-# INLINE_STREAM head #-} head (Stream step s _) = head_loop SPEC s where head_loop !sPEC s = do r <- step s case r of Yield x _ -> return x Skip s' -> head_loop SPEC s' Done -> EMPTY_STREAM "head" -- | Last element of the 'Stream' or error if empty last :: Monad m => Stream m a -> m a {-# INLINE_STREAM last #-} last (Stream step s _) = last_loop0 SPEC s where last_loop0 !sPEC s = do r <- step s case r of Yield x s' -> last_loop1 SPEC x s' Skip s' -> last_loop0 SPEC s' Done -> EMPTY_STREAM "last" last_loop1 !sPEC x s = do r <- step s case r of Yield y s' -> last_loop1 SPEC y s' Skip s' -> last_loop1 SPEC x s' Done -> return x infixl 9 !! -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-} Stream step s _ !! i | i < 0 = ERROR "!!" "negative index" | otherwise = index_loop SPEC s i where index_loop !sPEC s i = i `seq` do r <- step s case r of Yield x s' | i == 0 -> return x | otherwise -> index_loop SPEC s' (i-1) Skip s' -> index_loop SPEC s' i Done -> EMPTY_STREAM "!!" infixl 9 !? -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Monad m => Stream m a -> Int -> m (Maybe a) {-# INLINE (!?) #-} Stream step s _ !? i = index_loop SPEC s i where index_loop !sPEC s i = i `seq` do r <- step s case r of Yield x s' | i == 0 -> return (Just x) | otherwise -> index_loop SPEC s' (i-1) Skip s' -> index_loop SPEC s' i Done -> return Nothing -- Substreams -- ---------- -- | Extract a substream of the given length starting at the given position. slice :: Monad m => Int -- ^ starting index -> Int -- ^ length -> Stream m a -> Stream m a {-# INLINE slice #-} slice i n s = take n (drop i s) -- | All but the last element init :: Monad m => Stream m a -> Stream m a {-# INLINE_STREAM init #-} init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1) where {-# INLINE_INNER step' #-} step' (Nothing, s) = liftM (\r -> case r of Yield x s' -> Skip (Just x, s') Skip s' -> Skip (Nothing, s') Done -> EMPTY_STREAM "init" ) (step s) step' (Just x, s) = liftM (\r -> case r of Yield y s' -> Yield x (Just y, s') Skip s' -> Skip (Just x, s') Done -> Done ) (step s) -- | All but the first element tail :: Monad m => Stream m a -> Stream m a {-# INLINE_STREAM tail #-} tail (Stream step s sz) = Stream step' (Left s) (sz - 1) where {-# INLINE_INNER step' #-} step' (Left s) = liftM (\r -> case r of Yield x s' -> Skip (Right s') Skip s' -> Skip (Left s') Done -> EMPTY_STREAM "tail" ) (step s) step' (Right s) = liftM (\r -> case r of Yield x s' -> Yield x (Right s') Skip s' -> Skip (Right s') Done -> Done ) (step s) -- | The first @n@ elements take :: Monad m => Int -> Stream m a -> Stream m a {-# INLINE_STREAM take #-} take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz) where {-# INLINE_INNER step' #-} step' (s, i) | i < n = liftM (\r -> case r of Yield x s' -> Yield x (s', i+1) Skip s' -> Skip (s', i) Done -> Done ) (step s) step' (s, i) = return Done -- | All but the first @n@ elements drop :: Monad m => Int -> Stream m a -> Stream m a {-# INLINE_STREAM drop #-} drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n) where {-# INLINE_INNER step' #-} step' (s, Just i) | i > 0 = liftM (\r -> case r of Yield x s' -> Skip (s', Just (i-1)) Skip s' -> Skip (s', Just i) Done -> Done ) (step s) | otherwise = return $ Skip (s, Nothing) step' (s, Nothing) = liftM (\r -> case r of Yield x s' -> Yield x (s', Nothing) Skip s' -> Skip (s', Nothing) Done -> Done ) (step s) -- Mapping -- ------- instance Monad m => Functor (Stream m) where {-# INLINE fmap #-} fmap = map -- | Map a function over a 'Stream' map :: Monad m => (a -> b) -> Stream m a -> Stream m b {-# INLINE map #-} map f = mapM (return . f) -- | Map a monadic function over a 'Stream' mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b {-# INLINE_STREAM mapM #-} mapM f (Stream step s n) = Stream step' s n where {-# INLINE_INNER step' #-} step' s = do r <- step s case r of Yield x s' -> liftM (`Yield` s') (f x) Skip s' -> return (Skip s') Done -> return Done consume :: Monad m => Stream m a -> m () {-# INLINE_STREAM consume #-} consume (Stream step s _) = consume_loop SPEC s where consume_loop !sPEC s = do r <- step s case r of Yield _ s' -> consume_loop SPEC s' Skip s' -> consume_loop SPEC s' Done -> return () -- | Execute a monadic action for each element of the 'Stream' mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () {-# INLINE_STREAM mapM_ #-} mapM_ m = consume . mapM m -- | Transform a 'Stream' to use a different monad trans :: (Monad m, Monad m') => (forall a. m a -> m' a) -> Stream m a -> Stream m' a {-# INLINE_STREAM trans #-} trans f (Stream step s n) = Stream (f . step) s n unbox :: Monad m => Stream m (Box a) -> Stream m a {-# INLINE_STREAM unbox #-} unbox (Stream step s n) = Stream step' s n where {-# INLINE_INNER step' #-} step' s = do r <- step s case r of Yield (Box x) s' -> return $ Yield x s' Skip s' -> return $ Skip s' Done -> return $ Done -- Zipping -- ------- -- | Pair each element in a 'Stream' with its index indexed :: Monad m => Stream m a -> Stream m (Int,a) {-# INLINE_STREAM indexed #-} indexed (Stream step s n) = Stream step' (s,0) n where {-# INLINE_INNER step' #-} step' (s,i) = i `seq` do r <- step s case r of Yield x s' -> return $ Yield (i,x) (s', i+1) Skip s' -> return $ Skip (s', i) Done -> return Done -- | Pair each element in a 'Stream' with its index, starting from the right -- and counting down indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a) {-# INLINE_STREAM indexedR #-} indexedR m (Stream step s n) = Stream step' (s,m) n where {-# INLINE_INNER step' #-} step' (s,i) = i `seq` do r <- step s case r of Yield x s' -> let i' = i-1 in return $ Yield (i',x) (s', i') Skip s' -> return $ Skip (s', i) Done -> return Done -- | Zip two 'Stream's with the given monadic function zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c {-# INLINE_STREAM zipWithM #-} zipWithM f (Stream stepa sa na) (Stream stepb sb nb) = Stream step (sa, sb, Nothing) (smaller na nb) where {-# INLINE_INNER step #-} step (sa, sb, Nothing) = liftM (\r -> case r of Yield x sa' -> Skip (sa', sb, Just x) Skip sa' -> Skip (sa', sb, Nothing) Done -> Done ) (stepa sa) step (sa, sb, Just x) = do r <- stepb sb case r of Yield y sb' -> do z <- f x y return $ Yield z (sa, sb', Nothing) Skip sb' -> return $ Skip (sa, sb', Just x) Done -> return $ Done -- FIXME: This might expose an opportunity for inplace execution. {-# RULES "zipWithM xs xs [Vector.Stream]" forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-} zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f sa sb = consume (zipWithM f sa sb) zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d {-# INLINE_STREAM zipWith3M #-} zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc) = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc)) where {-# INLINE_INNER step #-} step (sa, sb, sc, Nothing) = do r <- stepa sa return $ case r of Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing)) Skip sa' -> Skip (sa', sb, sc, Nothing) Done -> Done step (sa, sb, sc, Just (x, Nothing)) = do r <- stepb sb return $ case r of Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y)) Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing)) Done -> Done step (sa, sb, sc, Just (x, Just y)) = do r <- stepc sc case r of Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing)) Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y)) Done -> return $ Done zipWith4M :: Monad m => (a -> b -> c -> d -> m e) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e {-# INLINE zipWith4M #-} zipWith4M f sa sb sc sd = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m f {-# INLINE zipWith5M #-} zipWith5M f sa sb sc sd se = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m f -> Stream m g {-# INLINE zipWith6M #-} zipWith6M fn sa sb sc sd se sf = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) (zip3 sd se sf) zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c {-# INLINE zipWith #-} zipWith f = zipWithM (\a b -> return (f a b)) zipWith3 :: Monad m => (a -> b -> c -> d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d {-# INLINE zipWith3 #-} zipWith3 f = zipWith3M (\a b c -> return (f a b c)) zipWith4 :: Monad m => (a -> b -> c -> d -> e) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e {-# INLINE zipWith4 #-} zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m f {-# INLINE zipWith5 #-} zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) -> Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m f -> Stream m g {-# INLINE zipWith6 #-} zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b) {-# INLINE zip #-} zip = zipWith (,) zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c) {-# INLINE zip3 #-} zip3 = zipWith3 (,,) zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m (a,b,c,d) {-# INLINE zip4 #-} zip4 = zipWith4 (,,,) zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m (a,b,c,d,e) {-# INLINE zip5 #-} zip5 = zipWith5 (,,,,) zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f) {-# INLINE zip6 #-} zip6 = zipWith6 (,,,,,) -- Filtering -- --------- -- | Drop elements which do not satisfy the predicate filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a {-# INLINE filter #-} filter f = filterM (return . f) -- | Drop elements which do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a {-# INLINE_STREAM filterM #-} filterM f (Stream step s n) = Stream step' s (toMax n) where {-# INLINE_INNER step' #-} step' s = do r <- step s case r of Yield x s' -> do b <- f x return $ if b then Yield x s' else Skip s' Skip s' -> return $ Skip s' Done -> return $ Done -- | Longest prefix of elements that satisfy the predicate takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a {-# INLINE takeWhile #-} takeWhile f = takeWhileM (return . f) -- | Longest prefix of elements that satisfy the monadic predicate takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a {-# INLINE_STREAM takeWhileM #-} takeWhileM f (Stream step s n) = Stream step' s (toMax n) where {-# INLINE_INNER step' #-} step' s = do r <- step s case r of Yield x s' -> do b <- f x return $ if b then Yield x s' else Done Skip s' -> return $ Skip s' Done -> return $ Done -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a {-# INLINE dropWhile #-} dropWhile f = dropWhileM (return . f) data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s -- | Drop the longest prefix of elements that satisfy the monadic predicate dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a {-# INLINE_STREAM dropWhileM #-} dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n) where -- NOTE: we jump through hoops here to have only one Yield; local data -- declarations would be nice! {-# INLINE_INNER step' #-} step' (DropWhile_Drop s) = do r <- step s case r of Yield x s' -> do b <- f x return $ if b then Skip (DropWhile_Drop s') else Skip (DropWhile_Yield x s') Skip s' -> return $ Skip (DropWhile_Drop s') Done -> return $ Done step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s) step' (DropWhile_Next s) = liftM (\r -> case r of Yield x s' -> Skip (DropWhile_Yield x s') Skip s' -> Skip (DropWhile_Next s') Done -> Done ) (step s) -- Searching -- --------- infix 4 `elem` -- | Check whether the 'Stream' contains an element elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool {-# INLINE_STREAM elem #-} elem x (Stream step s _) = elem_loop SPEC s where elem_loop !sPEC s = do r <- step s case r of Yield y s' | x == y -> return True | otherwise -> elem_loop SPEC s' Skip s' -> elem_loop SPEC s' Done -> return False infix 4 `notElem` -- | Inverse of `elem` notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool {-# INLINE notElem #-} notElem x s = liftM not (elem x s) -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' -- if no such element exists. find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a) {-# INLINE find #-} find f = findM (return . f) -- | Yield 'Just' the first element that satisfies the monadic predicate or -- 'Nothing' if no such element exists. findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a) {-# INLINE_STREAM findM #-} findM f (Stream step s _) = find_loop SPEC s where find_loop !sPEC s = do r <- step s case r of Yield x s' -> do b <- f x if b then return $ Just x else find_loop SPEC s' Skip s' -> find_loop SPEC s' Done -> return Nothing -- | Yield 'Just' the index of the first element that satisfies the predicate -- or 'Nothing' if no such element exists. findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int) {-# INLINE_STREAM findIndex #-} findIndex f = findIndexM (return . f) -- | Yield 'Just' the index of the first element that satisfies the monadic -- predicate or 'Nothing' if no such element exists. findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int) {-# INLINE_STREAM findIndexM #-} findIndexM f (Stream step s _) = findIndex_loop SPEC s 0 where findIndex_loop !sPEC s i = do r <- step s case r of Yield x s' -> do b <- f x if b then return $ Just i else findIndex_loop SPEC s' (i+1) Skip s' -> findIndex_loop SPEC s' i Done -> return Nothing -- Folding -- ------- -- | Left fold foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a {-# INLINE foldl #-} foldl f = foldlM (\a b -> return (f a b)) -- | Left fold with a monadic operator foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE_STREAM foldlM #-} foldlM m z (Stream step s _) = foldlM_loop SPEC z s where foldlM_loop !sPEC z s = do r <- step s case r of Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' } Skip s' -> foldlM_loop SPEC z s' Done -> return z -- | Same as 'foldlM' foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE foldM #-} foldM = foldlM -- | Left fold over a non-empty 'Stream' foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a {-# INLINE foldl1 #-} foldl1 f = foldl1M (\a b -> return (f a b)) -- | Left fold over a non-empty 'Stream' with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldl1M #-} foldl1M f (Stream step s sz) = foldl1M_loop SPEC s where foldl1M_loop !sPEC s = do r <- step s case r of Yield x s' -> foldlM f x (Stream step s' (sz - 1)) Skip s' -> foldl1M_loop SPEC s' Done -> EMPTY_STREAM "foldl1M" -- | Same as 'foldl1M' fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE fold1M #-} fold1M = foldl1M -- | Left fold with a strict accumulator foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a {-# INLINE foldl' #-} foldl' f = foldlM' (\a b -> return (f a b)) -- | Left fold with a strict accumulator and a monadic operator foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE_STREAM foldlM' #-} foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s where foldlM'_loop !sPEC z s = z `seq` do r <- step s case r of Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' } Skip s' -> foldlM'_loop SPEC z s' Done -> return z -- | Same as 'foldlM'' foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a {-# INLINE foldM' #-} foldM' = foldlM' -- | Left fold over a non-empty 'Stream' with a strict accumulator foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a {-# INLINE foldl1' #-} foldl1' f = foldl1M' (\a b -> return (f a b)) -- | Left fold over a non-empty 'Stream' with a strict accumulator and a -- monadic operator foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldl1M' #-} foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s where foldl1M'_loop !sPEC s = do r <- step s case r of Yield x s' -> foldlM' f x (Stream step s' (sz - 1)) Skip s' -> foldl1M'_loop SPEC s' Done -> EMPTY_STREAM "foldl1M'" -- | Same as 'foldl1M'' fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE fold1M' #-} fold1M' = foldl1M' -- | Right fold foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b {-# INLINE foldr #-} foldr f = foldrM (\a b -> return (f a b)) -- | Right fold with a monadic operator foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b {-# INLINE_STREAM foldrM #-} foldrM f z (Stream step s _) = foldrM_loop SPEC s where foldrM_loop !sPEC s = do r <- step s case r of Yield x s' -> f x =<< foldrM_loop SPEC s' Skip s' -> foldrM_loop SPEC s' Done -> return z -- | Right fold over a non-empty stream foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a {-# INLINE foldr1 #-} foldr1 f = foldr1M (\a b -> return (f a b)) -- | Right fold over a non-empty stream with a monadic operator foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a {-# INLINE_STREAM foldr1M #-} foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s where foldr1M_loop0 !sPEC s = do r <- step s case r of Yield x s' -> foldr1M_loop1 SPEC x s' Skip s' -> foldr1M_loop0 SPEC s' Done -> EMPTY_STREAM "foldr1M" foldr1M_loop1 !sPEC x s = do r <- step s case r of Yield y s' -> f x =<< foldr1M_loop1 SPEC y s' Skip s' -> foldr1M_loop1 SPEC x s' Done -> return x -- Specialised folds -- ----------------- and :: Monad m => Stream m Bool -> m Bool {-# INLINE_STREAM and #-} and (Stream step s _) = and_loop SPEC s where and_loop !sPEC s = do r <- step s case r of Yield False _ -> return False Yield True s' -> and_loop SPEC s' Skip s' -> and_loop SPEC s' Done -> return True or :: Monad m => Stream m Bool -> m Bool {-# INLINE_STREAM or #-} or (Stream step s _) = or_loop SPEC s where or_loop !sPEC s = do r <- step s case r of Yield False s' -> or_loop SPEC s' Yield True _ -> return True Skip s' -> or_loop SPEC s' Done -> return False concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b {-# INLINE concatMap #-} concatMap f = concatMapM (return . f) concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b {-# INLINE_STREAM concatMapM #-} concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown where concatMap_go (Left s) = do r <- step s case r of Yield a s' -> do b_stream <- f a return $ Skip (Right (b_stream, s')) Skip s' -> return $ Skip (Left s') Done -> return Done concatMap_go (Right (Stream inner_step inner_s sz, s)) = do r <- inner_step inner_s case r of Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s' sz, s)) Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s)) Done -> return $ Skip (Left s) -- | Create a 'Stream' of values from a 'Stream' of streamable things flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size -> Stream m a -> Stream m b {-# INLINE_STREAM flatten #-} flatten mk istep sz (Stream ostep t _) = Stream step (Left t) sz where {-# INLINE_INNER step #-} step (Left t) = do r <- ostep t case r of Yield a t' -> do s <- mk a s `seq` return (Skip (Right (s,t'))) Skip t' -> return $ Skip (Left t') Done -> return $ Done step (Right (s,t)) = do r <- istep s case r of Yield x s' -> return $ Yield x (Right (s',t)) Skip s' -> return $ Skip (Right (s',t)) Done -> return $ Skip (Left t) -- Unfolding -- --------- -- | Unfold unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a {-# INLINE_STREAM unfoldr #-} unfoldr f = unfoldrM (return . f) -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a {-# INLINE_STREAM unfoldrM #-} unfoldrM f s = Stream step s Unknown where {-# INLINE_INNER step #-} step s = liftM (\r -> case r of Just (x, s') -> Yield x s' Nothing -> Done ) (f s) -- | Unfold at most @n@ elements unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a {-# INLINE_STREAM unfoldrN #-} unfoldrN n f = unfoldrNM n (return . f) -- | Unfold at most @n@ elements with a monadic functions unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a {-# INLINE_STREAM unfoldrNM #-} unfoldrNM n f s = Stream step (s,n) (Max (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (s,n) | n <= 0 = return Done | otherwise = liftM (\r -> case r of Just (x,s') -> Yield x (s',n-1) Nothing -> Done ) (f s) -- | Apply monadic function n times to value. Zeroth element is original value. iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a {-# INLINE_STREAM iterateNM #-} iterateNM n f x0 = Stream step (x0,n) (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (x,i) | i <= 0 = return Done | i == n = return $ Yield x (x,i-1) | otherwise = do a <- f x return $ Yield a (a,i-1) -- | Apply function n times to value. Zeroth element is original value. iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a {-# INLINE_STREAM iterateN #-} iterateN n f x0 = iterateNM n (return . f) x0 -- Scans -- ----- -- | Prefix scan prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE prescanl #-} prescanl f = prescanlM (\a b -> return (f a b)) -- | Prefix scan with a monadic operator prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE_STREAM prescanlM #-} prescanlM f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = do r <- step s case r of Yield y s' -> do z <- f x y return $ Yield x (s', z) Skip s' -> return $ Skip (s', x) Done -> return Done -- | Prefix scan with strict accumulator prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE prescanl' #-} prescanl' f = prescanlM' (\a b -> return (f a b)) -- | Prefix scan with strict accumulator and a monadic operator prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE_STREAM prescanlM' #-} prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = x `seq` do r <- step s case r of Yield y s' -> do z <- f x y return $ Yield x (s', z) Skip s' -> return $ Skip (s', x) Done -> return Done -- | Suffix scan postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE postscanl #-} postscanl f = postscanlM (\a b -> return (f a b)) -- | Suffix scan with a monadic operator postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE_STREAM postscanlM #-} postscanlM f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = do r <- step s case r of Yield y s' -> do z <- f x y return $ Yield z (s',z) Skip s' -> return $ Skip (s',x) Done -> return Done -- | Suffix scan with strict accumulator postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE postscanl' #-} postscanl' f = postscanlM' (\a b -> return (f a b)) -- | Suffix scan with strict acccumulator and a monadic operator postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE_STREAM postscanlM' #-} postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = x `seq` do r <- step s case r of Yield y s' -> do z <- f x y z `seq` return (Yield z (s',z)) Skip s' -> return $ Skip (s',x) Done -> return Done -- | Haskell-style scan scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE scanl #-} scanl f = scanlM (\a b -> return (f a b)) -- | Haskell-style scan with a monadic operator scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE scanlM #-} scanlM f z s = z `cons` postscanlM f z s -- | Haskell-style scan with strict accumulator scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a {-# INLINE scanl' #-} scanl' f = scanlM' (\a b -> return (f a b)) -- | Haskell-style scan with strict accumulator and a monadic operator scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a {-# INLINE scanlM' #-} scanlM' f z s = z `seq` (z `cons` postscanlM f z s) -- | Scan over a non-empty 'Stream' scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a {-# INLINE scanl1 #-} scanl1 f = scanl1M (\x y -> return (f x y)) -- | Scan over a non-empty 'Stream' with a monadic operator scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a {-# INLINE_STREAM scanl1M #-} scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz where {-# INLINE_INNER step' #-} step' (s, Nothing) = do r <- step s case r of Yield x s' -> return $ Yield x (s', Just x) Skip s' -> return $ Skip (s', Nothing) Done -> EMPTY_STREAM "scanl1M" step' (s, Just x) = do r <- step s case r of Yield y s' -> do z <- f x y return $ Yield z (s', Just z) Skip s' -> return $ Skip (s', Just x) Done -> return Done -- | Scan over a non-empty 'Stream' with a strict accumulator scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a {-# INLINE scanl1' #-} scanl1' f = scanl1M' (\x y -> return (f x y)) -- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic -- operator scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a {-# INLINE_STREAM scanl1M' #-} scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz where {-# INLINE_INNER step' #-} step' (s, Nothing) = do r <- step s case r of Yield x s' -> x `seq` return (Yield x (s', Just x)) Skip s' -> return $ Skip (s', Nothing) Done -> EMPTY_STREAM "scanl1M" step' (s, Just x) = x `seq` do r <- step s case r of Yield y s' -> do z <- f x y z `seq` return (Yield z (s', Just z)) Skip s' -> return $ Skip (s', Just x) Done -> return Done -- Enumerations -- ------------ -- The Enum class is broken for this, there just doesn't seem to be a -- way to implement this generically. We have to specialise for as many types -- as we can but this doesn't help in polymorphic loops. -- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a {-# INLINE_STREAM enumFromStepN #-} enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n) (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (x,n) | n > 0 = return $ Yield x (x+y,n-1) | otherwise = return $ Done -- | Enumerate values -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo #-} enumFromTo x y = fromList [x .. y] -- NOTE: We use (x+1) instead of (succ x) below because the latter checks for -- overflow which can't happen here. -- FIXME: add "too large" test for Int enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo_small #-} enumFromTo_small x y = x `seq` y `seq` Stream step x (Exact n) where n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8 "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16 "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8 "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16 #-} #if WORD_SIZE_IN_BITS > 32 {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32 "enumFromTo [Stream]" enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32 #-} #endif -- NOTE: We could implement a generic "too large" test: -- -- len x y | x > y = 0 -- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n -- | otherwise = error -- where -- n = y-x+1 -- -- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for -- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 -- enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo_int #-} enumFromTo_int x y = x `seq` y `seq` Stream step x (Exact (len x y)) where {-# INLINE [0] len #-} len x y | x > y = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0) $ fromIntegral n where n = y-x+1 {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int #if WORD_SIZE_IN_BITS > 32 "enumFromTo [Stream]" enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #else "enumFromTo [Stream]" enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32 #endif #-} enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo_big_word #-} enumFromTo_big_word x y = x `seq` y `seq` Stream step x (Exact (len x y)) where {-# INLINE [0] len #-} len x y | x > y = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n < fromIntegral (maxBound :: Int)) $ fromIntegral (n+1) where n = y-x {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word "enumFromTo [Stream]" enumFromTo = enumFromTo_big_word :: Monad m => Word64 -> Word64 -> Stream m Word64 #if WORD_SIZE_IN_BITS == 32 "enumFromTo [Stream]" enumFromTo = enumFromTo_big_word :: Monad m => Word32 -> Word32 -> Stream m Word32 #endif "enumFromTo [Stream]" enumFromTo = enumFromTo_big_word :: Monad m => Integer -> Integer -> Stream m Integer #-} -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo_big_int #-} enumFromTo_big_int x y = x `seq` y `seq` Stream step x (Exact (len x y)) where {-# INLINE [0] len #-} len x y | x > y = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0 && n <= fromIntegral (maxBound :: Int)) $ fromIntegral n where n = y-x+1 {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done #if WORD_SIZE_IN_BITS > 32 {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} #endif enumFromTo_char :: Monad m => Char -> Char -> Stream m Char {-# INLINE_STREAM enumFromTo_char #-} enumFromTo_char x y = x `seq` y `seq` Stream step xn (Exact n) where xn = ord x yn = ord y n = delay_inline max 0 (yn - xn + 1) {-# INLINE_INNER step #-} step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1) | otherwise = return $ Done {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_char #-} ------------------------------------------------------------------------ -- Specialise enumFromTo for Float and Double. -- Also, try to do something about pairs? enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a {-# INLINE_STREAM enumFromTo_double #-} enumFromTo_double n m = n `seq` m `seq` Stream step n (Max (len n m)) where lim = m + 1/2 -- important to float out {-# INLINE [0] len #-} len x y | x > y = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0) $ fromIntegral n where n = truncate (y-x)+2 {-# INLINE_INNER step #-} step x | x <= lim = return $ Yield x (x+1) | otherwise = return $ Done {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double "enumFromTo [Stream]" enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float #-} ------------------------------------------------------------------------ -- | Enumerate values with a given step. -- -- /WARNING:/ This operation is very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a {-# INLINE_STREAM enumFromThenTo #-} enumFromThenTo x y z = fromList [x, y .. z] -- FIXME: Specialise enumFromThenTo. -- Conversions -- ----------- -- | Convert a 'Stream' to a list toList :: Monad m => Stream m a -> m [a] {-# INLINE toList #-} toList = foldr (:) [] -- | Convert a list to a 'Stream' fromList :: Monad m => [a] -> Stream m a {-# INLINE fromList #-} fromList xs = unsafeFromList Unknown xs -- | Convert the first @n@ elements of a list to a 'Stream' fromListN :: Monad m => Int -> [a] -> Stream m a {-# INLINE_STREAM fromListN #-} fromListN n xs = Stream step (xs,n) (Max (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (xs,n) | n <= 0 = return Done step (x:xs,n) = return (Yield x (xs,n-1)) step ([],n) = return Done -- | Convert a list to a 'Stream' with the given 'Size' hint. unsafeFromList :: Monad m => Size -> [a] -> Stream m a {-# INLINE_STREAM unsafeFromList #-} unsafeFromList sz xs = Stream step xs sz where step (x:xs) = return (Yield x xs) step [] = return Done vector-0.10.0.1/Data/Vector/Primitive/0000755000000000000000000000000012035366315015506 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Primitive/Mutable.hs0000644000000000000000000002316612035366315017443 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Primitive.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Mutable primitive vectors. -- module Data.Vector.Primitive.Mutable ( -- * Mutable vectors of primitive types MVector(..), IOVector, STVector, Prim, -- * Accessors -- ** Length information length, null, -- ** Extracting subvectors 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, -- * Accessing individual elements read, write, swap, unsafeRead, unsafeWrite, unsafeSwap, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove ) where import qualified Data.Vector.Generic.Mutable as G import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) import Control.Monad.Primitive import Control.Monad ( liftM ) import Control.DeepSeq ( NFData ) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail ) import Data.Typeable ( Typeable ) #include "vector.h" -- | Mutable vectors of primitive types. data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) deriving ( Typeable ) type IOVector = MVector RealWorld type STVector s = MVector s instance NFData (MVector s a) instance Prim a => G.MVector MVector a where basicLength (MVector _ n _) = n basicUnsafeSlice j m (MVector i n arr) = MVector (i+j) m arr {-# INLINE basicOverlaps #-} basicOverlaps (MVector i m arr1) (MVector j n arr2) = sameMutableByteArray arr1 arr2 && (between i j (j+n) || between j i (i+m)) where between x y z = x >= y && x < z {-# INLINE basicUnsafeNew #-} basicUnsafeNew n = MVector 0 n `liftM` newByteArray (n * sizeOf (undefined :: a)) {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MVector i n arr) j = readByteArray arr (i+j) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector i n arr) j x = writeByteArray arr (i+j) x {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (MVector j _ src) = copyMutableByteArray dst (i*sz) src (j*sz) (n*sz) where sz = sizeOf (undefined :: a) {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MVector i n dst) (MVector j _ src) = moveByteArray dst (i*sz) src (j*sz) (n * sz) where sz = sizeOf (undefined :: a) {-# INLINE basicSet #-} basicSet (MVector i n arr) x = setByteArray arr i n x -- Length information -- ------------------ -- | Length of the mutable vector. length :: Prim a => MVector s a -> Int {-# INLINE length #-} length = G.length -- | Check whether the vector is empty null :: Prim a => MVector s a -> Bool {-# INLINE null #-} null = G.null -- Extracting subvectors -- --------------------- -- | Yield a part of the mutable vector without copying it. slice :: Prim a => Int -> Int -> MVector s a -> MVector s a {-# INLINE slice #-} slice = G.slice take :: Prim a => Int -> MVector s a -> MVector s a {-# INLINE take #-} take = G.take drop :: Prim a => Int -> MVector s a -> MVector s a {-# INLINE drop #-} drop = G.drop splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) {-# INLINE splitAt #-} splitAt = G.splitAt init :: Prim a => MVector s a -> MVector s a {-# INLINE init #-} init = G.init tail :: Prim a => MVector s a -> MVector s a {-# INLINE tail #-} tail = G.tail -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed. unsafeSlice :: Prim a => Int -- ^ starting index -> Int -- ^ length of the slice -> MVector s a -> MVector s a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice unsafeTake :: Prim a => Int -> MVector s a -> MVector s a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop unsafeInit :: Prim a => MVector s a -> MVector s a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit unsafeTail :: Prim a => MVector s a -> MVector s a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- Overlapping -- ----------- -- Check whether two vectors overlap. overlaps :: Prim a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps -- Initialisation -- -------------- -- | Create a mutable vector of the given length. new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) {-# INLINE new #-} new = G.new -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with an initial value. replicate :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) {-# INLINE replicate #-} replicate = G.replicate -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, Prim a) => Int -> m a -> m (MVector (PrimState m) a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) {-# INLINE clone #-} clone = G.clone -- Growing -- ------- -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow -- Restricting memory usage -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear -- Accessing individual elements -- ----------------------------- -- | Yield the element at the given position. read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a {-# INLINE read #-} read = G.read -- | Replace the element at the given position. write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE write #-} write = G.write -- | Swap the elements at the given positions. swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-} swap = G.swap -- | Yield the element at the given position. No bounds checks are performed. unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead = G.unsafeRead -- | Replace the element at the given position. No bounds checks are performed. unsafeWrite :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-} unsafeSwap = G.unsafeSwap -- Filling and copying -- ------------------- -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () {-# INLINE set #-} set = G.set -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy -- | Copy a vector. The two vectors must have the same length and may not -- overlap. This is not checked. unsafeCopy :: (PrimMonad m, Prim a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | Move the contents of a vector. The two vectors must have the same -- length. -- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE move #-} move = G.move -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked. -- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: (PrimMonad m, Prim a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove vector-0.10.0.1/Data/Vector/Unboxed/0000755000000000000000000000000012035366315015142 5ustar0000000000000000vector-0.10.0.1/Data/Vector/Unboxed/Mutable.hs0000644000000000000000000002030212035366315017064 0ustar0000000000000000-- | -- Module : Data.Vector.Unboxed.Mutable -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Mutable adaptive unboxed vectors -- module Data.Vector.Unboxed.Mutable ( -- * Mutable vectors of primitive types MVector(..), IOVector, STVector, Unbox, -- * Accessors -- ** Length information length, null, -- ** Extracting subvectors 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, swap, unsafeRead, unsafeWrite, unsafeSwap, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove ) where import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic.Mutable as G import Data.Vector.Fusion.Util ( delayed_min ) import Control.Monad.Primitive import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail, zip, zip3, unzip, unzip3 ) #include "vector.h" -- Length information -- ------------------ -- | Length of the mutable vector. length :: Unbox a => MVector s a -> Int {-# INLINE length #-} length = G.length -- | Check whether the vector is empty null :: Unbox a => MVector s a -> Bool {-# INLINE null #-} null = G.null -- Extracting subvectors -- --------------------- -- | Yield a part of the mutable vector without copying it. slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a {-# INLINE slice #-} slice = G.slice take :: Unbox a => Int -> MVector s a -> MVector s a {-# INLINE take #-} take = G.take drop :: Unbox a => Int -> MVector s a -> MVector s a {-# INLINE drop #-} drop = G.drop splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) {-# INLINE splitAt #-} splitAt = G.splitAt init :: Unbox a => MVector s a -> MVector s a {-# INLINE init #-} init = G.init tail :: Unbox a => MVector s a -> MVector s a {-# INLINE tail #-} tail = G.tail -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed. unsafeSlice :: Unbox a => Int -- ^ starting index -> Int -- ^ length of the slice -> MVector s a -> MVector s a {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop unsafeInit :: Unbox a => MVector s a -> MVector s a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit unsafeTail :: Unbox a => MVector s a -> MVector s a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- Overlapping -- ----------- -- Check whether two vectors overlap. overlaps :: Unbox a => MVector s a -> MVector s a -> Bool {-# INLINE overlaps #-} overlaps = G.overlaps -- Initialisation -- -------------- -- | Create a mutable vector of the given length. new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) {-# INLINE new #-} new = G.new -- | Create a mutable vector of the given length. The length is not checked. unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with an initial value. replicate :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) {-# INLINE replicate #-} replicate = G.replicate -- | Create a mutable vector of the given length (0 if the length is negative) -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, Unbox a) => Int -> m a -> m (MVector (PrimState m) a) {-# INLINE replicateM #-} replicateM = G.replicateM -- | Create a copy of a mutable vector. clone :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m (MVector (PrimState m) a) {-# INLINE clone #-} clone = G.clone -- Growing -- ------- -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow -- Restricting memory usage -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all -- references to external objects. This is usually a noop for unboxed vectors. clear :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear -- Accessing individual elements -- ----------------------------- -- | Yield the element at the given position. read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a {-# INLINE read #-} read = G.read -- | Replace the element at the given position. write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE write #-} write = G.write -- | Swap the elements at the given positions. swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE swap #-} swap = G.swap -- | Yield the element at the given position. No bounds checks are performed. unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead = G.unsafeRead -- | Replace the element at the given position. No bounds checks are performed. unsafeWrite :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite = G.unsafeWrite -- | Swap the elements at the given positions. No bounds checks are performed. unsafeSwap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () {-# INLINE unsafeSwap #-} unsafeSwap = G.unsafeSwap -- Filling and copying -- ------------------- -- | Set all elements of the vector to the given value. set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () {-# INLINE set #-} set = G.set -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE copy #-} copy = G.copy -- | Copy a vector. The two vectors must have the same length and may not -- overlap. This is not checked. unsafeCopy :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeCopy #-} unsafeCopy = G.unsafeCopy -- | Move the contents of a vector. The two vectors must have the same -- length. -- -- If the vectors do not overlap, then this is equivalent to 'copy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE move #-} move = G.move -- | Move the contents of a vector. The two vectors must have the same -- length, but this is not checked. -- -- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. -- Otherwise, the copying is performed as if the source vector were -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove #define DEFINE_MUTABLE #include "unbox-tuple-instances" vector-0.10.0.1/Data/Vector/Unboxed/Base.hs0000644000000000000000000003274012035366315016356 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Vector.Unboxed.Base -- Copyright : (c) Roman Leshchinskiy 2009-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Adaptive unboxed vectors: basic implementation -- module Data.Vector.Unboxed.Base ( MVector(..), IOVector, STVector, Vector(..), Unbox ) where import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Primitive as P import Control.DeepSeq ( NFData ) import Control.Monad.Primitive import Control.Monad ( liftM ) import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, #if MIN_VERSION_base(4,4,0) mkTyCon3 #else mkTyCon #endif ) import Data.Data ( Data(..) ) #include "vector.h" data family MVector s a data family Vector a type IOVector = MVector RealWorld type STVector s = MVector s type instance G.Mutable Vector = MVector class (G.Vector Vector a, M.MVector MVector a) => Unbox a instance NFData (Vector a) instance NFData (MVector s a) -- ----------------- -- Data and Typeable -- ----------------- #if MIN_VERSION_base(4,4,0) vectorTyCon = mkTyCon3 "vector" #else vectorTyCon m s = mkTyCon $ m ++ "." ++ s #endif instance Typeable1 Vector where typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] instance Typeable2 MVector where typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] instance (Data a, Unbox a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" dataCast1 = G.dataCast -- ---- -- Unit -- ---- newtype instance MVector s () = MV_Unit Int newtype instance Vector () = V_Unit Int instance Unbox () instance M.MVector MVector () where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Unit n) = n basicUnsafeSlice i m (MV_Unit n) = MV_Unit m basicOverlaps _ _ = False basicUnsafeNew n = return (MV_Unit n) basicUnsafeRead (MV_Unit _) _ = return () basicUnsafeWrite (MV_Unit _) _ () = return () basicClear _ = return () basicSet (MV_Unit _) () = return () basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return () basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m) instance G.Vector Vector () where {-# INLINE basicUnsafeFreeze #-} basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n {-# INLINE basicUnsafeThaw #-} basicUnsafeThaw (V_Unit n) = return $ MV_Unit n {-# INLINE basicLength #-} basicLength (V_Unit n) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i m (V_Unit n) = V_Unit m {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_Unit _) i = return () {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () {-# INLINE elemseq #-} elemseq _ = seq -- --------------- -- Primitive types -- --------------- #define primMVector(ty,con) \ instance M.MVector MVector ty where { \ {-# INLINE basicLength #-} \ ; {-# INLINE basicUnsafeSlice #-} \ ; {-# INLINE basicOverlaps #-} \ ; {-# INLINE basicUnsafeNew #-} \ ; {-# INLINE basicUnsafeReplicate #-} \ ; {-# INLINE basicUnsafeRead #-} \ ; {-# INLINE basicUnsafeWrite #-} \ ; {-# INLINE basicClear #-} \ ; {-# INLINE basicSet #-} \ ; {-# INLINE basicUnsafeCopy #-} \ ; {-# INLINE basicUnsafeGrow #-} \ ; basicLength (con v) = M.basicLength v \ ; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \ ; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \ ; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \ ; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x \ ; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \ ; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \ ; basicClear (con v) = M.basicClear v \ ; basicSet (con v) x = M.basicSet v x \ ; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ ; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ ; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n } #define primVector(ty,con,mcon) \ instance G.Vector Vector ty where { \ {-# INLINE basicUnsafeFreeze #-} \ ; {-# INLINE basicUnsafeThaw #-} \ ; {-# INLINE basicLength #-} \ ; {-# INLINE basicUnsafeSlice #-} \ ; {-# INLINE basicUnsafeIndexM #-} \ ; {-# INLINE elemseq #-} \ ; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ ; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ ; basicLength (con v) = G.basicLength v \ ; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ ; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \ ; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ ; elemseq _ = seq } newtype instance MVector s Int = MV_Int (P.MVector s Int) newtype instance Vector Int = V_Int (P.Vector Int) instance Unbox Int primMVector(Int, MV_Int) primVector(Int, V_Int, MV_Int) newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8) newtype instance Vector Int8 = V_Int8 (P.Vector Int8) instance Unbox Int8 primMVector(Int8, MV_Int8) primVector(Int8, V_Int8, MV_Int8) newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16) newtype instance Vector Int16 = V_Int16 (P.Vector Int16) instance Unbox Int16 primMVector(Int16, MV_Int16) primVector(Int16, V_Int16, MV_Int16) newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32) newtype instance Vector Int32 = V_Int32 (P.Vector Int32) instance Unbox Int32 primMVector(Int32, MV_Int32) primVector(Int32, V_Int32, MV_Int32) newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64) newtype instance Vector Int64 = V_Int64 (P.Vector Int64) instance Unbox Int64 primMVector(Int64, MV_Int64) primVector(Int64, V_Int64, MV_Int64) newtype instance MVector s Word = MV_Word (P.MVector s Word) newtype instance Vector Word = V_Word (P.Vector Word) instance Unbox Word primMVector(Word, MV_Word) primVector(Word, V_Word, MV_Word) newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8) newtype instance Vector Word8 = V_Word8 (P.Vector Word8) instance Unbox Word8 primMVector(Word8, MV_Word8) primVector(Word8, V_Word8, MV_Word8) newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16) newtype instance Vector Word16 = V_Word16 (P.Vector Word16) instance Unbox Word16 primMVector(Word16, MV_Word16) primVector(Word16, V_Word16, MV_Word16) newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32) newtype instance Vector Word32 = V_Word32 (P.Vector Word32) instance Unbox Word32 primMVector(Word32, MV_Word32) primVector(Word32, V_Word32, MV_Word32) newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64) newtype instance Vector Word64 = V_Word64 (P.Vector Word64) instance Unbox Word64 primMVector(Word64, MV_Word64) primVector(Word64, V_Word64, MV_Word64) newtype instance MVector s Float = MV_Float (P.MVector s Float) newtype instance Vector Float = V_Float (P.Vector Float) instance Unbox Float primMVector(Float, MV_Float) primVector(Float, V_Float, MV_Float) newtype instance MVector s Double = MV_Double (P.MVector s Double) newtype instance Vector Double = V_Double (P.Vector Double) instance Unbox Double primMVector(Double, MV_Double) primVector(Double, V_Double, MV_Double) newtype instance MVector s Char = MV_Char (P.MVector s Char) newtype instance Vector Char = V_Char (P.Vector Char) instance Unbox Char primMVector(Char, MV_Char) primVector(Char, V_Char, MV_Char) -- ---- -- Bool -- ---- fromBool :: Bool -> Word8 {-# INLINE fromBool #-} fromBool True = 1 fromBool False = 0 toBool :: Word8 -> Bool {-# INLINE toBool #-} toBool 0 = False toBool _ = True newtype instance MVector s Bool = MV_Bool (P.MVector s Word8) newtype instance Vector Bool = V_Bool (P.Vector Word8) instance Unbox Bool instance M.MVector MVector Bool where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicUnsafeReplicate #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Bool v) = M.basicLength v basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2 basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x) basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x) basicClear (MV_Bool v) = M.basicClear v basicSet (MV_Bool v) x = M.basicSet v (fromBool x) basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2 basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2 basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n instance G.Vector Vector Bool where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-} basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v basicLength (V_Bool v) = G.basicLength v basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v elemseq _ = seq -- ------- -- Complex -- ------- newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) instance (RealFloat a, Unbox a) => Unbox (Complex a) instance (RealFloat a, Unbox a) => M.MVector MVector (Complex a) where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicUnsafeReplicate #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Complex v) = M.basicLength v basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2 basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y) basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y) basicClear (MV_Complex v) = M.basicClear v basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y) basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2 basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2 basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-} basicUnsafeFreeze (MV_Complex v) = V_Complex `liftM` G.basicUnsafeFreeze v basicUnsafeThaw (V_Complex v) = MV_Complex `liftM` G.basicUnsafeThaw v basicLength (V_Complex v) = G.basicLength v basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v basicUnsafeIndexM (V_Complex v) i = uncurry (:+) `liftM` G.basicUnsafeIndexM v i basicUnsafeCopy (MV_Complex mv) (V_Complex v) = G.basicUnsafeCopy mv v elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x $ G.elemseq (undefined :: Vector a) y z -- ------ -- Tuples -- ------ #define DEFINE_INSTANCES #include "unbox-tuple-instances"