feat(third_party/bazel): Check in rules_haskell from Tweag

third_party/bazel/rules_haskell/examples/vector/BUILD.bazel

@@ -0,0 +1,38 @@
+load(
+    "@io_tweag_rules_haskell//haskell:haskell.bzl",
+    "haskell_cc_import",
+    "haskell_library",
+    "haskell_toolchain_library",
+)
+
+haskell_toolchain_library(name = "base")
+
+haskell_toolchain_library(name = "deepseq")
+
+haskell_toolchain_library(name = "ghc-prim")
+
+haskell_toolchain_library(name = "primitive")
+
+haskell_toolchain_library(name = "semigroups")
+
+haskell_library(
+    name = "vector",
+    testonly = 1,
+    srcs = glob(["Data/**/*.*hs"]),
+    compiler_flags = [
+        "-Iexternal/io_tweag_rules_haskell_examples/vector/include",
+        "-Iexternal/io_tweag_rules_haskell_examples/vector/internal",
+    ],
+    extra_srcs = [
+        "include/vector.h",
+        "internal/unbox-tuple-instances",
+    ],
+    version = "0",
+    visibility = ["//visibility:public"],
+    deps = [
+        ":base",
+        ":deepseq",
+        ":ghc-prim",
+        "//primitive",
+    ],
+)

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs

@@ -0,0 +1,655 @@
+{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, BangPatterns #-}
+
+-- |
+-- Module      : Data.Vector.Fusion.Bundle
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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, eqBy, cmpBy
+) 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_ )
+
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (Eq1 (..), Ord1 (..))
+#endif
+
+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 = eqBy (==)
+
+eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool
+{-# INLINE eqBy #-}
+eqBy e x y = unId (M.eqBy e x y)
+
+-- | Lexicographically compare two 'Bundle's
+cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering
+{-# INLINE cmp #-}
+cmp = cmpBy compare
+
+cmpBy :: (a ->  b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering
+{-# INLINE cmpBy #-}
+cmpBy c x y = unId (M.cmpBy c 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
+
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 (M.Bundle Id v) where
+  {-# INLINE liftEq #-}
+  liftEq = eqBy
+
+instance Ord1 (M.Bundle Id v) where
+  {-# INLINE liftCompare #-}
+  liftCompare = cmpBy
+#endif
+
+-- 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
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs

@@ -0,0 +1,121 @@
+-- |
+-- Module      : Data.Vector.Fusion.Bundle.Size
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE CPP #-}
+-- |
+-- Module      : Data.Vector.Fusion.Util
+-- Copyright   : (c) Roman Leshchinskiy 2009
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- Stability   : experimental
+-- Portability : portable
+--
+-- Fusion-related utility types
+--
+
+module Data.Vector.Fusion.Util (
+  Id(..), Box(..),
+
+  delay_inline, delayed_min
+) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative (Applicative(..))
+#endif
+
+-- | 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 = pure
+  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 = pure
+  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

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs

@@ -0,0 +1,140 @@
+{-# 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 <rl@cse.unsw.edu.au>
+-- 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
+
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-}
+-- |
+-- Module      : Data.Vector.Generic.Mutable.Base
+-- Copyright   : (c) Roman Leshchinskiy 2008-2011
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs

@@ -0,0 +1,178 @@
+{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-}
+
+-- |
+-- Module      : Data.Vector.Generic.New
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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)   #-}
+
+
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs

@@ -0,0 +1,152 @@
+{-# LANGUAGE CPP #-}
+
+-- |
+-- Module      : Data.Vector.Internal.Check
+-- Copyright   : (c) Roman Leshchinskiy 2009
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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<n) x
+
+
+checkLength_msg :: Int -> 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
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs

@@ -0,0 +1,416 @@
+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-}
+
+-- |
+-- Module      : Data.Vector.Mutable
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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
+  nextPermutation,
+
+  -- ** 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, 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 memory is not initialized.
+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
+
+-- | Compute the next (lexicographically) permutation of given vector in-place.
+--   Returns False when input is the last permtuation
+nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool
+{-# INLINE nextPermutation #-}
+nextPermutation = G.nextPermutation

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs

@@ -0,0 +1,366 @@
+{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}
+
+-- |
+-- Module      : Data.Vector.Primitive.Mutable
+-- Copyright   : (c) Roman Leshchinskiy 2008-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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
+  nextPermutation,
+
+  -- ** 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 memory is not initialized.
+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   -- ^ target
+     -> MVector (PrimState m) a   -- ^ source
+     -> 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
+
+-- | Compute the next (lexicographically) permutation of given vector in-place.
+--   Returns False when input is the last permtuation
+nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool
+{-# INLINE nextPermutation #-}
+nextPermutation = G.nextPermutation

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs

@@ -0,0 +1,33 @@
+-- |
+-- Module      : Data.Vector.Storable.Internal
+-- Copyright   : (c) Roman Leshchinskiy 2009-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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 }
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs

@@ -0,0 +1,543 @@
+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-}
+
+-- |
+-- Module      : Data.Vector.Storable.Mutable
+-- Copyright   : (c) Roman Leshchinskiy 2009-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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__ >= 706
+import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)
+#elif __GLASGOW_HASKELL__ >= 700
+import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray,
+                                 unsafeFreezeByteArray)
+import GHC.Prim (byteArrayContents#, unsafeCoerce#)
+import GHC.ForeignPtr
+#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__ >= 706
+  doMalloc undefined
+  where
+    doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
+    doMalloc dummy size =
+      mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy)
+#elif __GLASGOW_HASKELL__ >= 700
+  doMalloc undefined
+  where
+    doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
+    doMalloc dummy size = do
+      arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign
+      newConcForeignPtr
+        (Ptr (byteArrayContents# (unsafeCoerce# arr#)))
+        -- Keep reference to mutable byte array until whole ForeignPtr goes out
+        -- of scope.
+        (touch arr)
+      where
+        arrSize  = size * sizeOf dummy
+        arrAlign = alignment 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 memory is not initialized.
+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   -- ^ target
+     -> MVector (PrimState m) a   -- ^ source
+     -> 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
+

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs

@@ -0,0 +1,408 @@
+{-# 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 <rl@cse.unsw.edu.au>
+-- 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 ( Word8, Word16, Word32, Word64 )
+import Data.Int  ( Int8, Int16, Int32, Int64 )
+import Data.Complex
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Word ( Word )
+#endif
+
+#if __GLASGOW_HASKELL__ >= 707
+import Data.Typeable ( Typeable )
+#else
+import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
+                       mkTyCon3
+                     )
+#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
+vectorTyCon = mkTyCon3 "vector"
+
+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 (Unbox a) => Unbox (Complex a)
+
+instance (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 (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"

third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs

@@ -0,0 +1,307 @@
+{-# LANGUAGE CPP #-}
+
+-- |
+-- Module      : Data.Vector.Unboxed.Mutable
+-- Copyright   : (c) Roman Leshchinskiy 2009-2010
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- 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
+  nextPermutation,
+
+  -- ** 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 memory is not initialized.
+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   -- ^ target
+     -> MVector (PrimState m) a   -- ^ source
+     -> 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
+
+-- | Compute the next (lexicographically) permutation of given vector in-place.
+--   Returns False when input is the last permtuation
+nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool
+{-# INLINE nextPermutation #-}
+nextPermutation = G.nextPermutation
+
+#define DEFINE_MUTABLE
+#include "unbox-tuple-instances"

third_party/bazel/rules_haskell/examples/vector/LICENSE

@@ -0,0 +1,30 @@
+Copyright (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.
+

third_party/bazel/rules_haskell/examples/vector/README.md

@@ -0,0 +1,6 @@
+The `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.

third_party/bazel/rules_haskell/examples/vector/Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs

@@ -0,0 +1,38 @@
+{-# 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)
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs

@@ -0,0 +1,42 @@
+module 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')

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs

@@ -0,0 +1,16 @@
+module 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)
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs

@@ -0,0 +1,21 @@
+module 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)
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs

@@ -0,0 +1,32 @@
+module 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)
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs

@@ -0,0 +1,15 @@
+module 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
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs

@@ -0,0 +1,21 @@
+module 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
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs

@@ -0,0 +1,16 @@
+module 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)
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/LICENSE

@@ -0,0 +1,30 @@
+Copyright (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.
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Main.hs

@@ -0,0 +1,46 @@
+module 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
+    
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs

@@ -0,0 +1,45 @@
+module 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
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs

@@ -0,0 +1,20 @@
+module 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
+
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs

@@ -0,0 +1,16 @@
+module 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
+

third_party/bazel/rules_haskell/examples/vector/benchmarks/vector-benchmarks.cabal

@@ -0,0 +1,37 @@
+Name:           vector-benchmarks
+Version:        0.10.9
+License:        BSD3
+License-File:   LICENSE
+Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>
+Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>
+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
+

third_party/bazel/rules_haskell/examples/vector/changelog

@@ -0,0 +1,75 @@
+Changes in version 0.12.0.1
+
+ * Make sure `length` can be inlined
+ * Include modules that test-suites depend on in other-modules
+
+Changes in version 0.12.0.0
+
+ * Documentation fixes/additions
+ * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq
+ * New instances for various vector types: Semigroup, MonadZip
+ * Made `Storable` vectors respect memory alignment
+ * Changed some macros to ConstraintKinds
+   - Dropped compatibility with old GHCs to support this
+ * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related
+   helper functions.
+ * Relax context for `Unbox (Complex a)`.
+
+Changes 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

third_party/bazel/rules_haskell/examples/vector/include/vector.h

@@ -0,0 +1,20 @@
+#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

third_party/bazel/rules_haskell/examples/vector/internal/GenUnboxTuple.hs

@@ -0,0 +1,239 @@
+{-# 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 (\c -> text ['_',c]) $ 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_initialize rec
+      = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty)
+
+    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)
+                      ,("basicInitialize",        gen_initialize)]
+
+    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)]

third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs

@@ -0,0 +1,27 @@
+module 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

third_party/bazel/rules_haskell/examples/vector/tests/LICENSE

@@ -0,0 +1,30 @@
+Copyright (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.
+

third_party/bazel/rules_haskell/examples/vector/tests/Main.hs

@@ -0,0 +1,15 @@
+module Main (main) where
+
+import qualified Tests.Vector
+import qualified Tests.Vector.UnitTests
+import qualified Tests.Bundle
+import qualified Tests.Move
+
+import Test.Framework (defaultMain)
+
+main :: IO ()
+main = defaultMain $ Tests.Bundle.tests
+                  ++ Tests.Vector.tests
+                  ++ Tests.Vector.UnitTests.tests
+                  ++ Tests.Move.tests
+

third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs

@@ -0,0 +1,163 @@
+module 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 ]
+

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs

@@ -0,0 +1,49 @@
+module Tests.Move (tests) where
+
+import Test.QuickCheck
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck.Property (Property(..))
+
+import Utilities ()
+
+import Control.Monad (replicateM)
+import Control.Monad.ST (runST)
+import Data.List (sort,permutations)
+
+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))
+
+checkPermutations :: Int -> Bool
+checkPermutations n = runST $ do
+    vec <- U.thaw (U.fromList [1..n])
+    res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList
+    return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]]
+
+testPermutations :: Bool
+testPermutations = all checkPermutations [1..7]
+
+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),
+     testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations]

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs

@@ -0,0 +1,706 @@
+{-# LANGUAGE ConstraintKinds #-}
+module Tests.Vector (tests) where
+
+import Boilerplater
+import Utilities as Util
+
+import Data.Functor.Identity
+import qualified Data.Traversable as T (Traversable(..))
+import Data.Foldable (Foldable(foldMap))
+
+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
+
+import Control.Monad.Zip
+
+type CommonContext  a v = (VanillaContext a, VectorContext a v)
+type VanillaContext a   = ( Eq a , Show a, Arbitrary a, CoArbitrary a
+                          , TestData a, Model a ~ a, EqTest a ~ Property)
+type VectorContext  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?
+
+#if !MIN_VERSION_base(4,7,0)
+instance Foldable ((,) a) where
+  foldMap f (_, b) = f b
+
+instance T.Traversable ((,) a) where
+  traverse f (a, b) = fmap ((,) a) $ f b
+#endif
+
+testSanity :: forall a v. (CommonContext 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. (CommonContext a v, VectorContext 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, 'prop_iterateNM,
+
+        -- Monadic initialisation (FIXME)
+        'prop_createT,
+        {- 'prop_replicateM, 'prop_generateM, 'prop_create, -}
+
+        -- Unfolding
+        'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM,
+        '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_uniq,
+        'prop_mapMaybe, 'prop_imapMaybe,
+        '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_iscanl, 'prop_iscanl',
+
+        'prop_prescanr, 'prop_prescanr',
+        'prop_postscanr, 'prop_postscanr',
+        'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',
+        'prop_iscanr, 'prop_iscanr'
+    ])
+  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_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a))
+              = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM
+    prop_createT :: P ((a, v a) -> (a, v a))
+    prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id
+
+    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_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe
+    prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe
+    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_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
+                = V.iscanl `eq` iscanl
+    prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
+               = V.iscanl' `eq` iscanl
+
+    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_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
+                = V.iscanr `eq` iscanr
+    prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)
+               = V.iscanr' `eq` iscanr
+    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_uniq :: P (v a -> v a)
+      = V.uniq `eq` (map head . group)
+    --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
+    limitUnfoldsM f (theirs, ours)
+        | ours >  0 = do r <- f theirs
+                         return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r
+        | otherwise = return 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_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)
+         = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
+    prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))
+         = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n))
+           `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n))
+    prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a))
+         = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM 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. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test]
+testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3
+                                        , 'prop_unzip, 'prop_unzip3
+                                        , 'prop_mzip, 'prop_munzip
+                                        ])
+  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
+    prop_mzip   :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a))
+        = mzip `eq` zip
+    prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a))
+        = munzip `eq` unzip
+
+testOrdFunctions :: forall a v. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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. (CommonContext 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 (Bool)"       (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)),
+        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)))
+
+    ]

third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Tests.Vector.UnitTests (tests) where
+
+import Control.Applicative as Applicative
+import qualified Data.Vector.Storable as Storable
+import Foreign.Ptr
+import Foreign.Storable
+import Text.Printf
+
+import Test.Framework
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, assertBool)
+
+newtype Aligned a = Aligned { getAligned :: a }
+
+instance (Storable a) => Storable (Aligned a) where
+  sizeOf _    = sizeOf (undefined :: a)
+  alignment _ = 128
+  peek ptr    = Aligned Applicative.<$> peek (castPtr ptr)
+  poke ptr    = poke (castPtr ptr) . getAligned
+
+checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion
+checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do
+  let ptr'  = ptrToWordPtr ptr
+      msg   = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr')
+      align :: WordPtr
+      align = fromIntegral $ alignment dummy
+  assertBool msg $ (ptr' `mod` align) == 0
+  where
+    dummy :: a
+    dummy = undefined
+
+tests :: [Test]
+tests =
+  [ testGroup "Data.Vector.Storable.Vector Alignment"
+      [ testCase "Aligned Double" $
+          checkAddressAlignment alignedDoubleVec
+      , testCase "Aligned Int" $
+          checkAddressAlignment alignedIntVec
+      ]
+  ]
+
+alignedDoubleVec :: Storable.Vector (Aligned Double)
+alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
+
+alignedIntVec :: Storable.Vector (Aligned Int)
+alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]

third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs

@@ -0,0 +1,350 @@
+{-# 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
+import Data.Maybe (catMaybes)
+
+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 b) => Arbitrary (Writer a b) where
+    arbitrary = do b <- arbitrary
+                   a <- arbitrary
+                   return $ writer (b,a)
+
+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, Eq b, TestData b, Monoid a) => TestData (Writer a b) where
+  type Model (Writer a b) = Writer (Model a) (Model b)
+  model = mapWriter model
+  unmodel = mapWriter unmodel
+
+  type EqTest (Writer a b) = Property
+  equal = (property .) . on (==) runWriter
+
+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
+
+mapMaybe :: (a -> Maybe b) -> [a] -> [b]
+mapMaybe f = catMaybes . map f
+
+imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b]
+imapMaybe f = catMaybes . withIndexFirst map f
+
+indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..]
+
+ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a
+ifoldl = indexedLeftFold foldl
+
+iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a]
+iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..]
+
+iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b]
+iscanr f z = scanr (uncurry f) z . zip [0..]
+
+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)
+
+iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a]
+iterateNM n f x
+    | n <= 0    = return []
+    | n == 1    = return [x]
+    | otherwise =  do x' <- f x
+                      xs <- iterateNM (n-1) f x'
+                      return (x : xs)
+
+unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a]
+unfoldrM step b0 = do
+    r <- step b0
+    case r of
+      Nothing    -> return []
+      Just (a,b) -> do as <- unfoldrM step b
+                       return (a : as)
+
+
+limitUnfolds f (theirs, ours)
+    | ours >= 0
+    , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
+    | otherwise                       = Nothing

third_party/bazel/rules_haskell/examples/vector/vector.cabal

@@ -0,0 +1,251 @@
+Name:           vector
+Version:        0.12.0.1
+x-revision: 2
+-- don't forget to update the changelog file!
+License:        BSD3
+License-File:   LICENSE
+Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>
+Maintainer:     Haskell Libraries Team <libraries@haskell.org>
+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.
+        .
+        * <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial>
+
+Tested-With:
+  GHC == 7.4.2,
+  GHC == 7.6.3,
+  GHC == 7.8.4,
+  GHC == 7.10.3,
+  GHC == 8.0.1
+
+Cabal-Version:  >=1.10
+Build-Type:     Simple
+
+Extra-Source-Files:
+      changelog
+      README.md
+      tests/LICENSE
+      tests/Setup.hs
+      tests/Main.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
+
+Flag Wall
+  Description: Enable all -Wall warnings
+  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.5 && < 4.12
+               , primitive >= 0.5.0.1 && < 0.7
+               , ghc-prim >= 0.2 && < 0.6
+               , deepseq >= 1.1 && < 1.5
+  if !impl(ghc > 8.0)
+    Build-Depends: semigroups >= 0.18 && < 0.19
+
+  Ghc-Options: -O2 -Wall
+
+  if !flag(Wall)
+    Ghc-Options: -fno-warn-orphans
+
+    if impl(ghc >= 8.0) && impl(ghc < 8.1)
+      Ghc-Options:   -Wno-redundant-constraints
+
+  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
+
+  other-modules: Boilerplater
+                 Tests.Bundle
+                 Tests.Move
+                 Tests.Vector
+                 Tests.Vector.UnitTests
+                 Utilities
+
+  hs-source-dirs: tests
+  Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
+                 random,
+                 QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
+                 test-framework-hunit, 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
+
+  if !flag(Wall)
+    Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures
+    if impl(ghc >= 8.0) && impl( ghc < 8.1)
+      Ghc-Options: -Wno-redundant-constraints
+
+
+test-suite vector-tests-O2
+  Default-Language: Haskell2010
+  type: exitcode-stdio-1.0
+  Main-Is:  Main.hs
+
+  other-modules: Boilerplater
+                 Tests.Bundle
+                 Tests.Move
+                 Tests.Vector
+                 Tests.Vector.UnitTests
+                 Utilities
+
+  hs-source-dirs: tests
+  Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
+                 random,
+                 QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
+                 test-framework-hunit, test-framework-quickcheck2,
+                 transformers >= 0.2.0.0
+
+  default-extensions: CPP,
+              ScopedTypeVariables,
+              PatternGuards,
+              MultiParamTypeClasses,
+              FlexibleContexts,
+              Rank2Types,
+              TypeSynonymInstances,
+              TypeFamilies,
+              TemplateHaskell
+
+  Ghc-Options: -O2 -Wall
+
+  if !flag(Wall)
+    Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures
+    if impl(ghc >= 8.0) && impl(ghc < 8.1)
+      Ghc-Options: -Wno-redundant-constraints
+