vector-0.11.0.0/0000755000000000000000000000000012550636750011430 5ustar0000000000000000vector-0.11.0.0/README.md0000644000000000000000000000056412550636750012714 0ustar0000000000000000The `vector` package [![Build Status](https://travis-ci.org/haskell/vector.png?branch=master)](https://travis-ci.org/haskell/vector) ==================== An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework. See [`vector` on Hackage](http://hackage.haskell.org/package/vector) for more information. vector-0.11.0.0/changelog0000644000000000000000000000266112550636750013307 0ustar0000000000000000Changes in version 0.11.0.0 * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}` * Define non-bottom `fail` for `instance Monad Vector` * New generalized stream fusion framework * Various safety fixes - Various overflows due to vector size have been eliminated - Memory is initialized on creation of unboxed vectors * Changes to SPEC usage to allow building under more conditions Changes in version 0.10.12.3 * Allow building with `primtive-0.6` Changes in version 0.10.12.2 * Add support for `deepseq-1.4.0.0` Changes in version 0.10.12.1 * Fixed compilation on non-head GHCs Changes in version 0.10.12.0 * Export MVector constructor from Data.Vector.Primitive to match Vector's (which was already exported). * Fix building on GHC 7.9 by adding Applicative instances for Id and Box Changes in version 0.10.11.0 * Support OverloadedLists for boxed Vector in GHC >= 7.8 Changes in version 0.10.10.0 * Minor version bump to rectify PVP violation occured in 0.10.9.3 release Changes in version 0.10.9.3 (deprecated) * Add support for OverloadedLists in GHC >= 7.8 Changes in version 0.10.9.2 * Fix compilation with GHC 7.9 Changes in version 0.10.9.1 * Implement poly-kinded Typeable 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 vector-0.11.0.0/vector.cabal0000644000000000000000000001331512550636750013721 0ustar0000000000000000Name: vector Version: 0.11.0.0 -- don't forget to update the changelog file! License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Haskell Libraries Team Copyright: (c) Roman Leshchinskiy 2008-2012 Homepage: https://github.com/haskell/vector Bug-Reports: https://github.com/haskell/vector/issues 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. . * Cabal-Version: >=1.10 Build-Type: Simple Extra-Source-Files: README.md tests/LICENSE tests/Setup.hs tests/Main.hs tests/Boilerplater.hs tests/Utilities.hs tests/Tests/Move.hs tests/Tests/Bundle.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 changelog internal/GenUnboxTuple.hs internal/unbox-tuple-instances Flag BoundsChecks Description: Enable bounds checking Default: True Manual: True Flag UnsafeChecks Description: Enable bounds checking in unsafe operations at the cost of a significant performance penalty Default: False Manual: True Flag InternalChecks Description: Enable internal consistency checks at the cost of a significant performance penalty Default: False Manual: True Library Default-Language: Haskell2010 Other-Extensions: BangPatterns CPP DeriveDataTypeable ExistentialQuantification FlexibleContexts FlexibleInstances GADTs KindSignatures MagicHash MultiParamTypeClasses Rank2Types ScopedTypeVariables StandaloneDeriving TypeFamilies Exposed-Modules: Data.Vector.Internal.Check Data.Vector.Fusion.Util Data.Vector.Fusion.Stream.Monadic Data.Vector.Fusion.Bundle.Size Data.Vector.Fusion.Bundle.Monadic Data.Vector.Fusion.Bundle Data.Vector.Generic.Mutable.Base 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.3 && < 4.9 , primitive >= 0.5.0.1 && < 0.7 , ghc-prim >= 0.2 && < 0.5 , deepseq >= 1.1 && < 1.5 Ghc-Options: -O2 -Wall -fno-warn-orphans if flag(BoundsChecks) cpp-options: -DVECTOR_BOUNDS_CHECKS if flag(UnsafeChecks) cpp-options: -DVECTOR_UNSAFE_CHECKS if flag(InternalChecks) cpp-options: -DVECTOR_INTERNAL_CHECKS source-repository head type: git location: https://github.com/haskell/vector.git test-suite vector-tests-O0 Default-Language: Haskell2010 type: exitcode-stdio-1.0 Main-Is: Main.hs hs-source-dirs: tests Build-Depends: base >= 4 && < 5, template-haskell, vector, random, QuickCheck >= 2.7 && < 2.8 , test-framework, test-framework-quickcheck2, transformers >= 0.2.0.0 default-extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts, Rank2Types, TypeSynonymInstances, TypeFamilies, TemplateHaskell Ghc-Options: -O0 Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures test-suite vector-tests-O2 Default-Language: Haskell2010 type: exitcode-stdio-1.0 Main-Is: Main.hs hs-source-dirs: tests Build-Depends: base >= 4 && < 5, template-haskell, vector, random, QuickCheck >= 2.7, test-framework, test-framework-quickcheck2, transformers >= 0.2.0.0 default-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.11.0.0/LICENSE0000644000000000000000000000301612550636750012435 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.11.0.0/Setup.hs0000644000000000000000000000005712550636750013066 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.11.0.0/tests/0000755000000000000000000000000012550636750012572 5ustar0000000000000000vector-0.11.0.0/tests/Main.hs0000644000000000000000000000041712550636750014014 0ustar0000000000000000module Main (main) where import qualified Tests.Vector import qualified Tests.Bundle import qualified Tests.Move import Test.Framework (defaultMain) main = defaultMain $ Tests.Bundle.tests ++ Tests.Vector.tests ++ Tests.Move.tests vector-0.11.0.0/tests/Utilities.hs0000644000000000000000000002155712550636750015113 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.Bundle as S import Control.Monad (foldM, foldM_, zipWithM, zipWithM_) import Control.Monad.Trans.Writer import Data.Function (on) import Data.Functor.Identity import Data.List ( sortBy ) import Data.Monoid instance Show a => Show (S.Bundle v a) where show s = "Data.Vector.Fusion.Bundle.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.Bundle v a) where arbitrary = fmap S.fromList arbitrary instance CoArbitrary a => CoArbitrary (S.Bundle v a) where coarbitrary = coarbitrary . S.toList instance Arbitrary a => Arbitrary (Identity a) where arbitrary = fmap Identity arbitrary instance CoArbitrary a => CoArbitrary (Identity a) where coarbitrary = coarbitrary . runIdentity instance Arbitrary a => Arbitrary (Writer a ()) where arbitrary = fmap (writer . ((,) ())) arbitrary instance CoArbitrary a => CoArbitrary (Writer a ()) where coarbitrary = coarbitrary . runWriter 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.Bundle v a) where type Model (S.Bundle v a) = [a] model = S.toList unmodel = S.fromList type EqTest (S.Bundle v 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, TestData a) => TestData (Identity a) where type Model (Identity a) = Identity (Model a) model = fmap model unmodel = fmap unmodel type EqTest (Identity a) = Property equal = (property .) . on (==) runIdentity instance (Eq a, TestData a, Monoid a) => TestData (Writer a ()) where type Model (Writer a ()) = Writer (Model a) () model = mapWriter model unmodel = mapWriter unmodel type EqTest (Writer a ()) = Property equal = (property .) . on (==) execWriter 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 [] _ _ = [] withIndexFirst m f = m (uncurry f) . zip [0..] imap :: (Int -> a -> a) -> [a] -> [a] imap = withIndexFirst map imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a] imapM = withIndexFirst mapM imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m () imapM_ = withIndexFirst mapM_ izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a] izipWith = withIndexFirst zipWith izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a] izipWithM = withIndexFirst zipWithM izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m () izipWithM_ = withIndexFirst zipWithM_ izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a] izipWith3 = withIndexFirst zipWith3 ifilter :: (Int -> a -> Bool) -> [a] -> [a] ifilter f = map snd . withIndexFirst filter f indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..] ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a ifoldl = indexedLeftFold foldl ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z = foldr (uncurry f) z . zip [0..] ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a ifoldM = indexedLeftFold foldM ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m () ifoldM_ = indexedLeftFold foldM_ 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.11.0.0/tests/LICENSE0000644000000000000000000000303512550636750013600 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.11.0.0/tests/Setup.hs0000644000000000000000000000005712550636750014230 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.11.0.0/tests/Boilerplater.hs0000644000000000000000000000217612550636750015560 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.11.0.0/tests/Tests/0000755000000000000000000000000012550636750013674 5ustar0000000000000000vector-0.11.0.0/tests/Tests/Bundle.hs0000644000000000000000000001643712550636750015454 0ustar0000000000000000module Tests.Bundle ( tests ) where import Boilerplater import Utilities import qualified Data.Vector.Fusion.Bundle 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 v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList ] where prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a) = (S.fromList . S.toList) `eq` id prop_toList_fromList :: P ([a] -> [a]) = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v 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.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==) prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null prop_empty :: P (S.Bundle v a) = S.empty `eq` [] prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton prop_replicate :: P (Int -> a -> S.Bundle v a) = (\n _ -> n < 1000) ===> S.replicate `eq` replicate prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:) prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++) prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head prop_last :: P (S.Bundle v 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.Bundle v 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.Bundle v a -> S.Bundle v a) = S.slice `eq` slice prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith3 `eq` zipWith3 prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int) = S.findIndex `eq` findIndex prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldl1 `eq` foldl1 prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl' prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldl1' `eq` foldl1' prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> S.foldr1 `eq` foldr1 prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.prescanl `eq` prescanl prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.prescanl' `eq` prescanl prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.postscanl `eq` postscanl prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.postscanl' `eq` postscanl prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) = S.scanl' `eq` scanl prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> S.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v 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.Bundle v a) -> S.Bundle v a -> S.Bundle v 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.Bundle v a) = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) testBoolFunctions :: forall v. S.Bundle v Bool -> [Test] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) where prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or testBundleFunctions = testSanity (undefined :: S.Bundle v Int) ++ testPolymorphicFunctions (undefined :: S.Bundle v Int) ++ testBoolFunctions (undefined :: S.Bundle v Bool) tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ] vector-0.11.0.0/tests/Tests/Vector.hs0000644000000000000000000006535012550636750015503 0ustar0000000000000000module Tests.Vector (tests) where import Boilerplater import Utilities as Util 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.Bundle 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) import Data.Functor.Identity import Control.Monad.Trans.Writer #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.Bundle v a) = ((V.stream :: v a -> S.Bundle v 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_, -} 'prop_imapM, 'prop_imapM_, -- Zipping 'prop_zipWith, 'prop_zipWith3, {- ... -} 'prop_izipWith, 'prop_izipWith3, {- ... -} 'prop_izipWithM, 'prop_izipWithM_, {- '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', 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_, -- 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` Util.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_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a)) = V.imapM `eq` imapM prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) = V.imapM_ `eq` imapM_ prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a)) = V.izipWithM `eq` izipWithM prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) = V.izipWithM_ `eq` izipWithM_ 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_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) = V.ifoldM `eq` ifoldM prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) = V.ifoldM' `eq` ifoldM prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) = V.ifoldM_ `eq` ifoldM_ prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) = V.ifoldM'_ `eq` ifoldM_ 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.11.0.0/tests/Tests/Move.hs0000644000000000000000000000273612550636750015146 0ustar0000000000000000module Tests.Move (tests) where import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck.Property (Property(..)) 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 ==> (MkProperty $ do dstOff <- choose (0, G.length v - 1) srcOff <- choose (0, G.length v - 1) len <- choose (1, G.length v - max dstOff srcOff) expected <- return $ basicMove v dstOff srcOff len actual <- return $ G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v unProperty $ counterexample ("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.11.0.0/include/0000755000000000000000000000000012550636750013053 5ustar0000000000000000vector-0.11.0.0/include/vector.h0000644000000000000000000000115512550636750014530 0ustar0000000000000000#define PHASE_FUSED [1] #define PHASE_INNER [0] #define INLINE_FUSED INLINE PHASE_FUSED #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) #define PHASE_STREAM Please use "PHASE_FUSED" instead #define INLINE_STREAM Please use "INLINE_FUSED" instead vector-0.11.0.0/Data/0000755000000000000000000000000012550636750012301 5ustar0000000000000000vector-0.11.0.0/Data/Vector.hs0000644000000000000000000013143712550636750014110 0ustar0000000000000000{-# LANGUAGE CPP , DeriveDataTypeable , 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, imapM, mapM_, imapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, izipWithM, zipWithM_, izipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, filterM, takeWhile, dropWhile, -- ** Partitioning partition, unstablePartition, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', ifoldl, ifoldl', ifoldr, ifoldr', -- ** Specialised folds all, any, and, or, sum, product, maximum, maximumBy, minimum, minimumBy, minIndex, minIndexBy, maxIndex, maxIndexBy, -- ** Monadic folds foldM, ifoldM, foldM', ifoldM', fold1M, fold1M',foldM_, ifoldM_, foldM'_, ifoldM'_, fold1M_, fold1M'_, -- ** 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.Bundle as Bundle 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 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 #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) #endif -- | 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) = rnfAll i where rnfAll ix | ix < n = rnf (indexArray arr ix) `seq` rnfAll (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 #if __GLASGOW_HASKELL__ >= 708 instance Exts.IsList (Vector a) where type Item (Vector a) = a fromList = fromList fromListN = fromListN toList = toList #endif 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 = Bundle.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Bundle.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 = Bundle.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Bundle.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 {-# INLINE fail #-} fail _ = empty 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 every element of a vector and its -- index, yielding a vector of results imapM :: Monad m => (Int -> a -> m b) -> Vector a -> m (Vector b) {-# INLINE imapM #-} imapM = G.imapM -- | /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 every element of a vector and its -- index, ignoring the results imapM_ :: Monad m => (Int -> a -> m b) -> Vector a -> m () {-# INLINE imapM_ #-} imapM_ = G.imapM_ -- | /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 a monadic action that also takes -- the element index and yield a vector of results izipWithM :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE izipWithM #-} izipWithM = G.izipWithM -- | /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_ -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes -- the element index and ignore the results izipWithM_ :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE izipWithM_ #-} izipWithM_ = G.izipWithM_ -- 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 (action applied to each element and its index) ifoldM :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM #-} ifoldM = G.ifoldM -- | /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 with strict accumulator (action applied to each -- element and its index) ifoldM' :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM' #-} ifoldM' = G.ifoldM' -- | /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 that discards the result (action applied to each -- element and its index) ifoldM_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM_ #-} ifoldM_ = G.ifoldM_ -- | /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 with strict accumulator that discards the result -- (action applied to each element and its index) ifoldM'_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM'_ #-} ifoldM'_ = G.ifoldM'_ -- | /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.11.0.0/Data/Vector/0000755000000000000000000000000012550636750013543 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Unboxed.hs0000644000000000000000000012764512550636750015522 0ustar0000000000000000{-# LANGUAGE CPP, Rank2Types, TypeFamilies #-} -- | -- 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, imapM, mapM_, imapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, izipWithM, zipWithM_, izipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, filterM, takeWhile, dropWhile, -- ** Partitioning partition, unstablePartition, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', ifoldl, ifoldl', ifoldr, ifoldr', -- ** Specialised folds all, any, and, or, sum, product, maximum, maximumBy, minimum, minimumBy, minIndex, minIndexBy, maxIndex, maxIndexBy, -- ** Monadic folds foldM, ifoldM, foldM', ifoldM', fold1M, fold1M', foldM_, ifoldM_, foldM'_, ifoldM'_, fold1M_, fold1M'_, -- * Prefix sums (scans) prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', 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.Bundle as Bundle 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 Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) #endif #define NOT_VECTOR_MODULE #include "vector.h" -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-} xs == ys = Bundle.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Bundle.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 = Bundle.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Bundle.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 #if __GLASGOW_HASKELL__ >= 708 instance (Unbox e) => Exts.IsList (Vector e) where type Item (Vector e) = e fromList = fromList fromListN = fromListN toList = toList #endif -- 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 every element of a vector and its -- index, yielding a vector of results imapM :: (Monad m, Unbox a, Unbox b) => (Int -> a -> m b) -> Vector a -> m (Vector b) {-# INLINE imapM #-} imapM = G.imapM -- | /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 every element of a vector and its -- index, ignoring the results imapM_ :: (Monad m, Unbox a) => (Int -> a -> m b) -> Vector a -> m () {-# INLINE imapM_ #-} imapM_ = G.imapM_ -- | /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 a monadic action that also takes -- the element index and yield a vector of results izipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE izipWithM #-} izipWithM = G.izipWithM -- | /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_ -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes -- the element index and ignore the results izipWithM_ :: (Monad m, Unbox a, Unbox b) => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE izipWithM_ #-} izipWithM_ = G.izipWithM_ -- 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 (action applied to each element and its index) ifoldM :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM #-} ifoldM = G.ifoldM -- | /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 with strict accumulator (action applied to each -- element and its index) ifoldM' :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM' #-} ifoldM' = G.ifoldM' -- | /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 that discards the result (action applied to each -- element and its index) ifoldM_ :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM_ #-} ifoldM_ = G.ifoldM_ -- | /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 with strict accumulator that discards the result -- (action applied to each element and its index) ifoldM'_ :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM'_ #-} ifoldM'_ = G.ifoldM'_ -- | /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.11.0.0/Data/Vector/Generic.hs0000644000000000000000000021041112550636750015452 0ustar0000000000000000{-# LANGUAGE CPP, 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, imapM, mapM_, imapM_, forM, forM_, -- ** Zipping zipWith, zipWith3, zipWith4, zipWith5, zipWith6, izipWith, izipWith3, izipWith4, izipWith5, izipWith6, zip, zip3, zip4, zip5, zip6, -- ** Monadic zipping zipWithM, izipWithM, zipWithM_, izipWithM_, -- ** Unzipping unzip, unzip3, unzip4, unzip5, unzip6, -- * Working with predicates -- ** Filtering filter, ifilter, filterM, takeWhile, dropWhile, -- ** Partitioning partition, unstablePartition, span, break, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, -- * Folding foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', ifoldl, ifoldl', ifoldr, ifoldr', -- ** Specialised folds all, any, and, or, sum, product, maximum, maximumBy, minimum, minimumBy, minIndex, minIndexBy, maxIndex, maxIndexBy, -- ** Monadic folds foldM, ifoldM, foldM', ifoldM', fold1M, fold1M', foldM_, ifoldM_, foldM'_, ifoldM'_, fold1M_, fold1M'_, -- ** 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 Bundles 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 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.Bundle as Bundle import Data.Vector.Fusion.Bundle ( Bundle, MBundle, lift, inplace ) import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle import Data.Vector.Fusion.Stream.Monadic ( Stream ) import qualified Data.Vector.Fusion.Stream.Monadic as S import Data.Vector.Fusion.Bundle.Size import Data.Vector.Fusion.Util import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive 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 #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable, gcast1 ) #else import Data.Typeable ( Typeable1, gcast1 ) #endif #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 length #-} length = Bundle.length . stream -- | /O(1)/ Test whether a vector if empty null :: Vector v a => v a -> Bool {-# INLINE null #-} null = Bundle.null . stream -- Indexing -- -------- infixl 9 ! -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a {-# INLINE_FUSED (!) #-} (!) 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_FUSED (!?) #-} 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_FUSED head #-} head v = v ! 0 -- | /O(1)/ Last element last :: Vector v a => v a -> a {-# INLINE_FUSED last #-} last v = v ! (length v - 1) -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Vector v a => v a -> Int -> a {-# INLINE_FUSED 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_FUSED 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_FUSED unsafeLast #-} unsafeLast v = unsafeIndex v (length v - 1) {-# RULES "(!)/unstream [Vector]" forall i s. new (New.unstream s) ! i = s Bundle.!! i "(!?)/unstream [Vector]" forall i s. new (New.unstream s) !? i = s Bundle.!? i "head/unstream [Vector]" forall s. head (new (New.unstream s)) = Bundle.head s "last/unstream [Vector]" forall s. last (new (New.unstream s)) = Bundle.last s "unsafeIndex/unstream [Vector]" forall i s. unsafeIndex (new (New.unstream s)) i = s Bundle.!! i "unsafeHead/unstream [Vector]" forall s. unsafeHead (new (New.unstream s)) = Bundle.head s "unsafeLast/unstream [Vector]" forall s. unsafeLast (new (New.unstream s)) = Bundle.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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED unsafeLastM #-} unsafeLastM v = unsafeIndexM v (length v - 1) {-# RULES "indexM/unstream [Vector]" forall s i. indexM (new (New.unstream s)) i = lift s MBundle.!! i "headM/unstream [Vector]" forall s. headM (new (New.unstream s)) = MBundle.head (lift s) "lastM/unstream [Vector]" forall s. lastM (new (New.unstream s)) = MBundle.last (lift s) "unsafeIndexM/unstream [Vector]" forall s i. unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i "unsafeHeadM/unstream [Vector]" forall s. unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s) "unsafeLastM/unstream [Vector]" forall s. unsafeLastM (new (New.unstream s)) = MBundle.last (lift 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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_FUSED 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 Bundle.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 (Bundle.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 $ Bundle.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 (Bundle.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 (Bundle.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 . Bundle.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 . Bundle.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 _ = 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 _ = 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 $ Bundle.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 (Bundle.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 (Bundle.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 $ Bundle.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 $ Bundle.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 Bundle.++ stream w) -- | /O(n)/ Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a {-# INLINE concat #-} concat = unstream . Bundle.fromVectors {- concat vs = unstream (Bundle.flatten mk step (Exact n) (Bundle.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 -> Bundle.Yield x (v,i+1,k) | otherwise = Bundle.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 (MBundle.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 (MBundle.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_FUSED 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 (Bundle.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 (Bundle.zipWith (,) (stream is) (stream w)) update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a {-# INLINE update_stream #-} update_stream = modifyWithBundle 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 (Bundle.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 (Bundle.zipWith (,) (stream is) (stream w)) unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a {-# INLINE unsafeUpdate_stream #-} unsafeUpdate_stream = modifyWithBundle 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 (Bundle.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 (Bundle.zipWith (,) (stream is) (stream xs)) accum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a {-# INLINE accum_stream #-} accum_stream f = modifyWithBundle (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 (Bundle.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 (Bundle.zipWith (,) (stream is) (stream xs)) unsafeAccum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a {-# INLINE unsafeAccum_stream #-} unsafeAccum_stream f = modifyWithBundle (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 $ Bundle.unbox $ Bundle.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 $ Bundle.unbox $ Bundle.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. modifyWithBundle :: Vector v a => (forall s. Mutable v s a -> Bundle u b -> ST s ()) -> v a -> Bundle u b -> v a {-# INLINE modifyWithBundle #-} modifyWithBundle p v s = new (New.modifyWithBundle 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 . Bundle.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 (S.map f) id . 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 (S.map (uncurry f) . S.indexed) id . 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 . Bundle.toList . Bundle.map f . stream -- Slowest -- concatMap f = unstream . Bundle.concatMap (stream . f) . stream -- Used to be fastest {- concatMap f = unstream . Bundle.flatten mk step Unknown . stream where {-# INLINE_INNER step #-} step (v,i,k) | i < k = case unsafeIndexM v i of Box x -> Bundle.Yield x (v,i+1,k) | otherwise = Bundle.Done {-# INLINE mk #-} mk x = let v = f x k = length v in k `seq` (v,0,k) -} -- This seems to be fastest now concatMap f = unstream . Bundle.concatVectors . Bundle.map f . stream -- 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 . Bundle.mapM f . stream -- | /O(n)/ Apply the monadic action to every element of a vector and its -- index, yielding a vector of results imapM :: (Monad m, Vector v a, Vector v b) => (Int -> a -> m b) -> v a -> m (v b) imapM f = unstreamM . Bundle.mapM (uncurry f) . Bundle.indexed . 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 = Bundle.mapM_ f . stream -- | /O(n)/ Apply the monadic action to every element of a vector and its -- index, ignoring the results imapM_ :: (Monad m, Vector v a) => (Int -> a -> m b) -> v a -> m () {-# INLINE imapM_ #-} imapM_ f = Bundle.mapM_ (uncurry f) . Bundle.indexed . 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 (Bundle.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 (Bundle.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 (Bundle.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 (Bundle.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 (Bundle.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 (Bundle.zipWith (uncurry f) (Bundle.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 (Bundle.zipWith3 (uncurry f) (Bundle.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 (Bundle.zipWith4 (uncurry f) (Bundle.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 (Bundle.zipWith5 (uncurry f) (Bundle.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 (Bundle.zipWith6 (uncurry f) (Bundle.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 $ Bundle.zipWithM f (stream as) (stream bs) -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes -- the element index and yield a vector of results izipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) => (Int -> a -> b -> m c) -> v a -> v b -> m (v c) {-# INLINE izipWithM #-} izipWithM m as bs = unstreamM . Bundle.zipWithM (uncurry m) (Bundle.indexed (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 -> Bundle.zipWithM_ f (stream as) (stream bs) -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes -- the element index and ignore the results izipWithM_ :: (Monad m, Vector v a, Vector v b) => (Int -> a -> b -> m c) -> v a -> v b -> m () {-# INLINE izipWithM_ #-} izipWithM_ m as bs = Bundle.zipWithM_ (uncurry m) (Bundle.indexed (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, _, _) -> a) xs, map (\(_, b, _) -> b) xs, map (\(_, _, 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, _, _, _) -> a) xs, map (\(_, b, _, _) -> b) xs, map (\(_, _, c, _) -> c) xs, map (\(_, _, _, 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, _, _, _, _) -> a) xs, map (\(_, b, _, _, _) -> b) xs, map (\(_, _, c, _, _) -> c) xs, map (\(_, _, _, d, _) -> d) xs, map (\(_, _, _, _, 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, _, _, _, _, _) -> a) xs, map (\(_, b, _, _, _, _) -> b) xs, map (\(_, _, c, _, _, _) -> c) xs, map (\(_, _, _, d, _, _) -> d) xs, map (\(_, _, _, _, e, _) -> e) xs, map (\(_, _, _, _, _, 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 (S.filter f) toMax . 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 (S.map snd . S.filter (uncurry f) . S.indexed) toMax . 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 . Bundle.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 . Bundle.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 . Bundle.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) -> Bundle u a -> (v a, v a) {-# INLINE_FUSED partition_stream #-} partition_stream f s = s `seq` runST ( do (mv1,mv2) <- M.partitionBundle 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) -> Bundle u a -> (v a, v a) {-# INLINE_FUSED unstablePartition_stream #-} unstablePartition_stream f s = s `seq` runST ( do (mv1,mv2) <- M.unstablePartitionBundle 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_FUSED 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 = Bundle.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 = Bundle.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 = Bundle.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 = Bundle.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 (S.map fst . S.filter (f . snd) . S.indexed) toMax . 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 = Bundle.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 = Bundle.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 = Bundle.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 = Bundle.foldl1' f . stream -- | /O(n)/ Right fold foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-} foldr f z = Bundle.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 = Bundle.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 = Bundle.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 = Bundle.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 = Bundle.foldl (uncurry . f) z . Bundle.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 = Bundle.foldl' (uncurry . f) z . Bundle.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 = Bundle.foldr (uncurry f) z . Bundle.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 = Bundle.foldl' (flip (uncurry f)) z $ Bundle.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 = Bundle.and . Bundle.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 = Bundle.or . Bundle.map f . stream -- | /O(n)/ Check if all elements are 'True' and :: Vector v Bool => v Bool -> Bool {-# INLINE and #-} and = Bundle.and . stream -- | /O(n)/ Check if any element is 'True' or :: Vector v Bool => v Bool -> Bool {-# INLINE or #-} or = Bundle.or . stream -- | /O(n)/ Compute the sum of the elements sum :: (Vector v a, Num a) => v a -> a {-# INLINE sum #-} sum = Bundle.foldl' (+) 0 . stream -- | /O(n)/ Compute the produce of the elements product :: (Vector v a, Num a) => v a -> a {-# INLINE product #-} product = Bundle.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 = Bundle.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 cmpr = Bundle.foldl1' maxBy . stream where {-# INLINE maxBy #-} maxBy x y = case cmpr 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 = Bundle.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 cmpr = Bundle.foldl1' minBy . stream where {-# INLINE minBy #-} minBy x y = case cmpr 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 cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream where imax (i,x) (j,y) = i `seq` j `seq` case cmpr 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 cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream where imin (i,x) (j,y) = i `seq` j `seq` case cmpr 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 = Bundle.foldM m z . stream -- | /O(n)/ Monadic fold (action applied to each element and its index) ifoldM :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a {-# INLINE ifoldM #-} ifoldM m z = Bundle.foldM (uncurry . m) z . Bundle.indexed . 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 = Bundle.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 = Bundle.foldM' m z . stream -- | /O(n)/ Monadic fold with strict accumulator (action applied to each -- element and its index) ifoldM' :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a {-# INLINE ifoldM' #-} ifoldM' m z = Bundle.foldM' (uncurry . m) z . Bundle.indexed . 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 = Bundle.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 . Bundle.foldM m z . stream -- | /O(n)/ Monadic fold that discards the result (action applied to -- each element and its index) ifoldM_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () {-# INLINE ifoldM_ #-} ifoldM_ m z = discard . Bundle.foldM (uncurry . m) z . Bundle.indexed . 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 . Bundle.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 . Bundle.foldM' m z . stream -- | /O(n)/ Monadic fold with strict accumulator that discards the result -- (action applied to each element and its index) ifoldM'_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () {-# INLINE ifoldM'_ #-} ifoldM'_ m z = discard . Bundle.foldM' (uncurry . m) z . Bundle.indexed . 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 . Bundle.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 (S.prescanl f z) id . 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 (S.prescanl' f z) id . 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 (S.postscanl f z) id . 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 (S.postscanl' f z) id . 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 . Bundle.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 . Bundle.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 (S.scanl1 f) id . 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 (S.scanl1' f) id . 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 (S.prescanl (flip f) z) id . 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 (S.prescanl' (flip f) z) id . 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 (S.postscanl (flip f) z) id . 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 (S.postscanl' (flip f) z) id . 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 . Bundle.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 . Bundle.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 (S.scanl1 (flip f)) id . 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 (S.scanl1' (flip f)) id . streamR -- Conversions - Lists -- ------------------------ -- | /O(n)/ Convert a vector to a list toList :: Vector v a => v a -> [a] {-# INLINE toList #-} toList = Bundle.toList . stream -- | /O(n)/ Convert a list to a vector fromList :: Vector v a => [a] -> v a {-# INLINE fromList #-} fromList = unstream . Bundle.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 . Bundle.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 . Bundle.reVector . 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_FUSED 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_FUSED 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_FUSED 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 Bundles -- --------------------------- -- | /O(1)/ Convert a vector to a 'Bundle' stream :: Vector v a => v a -> Bundle v a {-# INLINE_FUSED stream #-} stream v = Bundle.fromVector v {- stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.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 'Bundle' unstream :: Vector v a => Bundle v 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 => Stream m a -> Stream m a) g m. New.unstream (inplace f g (stream (new m))) = New.transform f g m "uninplace [Vector]" forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. stream (new (New.transform f g m)) = inplace f g (stream (new m)) #-} -- | /O(1)/ Convert a vector to a 'Bundle', proceeding from right to left streamR :: Vector v a => v a -> Bundle u a {-# INLINE_FUSED streamR #-} streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.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 'Bundle', proceeding from right to left unstreamR :: Vector v a => Bundle v 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 => Stream m a -> Stream m a) g m. New.unstreamR (inplace f g (streamR (new m))) = New.transformR f g m "uninplace right [Vector]" forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. streamR (new (New.transformR f g m)) = inplace f g (streamR (new m)) #-} unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a) {-# INLINE_FUSED unstreamM #-} unstreamM s = do xs <- MBundle.toList s return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs unstreamPrimM :: (PrimMonad m, Vector v a) => MBundle m u a -> m (v a) {-# INLINE_FUSED unstreamPrimM #-} unstreamPrimM s = M.munstream s >>= unsafeFreeze -- FIXME: the next two functions are only necessary for the specialisations unstreamPrimM_IO :: Vector v a => MBundle IO u a -> IO (v a) {-# INLINE unstreamPrimM_IO #-} unstreamPrimM_IO = unstreamPrimM unstreamPrimM_ST :: Vector v a => MBundle (ST s) u 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_FUSED 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_FUSED 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 _ = shows . toList -- | Generic definition of 'Text.Read.readPrec' readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) {-# INLINE readPrec #-} readPrec = do 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 #if __GLASGOW_HASKELL__ >= 707 dataCast :: (Vector v a, Data a, Typeable v, Typeable t) #else dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) #endif => (forall d. Data d => c (t d)) -> Maybe (c (v a)) {-# INLINE dataCast #-} dataCast f = gcast1 f vector-0.11.0.0/Data/Vector/Primitive.hs0000644000000000000000000012036212550636750016053 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, 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.Bundle as Bundle import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) import Control.DeepSeq ( NFData(rnf) ) 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 Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts #endif -- | Unboxed vectors of primitive types data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !ByteArray -- ^ offset, length, underlying byte array deriving ( Typeable ) instance NFData (Vector a) where rnf (Vector _ _ _) = () 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 = Bundle.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Bundle.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 = Bundle.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Bundle.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 #if __GLASGOW_HASKELL__ >= 708 instance Prim a => Exts.IsList (Vector a) where type Item (Vector a) = a fromList = fromList fromListN = fromListN toList = toList #endif -- 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.11.0.0/Data/Vector/Storable.hs0000644000000000000000000013023512550636750015656 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, 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.Bundle as Bundle import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray ) import Control.DeepSeq ( NFData(rnf) ) 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 Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts #endif -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE #include "vector.h" -- | 'Storable'-based vectors data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) instance NFData (Vector a) where rnf (Vector _ _) = () 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 = Bundle.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-} xs /= ys = not (Bundle.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 = Bundle.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-} xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-} xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-} xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-} xs >= ys = Bundle.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 #if __GLASGOW_HASKELL__ >= 708 instance Storable a => Exts.IsList (Vector a) where type Item (Vector a) = a fromList = fromList fromListN = fromListN toList = toList #endif -- 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_FUSED 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 _ fp) = withForeignPtr fp vector-0.11.0.0/Data/Vector/Mutable.hs0000644000000000000000000003144112550636750015473 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-} -- | -- 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, modify, swap, unsafeRead, unsafeWrite, unsafeModify, 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 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 _ 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 basicInitialize #-} -- initialization is unnecessary for boxed vectors basicInitialize _ = return () {-# INLINE basicUnsafeReplicate #-} basicUnsafeReplicate n x = do arr <- newArray n x return (MVector 0 n arr) {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector i _ 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 -- | Modify the element at the given position. modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE modify #-} modify = G.modify -- | 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 -- | Modify the element at the given position. No bounds checks are performed. unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE unsafeModify #-} unsafeModify = G.unsafeModify -- | 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.11.0.0/Data/Vector/Storable/0000755000000000000000000000000012550636750015316 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Storable/Internal.hs0000644000000000000000000000161312550636750017427 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 Foreign.ForeignPtr import Foreign.Ptr 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.11.0.0/Data/Vector/Storable/Mutable.hs0000644000000000000000000004012312550636750017243 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, 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, modify, swap, unsafeRead, unsafeWrite, unsafeModify, 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(rnf) ) 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 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 ) -- Data.Vector.Internal.Check is not needed #define NOT_VECTOR_MODULE #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) where rnf (MVector _ _) = () instance Storable a => G.MVector MVector a where {-# INLINE basicLength #-} basicLength (MVector n _) = n {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j m (MVector _ 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 | n < 0 = error $ "Storable.basicUnsafeNew: negative length: " ++ show n | n > mx = error $ "Storable.basicUnsafeNew: length too large: " ++ show n | otherwise = unsafePrimToPrim $ do fp <- mallocVector n return $ MVector n fp where size = sizeOf (undefined :: a) mx = maxBound `quot` size :: Int {-# INLINE basicInitialize #-} basicInitialize = storableZero {-# 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 storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m () {-# INLINE storableZero #-} storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \(Ptr p) -> do let q = Addr p setAddr q byteSize (0 :: Word8) where x :: a x = undefined byteSize :: Int byteSize = n * sizeOf x storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m () {-# INLINE storableSet #-} storableSet (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 -- | Modify the element at the given position. modify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE modify #-} modify = G.modify -- | 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 -- | Modify the element at the given position. No bounds checks are performed. unsafeModify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE unsafeModify #-} unsafeModify = G.unsafeModify -- | 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_FUSED 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 _ fp) = withForeignPtr fp vector-0.11.0.0/Data/Vector/Fusion/0000755000000000000000000000000012550636750015006 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Fusion/Bundle.hs0000644000000000000000000004004612550636750016557 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, BangPatterns #-} -- | -- Module : Data.Vector.Fusion.Bundle -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Bundles for stream fusion -- module Data.Vector.Fusion.Bundle ( -- * Types Step(..), Chunk(..), Bundle, MBundle, -- * 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, lift, fromVector, reVector, fromVectors, concatVectors, -- * Monadic combinators mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', eq, cmp ) where import Data.Vector.Generic.Base ( Vector ) import Data.Vector.Fusion.Bundle.Size import Data.Vector.Fusion.Util import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) ) import qualified Data.Vector.Fusion.Bundle.Monadic as M import qualified Data.Vector.Fusion.Stream.Monadic as S 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 ) -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE #include "vector.h" -- | The type of pure streams type Bundle = M.Bundle Id -- | Alternative name for monadic streams type MBundle = M.Bundle inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b) -> (Size -> Size) -> Bundle v a -> Bundle v b {-# INLINE_FUSED inplace #-} inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b)) {-# RULES "inplace/inplace [Vector]" forall (f1 :: forall m. Monad m => S.Stream m a -> S.Stream m a) (f2 :: forall m. Monad m => S.Stream m a -> S.Stream m a) g1 g2 s. inplace f1 g1 (inplace f2 g2 s) = inplace (f1 . f2) (g1 . g2) s #-} -- | Convert a pure stream to a monadic stream lift :: Monad m => Bundle v a -> M.Bundle m v a {-# INLINE_FUSED lift #-} lift (M.Bundle (Stream step s) (Stream vstep t) v sz) = M.Bundle (Stream (return . unId . step) s) (Stream (return . unId . vstep) t) v sz -- | 'Size' hint of a 'Bundle' size :: Bundle v a -> Size {-# INLINE size #-} size = M.size -- | Attach a 'Size' hint to a 'Bundle' sized :: Bundle v a -> Size -> Bundle v a {-# INLINE sized #-} sized = M.sized -- Length -- ------ -- | Length of a 'Bundle' length :: Bundle v a -> Int {-# INLINE length #-} length = unId . M.length -- | Check if a 'Bundle' is empty null :: Bundle v a -> Bool {-# INLINE null #-} null = unId . M.null -- Construction -- ------------ -- | Empty 'Bundle' empty :: Bundle v a {-# INLINE empty #-} empty = M.empty -- | Singleton 'Bundle' singleton :: a -> Bundle v a {-# INLINE singleton #-} singleton = M.singleton -- | Replicate a value to a given length replicate :: Int -> a -> Bundle v a {-# INLINE replicate #-} replicate = M.replicate -- | Generate a stream from its indices generate :: Int -> (Int -> a) -> Bundle v a {-# INLINE generate #-} generate = M.generate -- | Prepend an element cons :: a -> Bundle v a -> Bundle v a {-# INLINE cons #-} cons = M.cons -- | Append an element snoc :: Bundle v a -> a -> Bundle v a {-# INLINE snoc #-} snoc = M.snoc infixr 5 ++ -- | Concatenate two 'Bundle's (++) :: Bundle v a -> Bundle v a -> Bundle v a {-# INLINE (++) #-} (++) = (M.++) -- Accessing elements -- ------------------ -- | First element of the 'Bundle' or error if empty head :: Bundle v a -> a {-# INLINE head #-} head = unId . M.head -- | Last element of the 'Bundle' or error if empty last :: Bundle v a -> a {-# INLINE last #-} last = unId . M.last infixl 9 !! -- | Element at the given position (!!) :: Bundle v a -> Int -> a {-# INLINE (!!) #-} s !! i = unId (s M.!! i) infixl 9 !? -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Bundle v 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 -> Bundle v a -> Bundle v a {-# INLINE slice #-} slice = M.slice -- | All but the last element init :: Bundle v a -> Bundle v a {-# INLINE init #-} init = M.init -- | All but the first element tail :: Bundle v a -> Bundle v a {-# INLINE tail #-} tail = M.tail -- | The first @n@ elements take :: Int -> Bundle v a -> Bundle v a {-# INLINE take #-} take = M.take -- | All but the first @n@ elements drop :: Int -> Bundle v a -> Bundle v a {-# INLINE drop #-} drop = M.drop -- Mapping -- --------------- -- | Map a function over a 'Bundle' map :: (a -> b) -> Bundle v a -> Bundle v b {-# INLINE map #-} map = M.map unbox :: Bundle v (Box a) -> Bundle v a {-# INLINE unbox #-} unbox = M.unbox concatMap :: (a -> Bundle v b) -> Bundle v a -> Bundle v b {-# INLINE concatMap #-} concatMap = M.concatMap -- Zipping -- ------- -- | Pair each element in a 'Bundle' with its index indexed :: Bundle v a -> Bundle v (Int,a) {-# INLINE indexed #-} indexed = M.indexed -- | Pair each element in a 'Bundle' with its index, starting from the right -- and counting down indexedR :: Int -> Bundle v a -> Bundle v (Int,a) {-# INLINE_FUSED indexedR #-} indexedR = M.indexedR -- | Zip two 'Bundle's with the given function zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c {-# INLINE zipWith #-} zipWith = M.zipWith -- | Zip three 'Bundle's with the given function zipWith3 :: (a -> b -> c -> d) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d {-# INLINE zipWith3 #-} zipWith3 = M.zipWith3 zipWith4 :: (a -> b -> c -> d -> e) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v e {-# INLINE zipWith4 #-} zipWith4 = M.zipWith4 zipWith5 :: (a -> b -> c -> d -> e -> f) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v e -> Bundle v f {-# INLINE zipWith5 #-} zipWith5 = M.zipWith5 zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v e -> Bundle v f -> Bundle v g {-# INLINE zipWith6 #-} zipWith6 = M.zipWith6 zip :: Bundle v a -> Bundle v b -> Bundle v (a,b) {-# INLINE zip #-} zip = M.zip zip3 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v (a,b,c) {-# INLINE zip3 #-} zip3 = M.zip3 zip4 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v (a,b,c,d) {-# INLINE zip4 #-} zip4 = M.zip4 zip5 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v e -> Bundle v (a,b,c,d,e) {-# INLINE zip5 #-} zip5 = M.zip5 zip6 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d -> Bundle v e -> Bundle v f -> Bundle v (a,b,c,d,e,f) {-# INLINE zip6 #-} zip6 = M.zip6 -- Filtering -- --------- -- | Drop elements which do not satisfy the predicate filter :: (a -> Bool) -> Bundle v a -> Bundle v a {-# INLINE filter #-} filter = M.filter -- | Longest prefix of elements that satisfy the predicate takeWhile :: (a -> Bool) -> Bundle v a -> Bundle v a {-# INLINE takeWhile #-} takeWhile = M.takeWhile -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: (a -> Bool) -> Bundle v a -> Bundle v a {-# INLINE dropWhile #-} dropWhile = M.dropWhile -- Searching -- --------- infix 4 `elem` -- | Check whether the 'Bundle' contains an element elem :: Eq a => a -> Bundle v a -> Bool {-# INLINE elem #-} elem x = unId . M.elem x infix 4 `notElem` -- | Inverse of `elem` notElem :: Eq a => a -> Bundle v 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) -> Bundle v 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) -> Bundle v a -> Maybe Int {-# INLINE findIndex #-} findIndex f = unId . M.findIndex f -- Folding -- ------- -- | Left fold foldl :: (a -> b -> a) -> a -> Bundle v b -> a {-# INLINE foldl #-} foldl f z = unId . M.foldl f z -- | Left fold on non-empty 'Bundle's foldl1 :: (a -> a -> a) -> Bundle v a -> a {-# INLINE foldl1 #-} foldl1 f = unId . M.foldl1 f -- | Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Bundle v b -> a {-# INLINE foldl' #-} foldl' f z = unId . M.foldl' f z -- | Left fold on non-empty 'Bundle's with strict accumulator foldl1' :: (a -> a -> a) -> Bundle v a -> a {-# INLINE foldl1' #-} foldl1' f = unId . M.foldl1' f -- | Right fold foldr :: (a -> b -> b) -> b -> Bundle v a -> b {-# INLINE foldr #-} foldr f z = unId . M.foldr f z -- | Right fold on non-empty 'Bundle's foldr1 :: (a -> a -> a) -> Bundle v a -> a {-# INLINE foldr1 #-} foldr1 f = unId . M.foldr1 f -- Specialised folds -- ----------------- and :: Bundle v Bool -> Bool {-# INLINE and #-} and = unId . M.and or :: Bundle v Bool -> Bool {-# INLINE or #-} or = unId . M.or -- Unfolding -- --------- -- | Unfold unfoldr :: (s -> Maybe (a, s)) -> s -> Bundle v a {-# INLINE unfoldr #-} unfoldr = M.unfoldr -- | Unfold at most @n@ elements unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Bundle v a {-# INLINE unfoldrN #-} unfoldrN = M.unfoldrN -- | Apply function n-1 times to value. Zeroth element is original value. iterateN :: Int -> (a -> a) -> a -> Bundle v a {-# INLINE iterateN #-} iterateN = M.iterateN -- Scans -- ----- -- | Prefix scan prescanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE prescanl #-} prescanl = M.prescanl -- | Prefix scan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE prescanl' #-} prescanl' = M.prescanl' -- | Suffix scan postscanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE postscanl #-} postscanl = M.postscanl -- | Suffix scan with strict accumulator postscanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE postscanl' #-} postscanl' = M.postscanl' -- | Haskell-style scan scanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE scanl #-} scanl = M.scanl -- | Haskell-style scan with strict accumulator scanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a {-# INLINE scanl' #-} scanl' = M.scanl' -- | Scan over a non-empty 'Bundle' scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a {-# INLINE scanl1 #-} scanl1 = M.scanl1 -- | Scan over a non-empty 'Bundle' with a strict accumulator scanl1' :: (a -> a -> a) -> Bundle v a -> Bundle v a {-# INLINE scanl1' #-} scanl1' = M.scanl1' -- Comparisons -- ----------- -- | Check if two 'Bundle's are equal eq :: Eq a => Bundle v a -> Bundle v a -> Bool {-# INLINE eq #-} eq x y = unId (M.eq x y) -- | Lexicographically compare two 'Bundle's cmp :: Ord a => Bundle v a -> Bundle v a -> Ordering {-# INLINE cmp #-} cmp x y = unId (M.cmp x y) instance Eq a => Eq (M.Bundle Id v a) where {-# INLINE (==) #-} (==) = eq instance Ord a => Ord (M.Bundle Id v 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) -> Bundle v a -> M.Bundle m v b {-# INLINE mapM #-} mapM f = M.mapM f . lift -- | Apply a monadic action to each element of the stream mapM_ :: Monad m => (a -> m b) -> Bundle v a -> m () {-# INLINE mapM_ #-} mapM_ f = M.mapM_ f . lift zipWithM :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> M.Bundle m v c {-# INLINE zipWithM #-} zipWithM f as bs = M.zipWithM f (lift as) (lift bs) zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f as bs = M.zipWithM_ f (lift as) (lift bs) -- | Yield a monadic stream of elements that satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Bundle v a -> M.Bundle m v a {-# INLINE filterM #-} filterM f = M.filterM f . lift -- | Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a {-# INLINE foldM #-} foldM m z = M.foldM m z . lift -- | Monadic fold over non-empty stream fold1M :: Monad m => (a -> a -> m a) -> Bundle v a -> m a {-# INLINE fold1M #-} fold1M m = M.fold1M m . lift -- | Monadic fold with strict accumulator foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a {-# INLINE foldM' #-} foldM' m z = M.foldM' m z . lift -- | Monad fold over non-empty stream with strict accumulator fold1M' :: Monad m => (a -> a -> m a) -> Bundle v a -> m a {-# INLINE fold1M' #-} fold1M' m = M.fold1M' m . lift -- Enumerations -- ------------ -- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. enumFromStepN :: Num a => a -> a -> Int -> Bundle v 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 -> Bundle v 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 -> Bundle v a {-# INLINE enumFromThenTo #-} enumFromThenTo = M.enumFromThenTo -- Conversions -- ----------- -- | Convert a 'Bundle' to a list toList :: Bundle v 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 -> Bundle v a -> b {-# INLINE [0] toListFB #-} toListFB c n M.Bundle{M.sElems = Stream step t} = go t where go s = case unId (step s) of Yield x s' -> x `c` go s' Skip s' -> go s' Done -> n -- | Create a 'Bundle' from a list fromList :: [a] -> Bundle v a {-# INLINE fromList #-} fromList = M.fromList -- | Create a 'Bundle' from the first @n@ elements of a list -- -- > fromListN n xs = fromList (take n xs) fromListN :: Int -> [a] -> Bundle v a {-# INLINE fromListN #-} fromListN = M.fromListN unsafeFromList :: Size -> [a] -> Bundle v a {-# INLINE unsafeFromList #-} unsafeFromList = M.unsafeFromList fromVector :: Vector v a => v a -> Bundle v a {-# INLINE fromVector #-} fromVector = M.fromVector reVector :: Bundle u a -> Bundle v a {-# INLINE reVector #-} reVector = M.reVector fromVectors :: Vector v a => [v a] -> Bundle v a {-# INLINE fromVectors #-} fromVectors = M.fromVectors concatVectors :: Vector v a => Bundle u (v a) -> Bundle v a {-# INLINE concatVectors #-} concatVectors = M.concatVectors -- | Create a 'Bundle' of values from a 'Bundle' of streamable things flatten :: (a -> s) -> (s -> Step s b) -> Size -> Bundle v a -> Bundle v b {-# INLINE_FUSED flatten #-} flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . lift vector-0.11.0.0/Data/Vector/Fusion/Util.hs0000644000000000000000000000223212550636750016256 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 import Control.Applicative (Applicative(..)) -- | Identity monad newtype Id a = Id { unId :: a } instance Functor Id where fmap f (Id x) = Id (f x) instance Applicative Id where pure = Id Id 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 Applicative Box where pure = Box Box 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.11.0.0/Data/Vector/Fusion/Bundle/0000755000000000000000000000000012550636750016217 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Fusion/Bundle/Monadic.hs0000644000000000000000000010751212550636750020133 0ustar0000000000000000{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Fusion.Bundle.Monadic -- Copyright : (c) Roman Leshchinskiy 2008-2010 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Monadic bundles. -- module Data.Vector.Fusion.Bundle.Monadic ( Bundle(..), Chunk(..), -- * 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, -- * Comparisons eq, cmp, -- * 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, fromVector, reVector, fromVectors, concatVectors, fromStream, chunks, elements ) where import Data.Vector.Generic.Base import qualified Data.Vector.Generic.Mutable.Base as M import Data.Vector.Fusion.Bundle.Size import Data.Vector.Fusion.Util ( Box(..), delay_inline ) import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) import qualified Data.Vector.Fusion.Stream.Monadic as S import Control.Monad.Primitive import qualified Data.List as List 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 ) #include "vector.h" #include "MachDeps.h" data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) -- | Monadic streams data Bundle m v a = Bundle { sElems :: Stream m a , sChunks :: Stream m (Chunk v a) , sVector :: Maybe (v a) , sSize :: Size } fromStream :: Monad m => Stream m a -> Size -> Bundle m v a {-# INLINE fromStream #-} fromStream (Stream step t) sz = Bundle (Stream step t) (Stream step' t) Nothing sz where step' s = do r <- step s return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r chunks :: Bundle m v a -> Stream m (Chunk v a) {-# INLINE chunks #-} chunks = sChunks elements :: Bundle m v a -> Stream m a {-# INLINE elements #-} elements = sElems -- | 'Size' hint of a 'Bundle' size :: Bundle m v a -> Size {-# INLINE size #-} size = sSize -- | Attach a 'Size' hint to a 'Bundle' sized :: Bundle m v a -> Size -> Bundle m v a {-# INLINE_FUSED sized #-} sized s sz = s { sSize = sz } -- Length -- ------ -- | Length of a 'Bundle' length :: Monad m => Bundle m v a -> m Int {-# INLINE_FUSED length #-} length Bundle{sSize = Exact n} = return n length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s -- | Check if a 'Bundle' is empty null :: Monad m => Bundle m v a -> m Bool {-# INLINE_FUSED null #-} null Bundle{sSize = Exact n} = return (n == 0) null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s -- Construction -- ------------ -- | Empty 'Bundle' empty :: Monad m => Bundle m v a {-# INLINE_FUSED empty #-} empty = fromStream S.empty (Exact 0) -- | Singleton 'Bundle' singleton :: Monad m => a -> Bundle m v a {-# INLINE_FUSED singleton #-} singleton x = fromStream (S.singleton x) (Exact 1) -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Bundle m v a {-# INLINE_FUSED replicate #-} replicate n x = Bundle (S.replicate n x) (S.singleton $ Chunk len (\v -> M.basicSet v x)) Nothing (Exact len) where len = delay_inline max n 0 -- | Yield a 'Bundle' of values obtained by performing the monadic action the -- given number of times replicateM :: Monad m => Int -> m a -> Bundle m v a {-# INLINE_FUSED 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 = fromStream (S.replicateM n p) (Exact (delay_inline max n 0)) generate :: Monad m => Int -> (Int -> a) -> Bundle m v a {-# INLINE generate #-} generate n f = generateM n (return . f) -- | Generate a stream from its indices generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a {-# INLINE_FUSED generateM #-} generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0)) -- | Prepend an element cons :: Monad m => a -> Bundle m v a -> Bundle m v a {-# INLINE cons #-} cons x s = singleton x ++ s -- | Append an element snoc :: Monad m => Bundle m v a -> a -> Bundle m v a {-# INLINE snoc #-} snoc s x = s ++ singleton x infixr 5 ++ -- | Concatenate two 'Bundle's (++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED (++) #-} Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb) -- Accessing elements -- ------------------ -- | First element of the 'Bundle' or error if empty head :: Monad m => Bundle m v a -> m a {-# INLINE_FUSED head #-} head = S.head . sElems -- | Last element of the 'Bundle' or error if empty last :: Monad m => Bundle m v a -> m a {-# INLINE_FUSED last #-} last = S.last . sElems infixl 9 !! -- | Element at the given position (!!) :: Monad m => Bundle m v a -> Int -> m a {-# INLINE (!!) #-} b !! i = sElems b S.!! i infixl 9 !? -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a) {-# INLINE (!?) #-} b !? i = sElems b S.!? i -- Substreams -- ---------- -- | Extract a substream of the given length starting at the given position. slice :: Monad m => Int -- ^ starting index -> Int -- ^ length -> Bundle m v a -> Bundle m v a {-# INLINE slice #-} slice i n s = take n (drop i s) -- | All but the last element init :: Monad m => Bundle m v a -> Bundle m v a {-# INLINE_FUSED init #-} init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1) -- | All but the first element tail :: Monad m => Bundle m v a -> Bundle m v a {-# INLINE_FUSED tail #-} tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1) -- | The first @n@ elements take :: Monad m => Int -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED take #-} take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz) -- | All but the first @n@ elements drop :: Monad m => Int -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED drop #-} drop n Bundle{sElems = s, sSize = sz} = fromStream (S.drop n s) (clampedSubtract sz (Exact n)) -- Mapping -- ------- instance Monad m => Functor (Bundle m v) where {-# INLINE fmap #-} fmap = map -- | Map a function over a 'Bundle' map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b {-# INLINE map #-} map f = mapM (return . f) -- | Map a monadic function over a 'Bundle' mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b {-# INLINE_FUSED mapM #-} mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n -- | Execute a monadic action for each element of the 'Bundle' mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m () {-# INLINE_FUSED mapM_ #-} mapM_ m = S.mapM_ m . sElems -- | Transform a 'Bundle' to use a different monad trans :: (Monad m, Monad m') => (forall z. m z -> m' z) -> Bundle m v a -> Bundle m' v a {-# INLINE_FUSED trans #-} trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n} = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n } unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a {-# INLINE_FUSED unbox #-} unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n -- Zipping -- ------- -- | Pair each element in a 'Bundle' with its index indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a) {-# INLINE_FUSED indexed #-} indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n -- | Pair each element in a 'Bundle' with its index, starting from the right -- and counting down indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a) {-# INLINE_FUSED indexedR #-} indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n -- | Zip two 'Bundle's with the given monadic function zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c {-# INLINE_FUSED zipWithM #-} zipWithM f Bundle{sElems = sa, sSize = na} Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb) -- FIXME: This might expose an opportunity for inplace execution. {-# RULES "zipWithM xs xs [Vector.Bundle]" forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-} zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m () {-# INLINE zipWithM_ #-} zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb) zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d {-# INLINE_FUSED zipWith3M #-} zipWith3M f Bundle{sElems = sa, sSize = na} Bundle{sElems = sb, sSize = nb} Bundle{sElems = sc, sSize = nc} = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc)) zipWith4M :: Monad m => (a -> b -> c -> d -> m e) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v 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) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v 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) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v f -> Bundle m v 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) -> Bundle m v a -> Bundle m v b -> Bundle m v c {-# INLINE zipWith #-} zipWith f = zipWithM (\a b -> return (f a b)) zipWith3 :: Monad m => (a -> b -> c -> d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d {-# INLINE zipWith3 #-} zipWith3 f = zipWith3M (\a b c -> return (f a b c)) zipWith4 :: Monad m => (a -> b -> c -> d -> e) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v 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) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v 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) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v f -> Bundle m v g {-# INLINE zipWith6 #-} zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b) {-# INLINE zip #-} zip = zipWith (,) zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c) {-# INLINE zip3 #-} zip3 = zipWith3 (,,) zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v (a,b,c,d) {-# INLINE zip4 #-} zip4 = zipWith4 (,,,) zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v (a,b,c,d,e) {-# INLINE zip5 #-} zip5 = zipWith5 (,,,,) zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f) {-# INLINE zip6 #-} zip6 = zipWith6 (,,,,,) -- Comparisons -- ----------- -- | Check if two 'Bundle's are equal eq :: (Monad m, Eq a) => Bundle m v a -> Bundle m v a -> m Bool {-# INLINE_FUSED eq #-} eq x y = sElems x `S.eq` sElems y -- | Lexicographically compare two 'Bundle's cmp :: (Monad m, Ord a) => Bundle m v a -> Bundle m v a -> m Ordering {-# INLINE_FUSED cmp #-} cmp x y = sElems x `S.cmp` sElems y -- Filtering -- --------- -- | Drop elements which do not satisfy the predicate filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a {-# INLINE filter #-} filter f = filterM (return . f) -- | Drop elements which do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED filterM #-} filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n) -- | Longest prefix of elements that satisfy the predicate takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a {-# INLINE takeWhile #-} takeWhile f = takeWhileM (return . f) -- | Longest prefix of elements that satisfy the monadic predicate takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED takeWhileM #-} takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n) -- | Drop the longest prefix of elements that satisfy the predicate dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a {-# INLINE dropWhile #-} dropWhile f = dropWhileM (return . f) -- | Drop the longest prefix of elements that satisfy the monadic predicate dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED dropWhileM #-} dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n) -- Searching -- --------- infix 4 `elem` -- | Check whether the 'Bundle' contains an element elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool {-# INLINE_FUSED elem #-} elem x = S.elem x . sElems infix 4 `notElem` -- | Inverse of `elem` notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool {-# INLINE notElem #-} notElem x = S.notElem x . sElems -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' -- if no such element exists. find :: Monad m => (a -> Bool) -> Bundle m v 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) -> Bundle m v a -> m (Maybe a) {-# INLINE_FUSED findM #-} findM f = S.findM f . sElems -- | Yield 'Just' the index of the first element that satisfies the predicate -- or 'Nothing' if no such element exists. findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int) {-# INLINE_FUSED 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) -> Bundle m v a -> m (Maybe Int) {-# INLINE_FUSED findIndexM #-} findIndexM f = S.findIndexM f . sElems -- Folding -- ------- -- | Left fold foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v 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 -> Bundle m v b -> m a {-# INLINE_FUSED foldlM #-} foldlM m z = S.foldlM m z . sElems -- | Same as 'foldlM' foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a {-# INLINE foldM #-} foldM = foldlM -- | Left fold over a non-empty 'Bundle' foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a {-# INLINE foldl1 #-} foldl1 f = foldl1M (\a b -> return (f a b)) -- | Left fold over a non-empty 'Bundle' with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a {-# INLINE_FUSED foldl1M #-} foldl1M f = S.foldl1M f . sElems -- | Same as 'foldl1M' fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a {-# INLINE fold1M #-} fold1M = foldl1M -- | Left fold with a strict accumulator foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v 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 -> Bundle m v b -> m a {-# INLINE_FUSED foldlM' #-} foldlM' m z = S.foldlM' m z . sElems -- | Same as 'foldlM'' foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a {-# INLINE foldM' #-} foldM' = foldlM' -- | Left fold over a non-empty 'Bundle' with a strict accumulator foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a {-# INLINE foldl1' #-} foldl1' f = foldl1M' (\a b -> return (f a b)) -- | Left fold over a non-empty 'Bundle' with a strict accumulator and a -- monadic operator foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a {-# INLINE_FUSED foldl1M' #-} foldl1M' f = S.foldl1M' f . sElems -- | Same as 'foldl1M'' fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a {-# INLINE fold1M' #-} fold1M' = foldl1M' -- | Right fold foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v 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 -> Bundle m v a -> m b {-# INLINE_FUSED foldrM #-} foldrM f z = S.foldrM f z . sElems -- | Right fold over a non-empty stream foldr1 :: Monad m => (a -> a -> a) -> Bundle m v 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) -> Bundle m v a -> m a {-# INLINE_FUSED foldr1M #-} foldr1M f = S.foldr1M f . sElems -- Specialised folds -- ----------------- and :: Monad m => Bundle m v Bool -> m Bool {-# INLINE_FUSED and #-} and = S.and . sElems or :: Monad m => Bundle m v Bool -> m Bool {-# INLINE_FUSED or #-} or = S.or . sElems concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b {-# INLINE concatMap #-} concatMap f = concatMapM (return . f) concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b {-# INLINE_FUSED concatMapM #-} concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown -- | Create a 'Bundle' of values from a 'Bundle' of streamable things flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size -> Bundle m v a -> Bundle m v b {-# INLINE_FUSED flatten #-} flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz -- Unfolding -- --------- -- | Unfold unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a {-# INLINE_FUSED unfoldr #-} unfoldr f = unfoldrM (return . f) -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a {-# INLINE_FUSED unfoldrM #-} unfoldrM f s = fromStream (S.unfoldrM f s) Unknown -- | Unfold at most @n@ elements unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a {-# INLINE_FUSED 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 -> Bundle m u a {-# INLINE_FUSED unfoldrNM #-} unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0)) -- | Apply monadic function n times to value. Zeroth element is original value. iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a {-# INLINE_FUSED iterateNM #-} iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0)) -- | Apply function n times to value. Zeroth element is original value. iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a {-# INLINE_FUSED iterateN #-} iterateN n f x0 = iterateNM n (return . f) x0 -- Scans -- ----- -- | Prefix scan prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v a {-# INLINE_FUSED prescanlM #-} prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz -- | Prefix scan with strict accumulator prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v a {-# INLINE_FUSED prescanlM' #-} prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz -- | Suffix scan postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v a {-# INLINE_FUSED postscanlM #-} postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz -- | Suffix scan with strict accumulator postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v a {-# INLINE_FUSED postscanlM' #-} postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz -- | Haskell-style scan scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v 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 -> Bundle m v b -> Bundle m v a {-# INLINE scanlM' #-} scanlM' f z s = z `seq` (z `cons` postscanlM f z s) -- | Scan over a non-empty 'Bundle' scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a {-# INLINE scanl1 #-} scanl1 f = scanl1M (\x y -> return (f x y)) -- | Scan over a non-empty 'Bundle' with a monadic operator scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED scanl1M #-} scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz -- | Scan over a non-empty 'Bundle' with a strict accumulator scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a {-# INLINE scanl1' #-} scanl1' f = scanl1M' (\x y -> return (f x y)) -- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic -- operator scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a {-# INLINE_FUSED scanl1M' #-} scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz -- 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 'Bundle' of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a {-# INLINE_FUSED enumFromStepN #-} enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0)) -- | Enumerate values -- -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED 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 -> Bundle m v a {-# INLINE_FUSED enumFromTo_small #-} enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n) where n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8 "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16 "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8 "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-} #if WORD_SIZE_IN_BITS > 32 {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32 "enumFromTo [Bundle]" enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v 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 :: forall m v. Monad m => Int -> Int -> Bundle m v Int {-# INLINE_FUSED enumFromTo_int #-} enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) where {-# INLINE [0] len #-} len :: Int -> Int -> Int len u v | u > v = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0) $ n where n = v-u+1 {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_intlike #-} enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0) $ fromIntegral n where n = v-u+1 {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int #if WORD_SIZE_IN_BITS > 32 "enumFromTo [Bundle]" enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} #else "enumFromTo [Bundle]" enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32 #-} #endif enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_big_word #-} enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n < fromIntegral (maxBound :: Int)) $ fromIntegral (n+1) where n = v-u {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word "enumFromTo [Bundle]" enumFromTo = enumFromTo_big_word :: Monad m => Word64 -> Word64 -> Bundle m v Word64 #if WORD_SIZE_IN_BITS == 32 "enumFromTo [Bundle]" enumFromTo = enumFromTo_big_word :: Monad m => Word32 -> Word32 -> Bundle m v Word32 #endif "enumFromTo [Bundle]" enumFromTo = enumFromTo_big_word :: Monad m => Integer -> Integer -> Bundle m v Integer #-} -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a {-# INLINE_FUSED enumFromTo_big_int #-} enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) where {-# INLINE [0] len #-} len u v | u > v = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0 && n <= fromIntegral (maxBound :: Int)) $ fromIntegral n where n = v-u+1 {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done #if WORD_SIZE_IN_BITS > 32 {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} #endif enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char {-# INLINE_FUSED enumFromTo_char #-} enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n) where xn = ord x yn = ord y n = delay_inline max 0 (yn - xn + 1) {-# INLINE_INNER step #-} step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) | otherwise = return $ Done {-# RULES "enumFromTo [Bundle]" 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 -> Bundle m v a {-# INLINE_FUSED enumFromTo_double #-} enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n lim)) 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" (l > 0) $ fromIntegral l where l :: Integer l = truncate (y-x)+2 {-# INLINE_INNER step #-} step x | x <= lim = return $ Yield x (x+1) | otherwise = return $ Done {-# RULES "enumFromTo [Bundle]" enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double "enumFromTo [Bundle]" enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v 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 -> Bundle m v a {-# INLINE_FUSED enumFromThenTo #-} enumFromThenTo x y z = fromList [x, y .. z] -- FIXME: Specialise enumFromThenTo. -- Conversions -- ----------- -- | Convert a 'Bundle' to a list toList :: Monad m => Bundle m v a -> m [a] {-# INLINE toList #-} toList = foldr (:) [] -- | Convert a list to a 'Bundle' fromList :: Monad m => [a] -> Bundle m v a {-# INLINE fromList #-} fromList xs = unsafeFromList Unknown xs -- | Convert the first @n@ elements of a list to a 'Bundle' fromListN :: Monad m => Int -> [a] -> Bundle m v a {-# INLINE_FUSED fromListN #-} fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0)) -- | Convert a list to a 'Bundle' with the given 'Size' hint. unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a {-# INLINE_FUSED unsafeFromList #-} unsafeFromList sz xs = fromStream (S.fromList xs) sz fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a {-# INLINE_FUSED fromVector #-} fromVector v = v `seq` n `seq` Bundle (Stream step 0) (Stream vstep True) (Just v) (Exact n) where n = basicLength v {-# INLINE step #-} step i | i >= n = return Done | otherwise = case basicUnsafeIndexM v i of Box x -> return $ Yield x (i+1) {-# INLINE vstep #-} vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) vstep False = return Done fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a {-# INLINE_FUSED fromVectors #-} fromVectors us = Bundle (Stream pstep (Left us)) (Stream vstep us) Nothing (Exact n) where n = List.foldl' (\k v -> k + basicLength v) 0 us pstep (Left []) = return Done pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) pstep (Right (v,i,vs)) | i >= basicLength v = return $ Skip (Left vs) | otherwise = case basicUnsafeIndexM v i of Box x -> return $ Yield x (Right (v,i+1,vs)) -- FIXME: work around bug in GHC 7.6.1 vstep :: [v a] -> m (Step [v a] (Chunk v a)) vstep [] = return Done vstep (v:vs) = return $ Yield (Chunk (basicLength v) (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" (M.basicLength mv == basicLength v) $ basicUnsafeCopy mv v)) vs concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a {-# INLINE_FUSED concatVectors #-} concatVectors Bundle{sElems = Stream step t} = Bundle (Stream pstep (Left t)) (Stream vstep t) Nothing Unknown where pstep (Left s) = do r <- step s case r of Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) Skip s' -> return (Skip (Left s')) Done -> return Done pstep (Right (v,i,s)) | i >= basicLength v = return (Skip (Left s)) | otherwise = case basicUnsafeIndexM v i of Box x -> return (Yield x (Right (v,i+1,s))) vstep s = do r <- step s case r of Yield v s' -> return (Yield (Chunk (basicLength v) (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" (M.basicLength mv == basicLength v) $ basicUnsafeCopy mv v)) s') Skip s' -> return (Skip s') Done -> return Done reVector :: Monad m => Bundle m u a -> Bundle m v a {-# INLINE_FUSED reVector #-} reVector Bundle{sElems = s, sSize = n} = fromStream s n {-# RULES "reVector [Vector]" reVector = id "reVector/reVector [Vector]" forall s. reVector (reVector s) = s #-} vector-0.11.0.0/Data/Vector/Fusion/Bundle/Size.hs0000644000000000000000000000724112550636750017471 0ustar0000000000000000-- | -- Module : Data.Vector.Fusion.Bundle.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.Bundle.Size ( Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound ) 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 = checkedAdd Exact m n Exact m + Max n = checkedAdd Max m n Max m + Exact n = checkedAdd Max m n Max m + Max n = checkedAdd Max m n _ + _ = Unknown Exact m - Exact n = checkedSubtract Exact m n Exact m - Max _ = Max m Max m - Exact n = checkedSubtract Max m n Max m - Max _ = Max m Max m - Unknown = Max m _ - _ = Unknown fromInteger n = Exact (fromInteger n) (*) = error "vector: internal error * for Bundle.size isn't defined" abs = error "vector: internal error abs for Bundle.size isn't defined" signum = error "vector: internal error signum for Bundle.size isn't defined" {-# INLINE checkedAdd #-} checkedAdd :: (Int -> Size) -> Int -> Int -> Size checkedAdd con m n -- Note: we assume m and n are >= 0. | r < m || r < n = error $ "Data.Vector.Fusion.Bundle.Size.checkedAdd: overflow: " ++ show r | otherwise = con r where r = m + n {-# INLINE checkedSubtract #-} checkedSubtract :: (Int -> Size) -> Int -> Int -> Size checkedSubtract con m n | r < 0 = error $ "Data.Vector.Fusion.Bundle.Size.checkedSubtract: underflow: " ++ show r | otherwise = con r where r = m - n -- | Subtract two sizes with clamping to 0, for drop-like things {-# INLINE clampedSubtract #-} clampedSubtract :: Size -> Size -> Size clampedSubtract (Exact m) (Exact n) = Exact (max 0 (m - n)) clampedSubtract (Max m) (Exact n) | m <= n = Exact 0 | otherwise = Max (m - n) clampedSubtract (Exact m) (Max _) = Max m clampedSubtract (Max m) (Max _) = Max m clampedSubtract _ _ = Unknown -- | 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.11.0.0/Data/Vector/Fusion/Stream/0000755000000000000000000000000012550636750016241 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Fusion/Stream/Monadic.hs0000644000000000000000000014623412550636750020161 0ustar0000000000000000{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} -- | -- 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(..), -- * 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, -- * Comparisons eq, cmp, -- * 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 ) where import Data.Vector.Fusion.Util ( Box(..) ) 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__ >= 708 import GHC.Types ( SPEC(..) ) #elif __GLASGOW_HASKELL__ >= 700 import GHC.Exts ( SpecConstrAnnotation(..) ) #endif #include "vector.h" #include "MachDeps.h" #if __GLASGOW_HASKELL__ < 708 data SPEC = SPEC | SPEC2 #if __GLASGOW_HASKELL__ >= 700 {-# ANN type SPEC ForceSpecConstr #-} #endif #endif emptyStream :: String {-# NOINLINE emptyStream #-} emptyStream = "empty stream" #define EMPTY_STREAM (\state -> ERROR state emptyStream) -- | Result of taking a single step in a stream data Step s a where Yield :: a -> s -> Step s a Skip :: s -> Step s a Done :: Step s a instance Functor (Step s) where {-# INLINE fmap #-} fmap f (Yield x s) = Yield (f x) s fmap _ (Skip s) = Skip s fmap _ Done = Done -- | Monadic streams data Stream m a = forall s. Stream (s -> m (Step s a)) s -- Length -- ------ -- | Length of a 'Stream' length :: Monad m => Stream m a -> m Int {-# INLINE_FUSED length #-} length = foldl' (\n _ -> n+1) 0 -- | Check if a 'Stream' is empty null :: Monad m => Stream m a -> m Bool {-# INLINE_FUSED null #-} null (Stream step t) = null_loop t where null_loop s = do r <- step s case r of Yield _ _ -> return False Skip s' -> null_loop s' Done -> return True -- Construction -- ------------ -- | Empty 'Stream' empty :: Monad m => Stream m a {-# INLINE_FUSED empty #-} empty = Stream (const (return Done)) () -- | Singleton 'Stream' singleton :: Monad m => a -> Stream m a {-# INLINE_FUSED singleton #-} singleton x = Stream (return . step) True 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_FUSED 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_FUSED replicateM #-} replicateM n p = Stream step n 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_FUSED generateM #-} generateM n f = n `seq` Stream step 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_FUSED (++) #-} Stream stepa ta ++ Stream stepb tb = Stream step (Left ta) 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 tb) 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_FUSED head #-} head (Stream step t) = head_loop SPEC t where head_loop !_ 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_FUSED last #-} last (Stream step t) = last_loop0 SPEC t where last_loop0 !_ 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 !_ 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 t !! j | j < 0 = ERROR "!!" "negative index" | otherwise = index_loop SPEC t j where index_loop !_ 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 t !? j = index_loop SPEC t j where index_loop !_ 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_FUSED init #-} init (Stream step t) = Stream step' (Nothing, t) 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_FUSED tail #-} tail (Stream step t) = Stream step' (Left t) where {-# INLINE_INNER step' #-} step' (Left s) = liftM (\r -> case r of Yield _ 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_FUSED take #-} take n (Stream step t) = n `seq` Stream step' (t, 0) 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' (_, _) = return Done -- | All but the first @n@ elements drop :: Monad m => Int -> Stream m a -> Stream m a {-# INLINE_FUSED drop #-} drop n (Stream step t) = Stream step' (t, Just n) where {-# INLINE_INNER step' #-} step' (s, Just i) | i > 0 = liftM (\r -> case r of Yield _ 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_FUSED mapM #-} mapM f (Stream step t) = Stream step' t 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_FUSED consume #-} consume (Stream step t) = consume_loop SPEC t where consume_loop !_ 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_FUSED mapM_ #-} mapM_ m = consume . mapM m -- | Transform a 'Stream' to use a different monad trans :: (Monad m, Monad m') => (forall z. m z -> m' z) -> Stream m a -> Stream m' a {-# INLINE_FUSED trans #-} trans f (Stream step s) = Stream (f . step) s unbox :: Monad m => Stream m (Box a) -> Stream m a {-# INLINE_FUSED unbox #-} unbox (Stream step t) = Stream step' t 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_FUSED indexed #-} indexed (Stream step t) = Stream step' (t,0) 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_FUSED indexedR #-} indexedR m (Stream step t) = Stream step' (t,m) 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_FUSED zipWithM #-} zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing) 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_FUSED zipWith3M #-} zipWith3M f (Stream stepa ta) (Stream stepb tb) (Stream stepc tc) = Stream step (ta, tb, tc, Nothing) 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 (,,,,,) -- Comparisons -- ----------- -- | Check if two 'Stream's are equal eq :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool {-# INLINE_FUSED eq #-} eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 where eq_loop0 !_ s1 s2 = do r <- step1 s1 case r of Yield x s1' -> eq_loop1 SPEC x s1' s2 Skip s1' -> eq_loop0 SPEC s1' s2 Done -> eq_null s2 eq_loop1 !_ x s1 s2 = do r <- step2 s2 case r of Yield y s2' | x == y -> eq_loop0 SPEC s1 s2' | otherwise -> return False Skip s2' -> eq_loop1 SPEC x s1 s2' Done -> return False eq_null s2 = do r <- step2 s2 case r of Yield _ _ -> return False Skip s2' -> eq_null s2' Done -> return True -- | Lexicographically compare two 'Stream's cmp :: (Monad m, Ord a) => Stream m a -> Stream m a -> m Ordering {-# INLINE_FUSED cmp #-} cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 where cmp_loop0 !_ s1 s2 = do r <- step1 s1 case r of Yield x s1' -> cmp_loop1 SPEC x s1' s2 Skip s1' -> cmp_loop0 SPEC s1' s2 Done -> cmp_null s2 cmp_loop1 !_ x s1 s2 = do r <- step2 s2 case r of Yield y s2' -> case x `compare` y of EQ -> cmp_loop0 SPEC s1 s2' c -> return c Skip s2' -> cmp_loop1 SPEC x s1 s2' Done -> return GT cmp_null s2 = do r <- step2 s2 case r of Yield _ _ -> return LT Skip s2' -> cmp_null s2' Done -> return EQ -- 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_FUSED filterM #-} filterM f (Stream step t) = Stream step' t 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_FUSED takeWhileM #-} takeWhileM f (Stream step t) = Stream step' t 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_FUSED dropWhileM #-} dropWhileM f (Stream step t) = Stream step' (DropWhile_Drop t) 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_FUSED elem #-} elem x (Stream step t) = elem_loop SPEC t where elem_loop !_ 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_FUSED findM #-} findM f (Stream step t) = find_loop SPEC t where find_loop !_ 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_FUSED 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_FUSED findIndexM #-} findIndexM f (Stream step t) = findIndex_loop SPEC t 0 where findIndex_loop !_ 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_FUSED foldlM #-} foldlM m w (Stream step t) = foldlM_loop SPEC w t where foldlM_loop !_ 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_FUSED foldl1M #-} foldl1M f (Stream step t) = foldl1M_loop SPEC t where foldl1M_loop !_ s = do r <- step s case r of Yield x s' -> foldlM f x (Stream step s') 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_FUSED foldlM' #-} foldlM' m w (Stream step t) = foldlM'_loop SPEC w t where foldlM'_loop !_ 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_FUSED foldl1M' #-} foldl1M' f (Stream step t) = foldl1M'_loop SPEC t where foldl1M'_loop !_ s = do r <- step s case r of Yield x s' -> foldlM' f x (Stream step s') 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_FUSED foldrM #-} foldrM f z (Stream step t) = foldrM_loop SPEC t where foldrM_loop !_ 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_FUSED foldr1M #-} foldr1M f (Stream step t) = foldr1M_loop0 SPEC t where foldr1M_loop0 !_ 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 !_ 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_FUSED and #-} and (Stream step t) = and_loop SPEC t where and_loop !_ 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_FUSED or #-} or (Stream step t) = or_loop SPEC t where or_loop !_ 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_FUSED concatMapM #-} concatMapM f (Stream step t) = Stream concatMap_go (Left t) 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, s)) = do r <- inner_step inner_s case r of Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s)) Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s', 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)) -> Stream m a -> Stream m b {-# INLINE_FUSED flatten #-} flatten mk istep (Stream ostep u) = Stream step (Left u) 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_FUSED unfoldr #-} unfoldr f = unfoldrM (return . f) -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a {-# INLINE_FUSED unfoldrM #-} unfoldrM f t = Stream step t where {-# INLINE_INNER step #-} step s = liftM (\r -> case r of Just (x, s') -> Yield x s' Nothing -> Done ) (f s) unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a {-# INLINE_FUSED 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_FUSED unfoldrNM #-} unfoldrNM m f t = Stream step (t,m) 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_FUSED iterateNM #-} iterateNM n f x0 = Stream step (x0,n) 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_FUSED 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_FUSED prescanlM #-} prescanlM f w (Stream step t) = Stream step' (t,w) 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_FUSED prescanlM' #-} prescanlM' f w (Stream step t) = Stream step' (t,w) 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_FUSED postscanlM #-} postscanlM f w (Stream step t) = Stream step' (t,w) 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_FUSED postscanlM' #-} postscanlM' f w (Stream step t) = w `seq` Stream step' (t,w) 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_FUSED scanl1M #-} scanl1M f (Stream step t) = Stream step' (t, Nothing) 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_FUSED scanl1M' #-} scanl1M' f (Stream step t) = Stream step' (t, Nothing) 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_FUSED enumFromStepN #-} enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n) where {-# INLINE_INNER step #-} step (w,m) | m > 0 = return $ Yield w (w+y,m-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_FUSED 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_FUSED enumFromTo_small #-} enumFromTo_small x y = x `seq` y `seq` Stream step x where {-# INLINE_INNER step #-} step w | w <= y = return $ Yield w (w+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 :: forall m. Monad m => Int -> Int -> Stream m Int {-# INLINE_FUSED enumFromTo_int #-} enumFromTo_int x y = x `seq` y `seq` Stream step x where -- {-# INLINE [0] len #-} -- len :: Int -> Int -> Int -- len u v | u > v = 0 -- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" -- (n > 0) -- $ n -- where -- n = v-u+1 {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_intlike #-} enumFromTo_intlike x y = x `seq` y `seq` Stream step x where {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+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_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} #else "enumFromTo [Stream]" enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32 #-} #endif enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_big_word #-} enumFromTo_big_word x y = x `seq` y `seq` Stream step x where {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+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_FUSED enumFromTo_big_int #-} enumFromTo_big_int x y = x `seq` y `seq` Stream step x where {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done #if WORD_SIZE_IN_BITS > 32 {-# RULES "enumFromTo [Stream]" enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} #endif enumFromTo_char :: Monad m => Char -> Char -> Stream m Char {-# INLINE_FUSED enumFromTo_char #-} enumFromTo_char x y = x `seq` y `seq` Stream step xn where xn = ord x yn = ord y {-# INLINE_INNER step #-} step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+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_FUSED enumFromTo_double #-} enumFromTo_double n m = n `seq` m `seq` Stream step n where lim = m + 1/2 -- important to float out {-# 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_FUSED 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 zs = Stream step zs where step (x:xs) = return (Yield x xs) step [] = return Done -- | Convert the first @n@ elements of a list to a 'Bundle' fromListN :: Monad m => Int -> [a] -> Stream m a {-# INLINE_FUSED fromListN #-} fromListN m zs = Stream step (zs,m) where {-# INLINE_INNER step #-} step (_, n) | n <= 0 = return Done step (x:xs,n) = return (Yield x (xs,n-1)) step ([],_) = return Done {- fromVector :: (Monad m, Vector v a) => v a -> Stream m a {-# INLINE_FUSED fromVector #-} fromVector v = v `seq` n `seq` Stream (Unf step 0) (Unf vstep True) (Just v) (Exact n) where n = basicLength v {-# INLINE step #-} step i | i >= n = return Done | otherwise = case basicUnsafeIndexM v i of Box x -> return $ Yield x (i+1) {-# INLINE vstep #-} vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) vstep False = return Done fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a {-# INLINE_FUSED fromVectors #-} fromVectors vs = Stream (Unf pstep (Left vs)) (Unf vstep vs) Nothing (Exact n) where n = List.foldl' (\k v -> k + basicLength v) 0 vs pstep (Left []) = return Done pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) pstep (Right (v,i,vs)) | i >= basicLength v = return $ Skip (Left vs) | otherwise = case basicUnsafeIndexM v i of Box x -> return $ Yield x (Right (v,i+1,vs)) -- FIXME: work around bug in GHC 7.6.1 vstep :: [v a] -> m (Step [v a] (Chunk v a)) vstep [] = return Done vstep (v:vs) = return $ Yield (Chunk (basicLength v) (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" (M.basicLength mv == basicLength v) $ basicUnsafeCopy mv v)) vs concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a {-# INLINE_FUSED concatVectors #-} concatVectors (Stream step s} = Stream (Unf pstep (Left s)) (Unf vstep s) Nothing Unknown where pstep (Left s) = do r <- step s case r of Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) Skip s' -> return (Skip (Left s')) Done -> return Done pstep (Right (v,i,s)) | i >= basicLength v = return (Skip (Left s)) | otherwise = case basicUnsafeIndexM v i of Box x -> return (Yield x (Right (v,i+1,s))) vstep s = do r <- step s case r of Yield v s' -> return (Yield (Chunk (basicLength v) (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" (M.basicLength mv == basicLength v) $ basicUnsafeCopy mv v)) s') Skip s' -> return (Skip s') Done -> return Done reVector :: Monad m => Stream m a -> Stream m a {-# INLINE_FUSED reVector #-} reVector (Stream step s, sSize = n} = Stream step s n {-# RULES "reVector [Vector]" reVector = id "reVector/reVector [Vector]" forall s. reVector (reVector s) = s #-} -} vector-0.11.0.0/Data/Vector/Generic/0000755000000000000000000000000012550636750015117 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Generic/New.hs0000644000000000000000000001231612550636750016207 0ustar0000000000000000{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-} -- | -- 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, modifyWithBundle, 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.Base ( Vector, Mutable ) import Data.Vector.Fusion.Bundle ( Bundle ) import qualified Data.Vector.Fusion.Bundle as Bundle import Data.Vector.Fusion.Stream.Monadic ( Stream ) import Data.Vector.Fusion.Bundle.Size import Control.Monad.Primitive import Control.Monad.ST ( ST ) import Control.Monad ( liftM ) import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE #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 }) modifyWithBundle :: (forall s. Mutable v s a -> Bundle u b -> ST s ()) -> New v a -> Bundle u b -> New v a {-# INLINE_FUSED modifyWithBundle #-} modifyWithBundle f (New p) s = s `seq` New (do { v <- p; f v s; return v }) unstream :: Vector v a => Bundle v a -> New v a {-# INLINE_FUSED unstream #-} unstream s = s `seq` New (MVector.vunstream s) transform :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) -> (Size -> Size) -> New v a -> New v a {-# INLINE_FUSED transform #-} transform f _ (New p) = New (MVector.transform f =<< p) {-# RULES "transform/transform [New]" forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) (f2 :: forall m. Monad m => Stream m a -> Stream m a) g1 g2 p . transform f1 g1 (transform f2 g2 p) = transform (f1 . f2) (g1 . g2) p "transform/unstream [New]" forall (f :: forall m. Monad m => Stream m a -> Stream m a) g s. transform f g (unstream s) = unstream (Bundle.inplace f g s) #-} unstreamR :: Vector v a => Bundle v a -> New v a {-# INLINE_FUSED unstreamR #-} unstreamR s = s `seq` New (MVector.unstreamR s) transformR :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) -> (Size -> Size) -> New v a -> New v a {-# INLINE_FUSED transformR #-} transformR f _ (New p) = New (MVector.transformR f =<< p) {-# RULES "transformR/transformR [New]" forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) (f2 :: forall m. Monad m => Stream m a -> Stream m a) g1 g2 p . transformR f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p "transformR/unstreamR [New]" forall (f :: forall m. Monad m => Stream m a -> Stream m a) g s. transformR f g (unstreamR s) = unstreamR (Bundle.inplace f g s) #-} slice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_FUSED slice #-} slice i n m = apply (MVector.slice i n) m init :: Vector v a => New v a -> New v a {-# INLINE_FUSED init #-} init m = apply MVector.init m tail :: Vector v a => New v a -> New v a {-# INLINE_FUSED tail #-} tail m = apply MVector.tail m take :: Vector v a => Int -> New v a -> New v a {-# INLINE_FUSED take #-} take n m = apply (MVector.take n) m drop :: Vector v a => Int -> New v a -> New v a {-# INLINE_FUSED drop #-} drop n m = apply (MVector.drop n) m unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_FUSED unsafeSlice #-} unsafeSlice i n m = apply (MVector.unsafeSlice i n) m unsafeInit :: Vector v a => New v a -> New v a {-# INLINE_FUSED unsafeInit #-} unsafeInit m = apply MVector.unsafeInit m unsafeTail :: Vector v a => New v a -> New v a {-# INLINE_FUSED unsafeTail #-} unsafeTail m = apply MVector.unsafeTail m {-# RULES "slice/unstream [New]" forall i n s. slice i n (unstream s) = unstream (Bundle.slice i n s) "init/unstream [New]" forall s. init (unstream s) = unstream (Bundle.init s) "tail/unstream [New]" forall s. tail (unstream s) = unstream (Bundle.tail s) "take/unstream [New]" forall n s. take n (unstream s) = unstream (Bundle.take n s) "drop/unstream [New]" forall n s. drop n (unstream s) = unstream (Bundle.drop n s) "unsafeSlice/unstream [New]" forall i n s. unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s) "unsafeInit/unstream [New]" forall s. unsafeInit (unstream s) = unstream (Bundle.init s) "unsafeTail/unstream [New]" forall s. unsafeTail (unstream s) = unstream (Bundle.tail s) #-} vector-0.11.0.0/Data/Vector/Generic/Base.hs0000644000000000000000000001064612550636750016334 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.Base ( MVector ) import qualified Data.Vector.Generic.Mutable.Base 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.11.0.0/Data/Vector/Generic/Mutable.hs0000644000000000000000000010575712550636750017063 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, 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, growFront, unsafeGrowFront, -- ** Restricting memory usage clear, -- * Accessing individual elements read, write, modify, swap, exchange, unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange, -- * Modifying vectors -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove, -- * Internal operations mstream, mstreamR, unstream, unstreamR, vunstream, munstream, munstreamR, transform, transformR, fill, fillR, unsafeAccum, accum, unsafeUpdate, update, reverse, unstablePartition, unstablePartitionBundle, partitionBundle ) where import Data.Vector.Generic.Mutable.Base import qualified Data.Vector.Generic.Base as V import qualified Data.Vector.Fusion.Bundle as Bundle import Data.Vector.Fusion.Bundle ( Bundle, MBundle, Chunk(..) ) import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle import Data.Vector.Fusion.Stream.Monadic ( Stream ) import qualified Data.Vector.Fusion.Stream.Monadic as Stream import Data.Vector.Fusion.Bundle.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" {- type family Immutable (v :: * -> * -> *) :: * -> * -- | Class of mutable vectors parametrised with a primitive state token. -- class MBundle.Pointer u a => 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 () basicUnsafeCopyPointer :: PrimMonad m => v (PrimState m) a -> Immutable v 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 basicUnsafeCopyPointer #-} basicUnsafeCopyPointer !dst !src = do_copy 0 src where do_copy !i p | Just (x,q) <- MBundle.pget p = do basicUnsafeWrite dst i x do_copy (i+1) q | otherwise = return () {-# 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', j) <- enlargeFront v let i' = j-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 -> Stream m a {-# INLINE mstream #-} mstream v = v `seq` n `seq` (Stream.unfoldrM get 0) 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 -> Stream m a -> m (v (PrimState m) a) {-# INLINE fill #-} fill v s = v `seq` do n' <- Stream.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) => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_FUSED transform #-} transform f v = fill v (f (mstream v)) mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a {-# INLINE mstreamR #-} mstreamR v = v `seq` n `seq` (Stream.unfoldrM get 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 -> Stream m a -> m (v (PrimState m) a) {-# INLINE fillR #-} fillR v s = v `seq` do i <- Stream.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) => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_FUSED transformR #-} transformR f v = fillR v (f (mstreamR v)) -- | Create a new mutable vector and fill it with elements from the 'Bundle'. -- The vector will grow exponentially if the maximum size of the 'Bundle' is -- unknown. unstream :: (PrimMonad m, MVector v a) => Bundle u a -> m (v (PrimState m) a) -- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) {-# INLINE_FUSED unstream #-} unstream s = munstream (Bundle.lift 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) => MBundle m u a -> m (v (PrimState m) a) {-# INLINE_FUSED munstream #-} munstream s = case upperBound (MBundle.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 . Bundle.fromList -- -- I'm not sure this still applies (19/04/2010) munstreamMax :: (PrimMonad m, MVector v a) => MBundle m u 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' <- MBundle.foldM' put 0 s return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n $ unsafeSlice 0 n' v munstreamUnknown :: (PrimMonad m, MVector v a) => MBundle m u a -> m (v (PrimState m) a) {-# INLINE munstreamUnknown #-} munstreamUnknown s = do v <- unsafeNew 0 (v', n) <- MBundle.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 'Bundle'. -- The vector will grow exponentially if the maximum size of the 'Bundle' is -- unknown. vunstream :: (PrimMonad m, V.Vector v a) => Bundle v a -> m (V.Mutable v (PrimState m) a) -- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) {-# INLINE_FUSED vunstream #-} vunstream s = vmunstream (Bundle.lift 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. vmunstream :: (PrimMonad m, V.Vector v a) => MBundle m v a -> m (V.Mutable v (PrimState m) a) {-# INLINE_FUSED vmunstream #-} vmunstream s = case upperBound (MBundle.size s) of Just n -> vmunstreamMax s n Nothing -> vmunstreamUnknown 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 . Bundle.fromList -- -- I'm not sure this still applies (19/04/2010) vmunstreamMax :: (PrimMonad m, V.Vector v a) => MBundle m v a -> Int -> m (V.Mutable v (PrimState m) a) {-# INLINE vmunstreamMax #-} vmunstreamMax s n = do v <- INTERNAL_CHECK(checkLength) "munstreamMax" n $ unsafeNew n let {-# INLINE_INNER copyChunk #-} copyChunk i (Chunk m f) = INTERNAL_CHECK(checkSlice) "munstreamMax.copyChunk" i m (length v) $ do f (basicUnsafeSlice i m v) return (i+m) n' <- Stream.foldlM' copyChunk 0 (MBundle.chunks s) return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n $ unsafeSlice 0 n' v vmunstreamUnknown :: (PrimMonad m, V.Vector v a) => MBundle m v a -> m (V.Mutable v (PrimState m) a) {-# INLINE vmunstreamUnknown #-} vmunstreamUnknown s = do v <- unsafeNew 0 (v', n) <- Stream.foldlM copyChunk (v,0) (MBundle.chunks s) return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') $ unsafeSlice 0 n v' where {-# INLINE_INNER copyChunk #-} copyChunk (v,i) (Chunk n f) = do let j = i+n v' <- if basicLength v < j then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v)) else return v INTERNAL_CHECK(checkSlice) "munstreamUnknown.copyChunk" i n (length v') $ f (basicUnsafeSlice i n v') return (v',j) -- | Create a new mutable vector and fill it with elements from the 'Bundle' -- from right to left. The vector will grow exponentially if the maximum size -- of the 'Bundle' is unknown. unstreamR :: (PrimMonad m, MVector v a) => Bundle u a -> m (v (PrimState m) a) -- NOTE: replace INLINE_FUSED by INLINE? (also in unstream) {-# INLINE_FUSED unstreamR #-} unstreamR s = munstreamR (Bundle.lift 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) => MBundle m u a -> m (v (PrimState m) a) {-# INLINE_FUSED munstreamR #-} munstreamR s = case upperBound (MBundle.size s) of Just n -> munstreamRMax s n Nothing -> munstreamRUnknown s munstreamRMax :: (PrimMonad m, MVector v a) => MBundle m u 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 <- MBundle.foldM' put n s return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n $ unsafeSlice i (n-i) v munstreamRUnknown :: (PrimMonad m, MVector v a) => MBundle m u a -> m (v (PrimState m) a) {-# INLINE munstreamRUnknown #-} munstreamRUnknown s = do v <- unsafeNew 0 (v', i) <- MBundle.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 >>= \v -> basicInitialize v >> return v -- | 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 (MBundle.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 $ do vnew <- unsafeGrow v by basicInitialize $ basicUnsafeSlice (length v) by vnew return vnew 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 $ do vnew <- unsafeGrowFront v by basicInitialize $ basicUnsafeSlice 0 by vnew return vnew enlarge_delta :: MVector v a => v s a -> Int 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 = do vnew <- unsafeGrow v by basicInitialize $ basicUnsafeSlice (length v) by vnew return vnew where by = 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 basicInitialize $ basicUnsafeSlice 0 by v' 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 -- | Modify the element at the given position. modify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE modify #-} modify v f i = BOUNDS_CHECK(checkIndex) "modify" i (length v) $ unsafeModify v f i -- | 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 -- | Modify the element at the given position. No bounds checks are performed. unsafeModify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE unsafeModify #-} unsafeModify v f i = UNSAFE_CHECK(checkIndex) "unsafeModify" i (length v) $ basicUnsafeRead v i >>= \x -> basicUnsafeWrite v i (f 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 -> Bundle u (Int, b) -> m () {-# INLINE accum #-} accum f !v s = Bundle.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 -> Bundle u (Int, a) -> m () {-# INLINE update #-} update !v s = Bundle.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 -> Bundle u (Int, b) -> m () {-# INLINE unsafeAccum #-} unsafeAccum f !v s = Bundle.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 -> Bundle u (Int, a) -> m () {-# INLINE unsafeUpdate #-} unsafeUpdate !v s = Bundle.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) unstablePartitionBundle :: (PrimMonad m, MVector v a) => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE unstablePartitionBundle #-} unstablePartitionBundle f s = case upperBound (Bundle.size s) of Just n -> unstablePartitionMax f s n Nothing -> partitionUnknown f s unstablePartitionMax :: (PrimMonad m, MVector v a) => (a -> Bool) -> Bundle u 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) <- Bundle.foldM' put (0, n) s return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) partitionBundle :: (PrimMonad m, MVector v a) => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionBundle #-} partitionBundle f s = case upperBound (Bundle.size s) of Just n -> partitionMax f s n Nothing -> partitionUnknown f s partitionMax :: (PrimMonad m, MVector v a) => (a -> Bool) -> Bundle u 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) <- Bundle.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) -> Bundle u 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) <- Bundle.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.11.0.0/Data/Vector/Generic/Mutable/0000755000000000000000000000000012550636750016510 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Generic/Mutable/Base.hs0000644000000000000000000001241212550636750017716 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-} -- | -- Module : Data.Vector.Generic.Mutable.Base -- Copyright : (c) Roman Leshchinskiy 2008-2011 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : non-portable -- -- Class of mutable vectors -- module Data.Vector.Generic.Mutable.Base ( MVector(..) ) where import Control.Monad.Primitive ( PrimMonad, PrimState ) -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE #include "vector.h" -- | Class of mutable vectors parametrised with a primitive state token. -- 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) -- | Initialize a vector to a standard value. This is intended to be called as -- part of the safe new operation (and similar operations), to properly blank -- the newly allocated memory if necessary. -- -- Vectors that are necessarily initialized as part of creation may implement -- this as a no-op. basicInitialize :: PrimMonad m => v (PrimState m) a -> m () -- | 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 <- basicUnsafeNew (basicLength src) basicUnsafeCopy srcCopy 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 vector-0.11.0.0/Data/Vector/Internal/0000755000000000000000000000000012550636750015317 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Internal/Check.hs0000644000000000000000000001005012550636750016664 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- 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 && _ = False True && x = x (||) :: Bool -> Bool -> Bool {-# INLINE (||) #-} True || _ = 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.11.0.0/Data/Vector/Unboxed/0000755000000000000000000000000012550636750015147 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Unboxed/Base.hs0000644000000000000000000003443112550636750016362 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif {-# 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(rnf) ) 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 #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable ) #else import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, #if MIN_VERSION_base(4,4,0) mkTyCon3 #else mkTyCon #endif ) #endif import Data.Data ( Data(..) ) -- Data.Vector.Internal.Check is unused #define NOT_VECTOR_MODULE #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) where rnf !_ = () instance NFData (MVector s a) where rnf !_ = () -- ----------------- -- Data and Typeable -- ----------------- #if __GLASGOW_HASKELL__ >= 707 deriving instance Typeable Vector deriving instance Typeable MVector #else #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") [] #endif 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 basicInitialize #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Unit n) = n basicUnsafeSlice _ m (MV_Unit _) = MV_Unit m basicOverlaps _ _ = False basicUnsafeNew n = return (MV_Unit n) -- Nothing to initialize basicInitialize _ = return () 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 _ m (V_Unit _) = V_Unit m {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_Unit _) _ = 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 basicInitialize #-} \ ; {-# 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 \ ; basicInitialize (con v) = M.basicInitialize v \ ; 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 basicInitialize #-} {-# 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 basicInitialize (MV_Bool v) = M.basicInitialize v 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 basicInitialize #-} {-# 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 basicInitialize (MV_Complex v) = M.basicInitialize v 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" vector-0.11.0.0/Data/Vector/Unboxed/Mutable.hs0000644000000000000000000002131712550636750017100 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- 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, modify, swap, unsafeRead, unsafeWrite, unsafeModify, 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 ) -- don't import an unused Data.Vector.Internal.Check #define NOT_VECTOR_MODULE #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 -- | Modify the element at the given position. modify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE modify #-} modify = G.modify -- | 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 -- | Modify the element at the given position. No bounds checks are performed. unsafeModify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE unsafeModify #-} unsafeModify = G.unsafeModify -- | 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.11.0.0/Data/Vector/Primitive/0000755000000000000000000000000012550636750015513 5ustar0000000000000000vector-0.11.0.0/Data/Vector/Primitive/Mutable.hs0000644000000000000000000002520312550636750017442 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, 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, modify, swap, unsafeRead, unsafeWrite, unsafeModify, 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 Data.Word ( Word8 ) import Control.Monad.Primitive import Control.Monad ( liftM ) import Control.DeepSeq ( NFData(rnf) ) import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, splitAt, init, tail ) import Data.Typeable ( Typeable ) -- Data.Vector.Internal.Check is unnecessary #define NOT_VECTOR_MODULE #include "vector.h" -- | Mutable vectors of primitive types. data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) -- ^ offset, length, underlying mutable byte array deriving ( Typeable ) type IOVector = MVector RealWorld type STVector s = MVector s instance NFData (MVector s a) where rnf (MVector _ _ _) = () instance Prim a => G.MVector MVector a where basicLength (MVector _ n _) = n basicUnsafeSlice j m (MVector i _ 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 | n < 0 = error $ "Primitive.basicUnsafeNew: negative length: " ++ show n | n > mx = error $ "Primitive.basicUnsafeNew: length to large: " ++ show n | otherwise = MVector 0 n `liftM` newByteArray (n * size) where size = sizeOf (undefined :: a) mx = maxBound `div` size :: Int {-# INLINE basicInitialize #-} basicInitialize (MVector off n v) = setByteArray v (off * size) (n * size) (0 :: Word8) where size = sizeOf (undefined :: a) {-# INLINE basicUnsafeRead #-} basicUnsafeRead (MVector i _ arr) j = readByteArray arr (i+j) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector i _ 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 -- | Modify the element at the given position. modify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE modify #-} modify = G.modify -- | 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 -- | Modify the element at the given position. No bounds checks are performed. unsafeModify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () {-# INLINE unsafeModify #-} unsafeModify = G.unsafeModify -- | 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.11.0.0/benchmarks/0000755000000000000000000000000012550636750013545 5ustar0000000000000000vector-0.11.0.0/benchmarks/Main.hs0000644000000000000000000000322612550636750014770 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.11.0.0/benchmarks/LICENSE0000644000000000000000000000301612550636750014552 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.11.0.0/benchmarks/Setup.hs0000644000000000000000000000005712550636750015203 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-0.11.0.0/benchmarks/vector-benchmarks.cabal0000644000000000000000000000156512550636750020155 0ustar0000000000000000Name: vector-benchmarks Version: 0.10.9 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.9 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.11.0.0/benchmarks/Algo/0000755000000000000000000000000012550636750014427 5ustar0000000000000000vector-0.11.0.0/benchmarks/Algo/Tridiag.hs0000644000000000000000000000102112550636750016340 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.11.0.0/benchmarks/Algo/AwShCC.hs0000644000000000000000000000246512550636750016042 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.11.0.0/benchmarks/Algo/ListRank.hs0000644000000000000000000000075712550636750016523 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.11.0.0/benchmarks/Algo/Spectral.hs0000644000000000000000000000071612550636750016544 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.11.0.0/benchmarks/Algo/Rootfix.hs0000644000000000000000000000070312550636750016415 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.11.0.0/benchmarks/Algo/Leaffix.hs0000644000000000000000000000070712550636750016345 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.11.0.0/benchmarks/Algo/Quickhull.hs0000644000000000000000000000162712550636750016732 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.11.0.0/benchmarks/Algo/HybCC.hs0000644000000000000000000000252512550636750015717 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.11.0.0/benchmarks/TestData/0000755000000000000000000000000012550636750015256 5ustar0000000000000000vector-0.11.0.0/benchmarks/TestData/ParenTree.hs0000644000000000000000000000121012550636750017471 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.11.0.0/benchmarks/TestData/Graph.hs0000644000000000000000000000233112550636750016652 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.11.0.0/benchmarks/TestData/Random.hs0000644000000000000000000000060212550636750017030 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.11.0.0/internal/0000755000000000000000000000000012550636750013244 5ustar0000000000000000vector-0.11.0.0/internal/GenUnboxTuple.hs0000644000000000000000000002156512550636750016350 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_FUSED" <+> 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 "Bundle." <> 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.11.0.0/internal/unbox-tuple-instances0000644000000000000000000012162412550636750017444 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_ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_2 _ as bs) = MV_2 m_ (M.basicUnsafeSlice i_ m_ as) (M.basicUnsafeSlice i_ m_ bs) {-# INLINE basicOverlaps #-} basicOverlaps (MV_2 _ as1 bs1) (MV_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 basicInitialize #-} basicInitialize (MV_2 _ as bs) = do M.basicInitialize as M.basicInitialize 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 _ as bs) i_ = do a <- M.basicUnsafeRead as i_ b <- M.basicUnsafeRead bs i_ return (a, b) {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MV_2 _ as bs) i_ (a, b) = do M.basicUnsafeWrite as i_ a M.basicUnsafeWrite bs i_ b {-# INLINE basicClear #-} basicClear (MV_2 _ as bs) = do M.basicClear as M.basicClear bs {-# INLINE basicSet #-} basicSet (MV_2 _ as bs) (a, b) = do M.basicSet as a M.basicSet bs b {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_2 _ as1 bs1) (MV_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_ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_2 _ as bs) = V_2 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_2 _ as bs) i_ = do a <- G.basicUnsafeIndexM as i_ b <- G.basicUnsafeIndexM bs i_ return (a, b) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 _ as1 bs1) (V_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_FUSED 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 _ 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_FUSED 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) = Bundle.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 _ 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_ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_3 _ 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 _ as1 bs1 cs1) (MV_3 _ 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 basicInitialize #-} basicInitialize (MV_3 _ as bs cs) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize 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 _ 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 _ 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 _ as bs cs) = do M.basicClear as M.basicClear bs M.basicClear cs {-# INLINE basicSet #-} basicSet (MV_3 _ as bs cs) (a, b, c) = do M.basicSet as a M.basicSet bs b M.basicSet cs c {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) = do M.basicUnsafeCopy as1 as2 M.basicUnsafeCopy bs1 bs2 M.basicUnsafeCopy cs1 cs2 {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MV_3 _ as1 bs1 cs1) (MV_3 _ 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_ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_3 _ 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 _ 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 _ as1 bs1 cs1) (V_3 _ 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_FUSED 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 _ 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_FUSED 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) = Bundle.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 _ 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_ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_4 _ 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 _ as1 bs1 cs1 ds1) (MV_4 _ 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 basicInitialize #-} basicInitialize (MV_4 _ as bs cs ds) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize 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 _ 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 _ 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 _ as bs cs ds) = do M.basicClear as M.basicClear bs M.basicClear cs M.basicClear ds {-# INLINE basicSet #-} basicSet (MV_4 _ 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 _ as1 bs1 cs1 ds1) (MV_4 _ 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 _ as1 bs1 cs1 ds1) (MV_4 _ 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_ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_4 _ 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 _ 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 _ as1 bs1 cs1 ds1) (V_4 _ 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_FUSED 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 _ 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_FUSED 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) = Bundle.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 _ 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_ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_5 _ 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 _ as1 bs1 cs1 ds1 es1) (MV_5 _ 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 basicInitialize #-} basicInitialize (MV_5 _ as bs cs ds es) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize ds M.basicInitialize 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 _ 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 _ 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 _ 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 _ 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 _ as1 bs1 cs1 ds1 es1) (MV_5 _ 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 _ as1 bs1 cs1 ds1 es1) (MV_5 _ 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_ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_5 _ 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 _ 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 _ as1 bs1 cs1 ds1 es1) (V_5 _ 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_FUSED 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 _ 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_FUSED 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) = Bundle.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 _ 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_ _ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (MV_6 _ 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 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ 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 basicInitialize #-} basicInitialize (MV_6 _ as bs cs ds es fs) = do M.basicInitialize as M.basicInitialize bs M.basicInitialize cs M.basicInitialize ds M.basicInitialize es M.basicInitialize 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 _ 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 _ 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 _ 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 _ 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 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ 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 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ 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_ _ _ _ _ _ _) = n_ {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i_ m_ (V_6 _ 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 _ 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 _ as1 bs1 cs1 ds1 es1 fs1) (V_6 _ 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_FUSED 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 _ 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_FUSED 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) = Bundle.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 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) #endif