diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs')
-rw-r--r-- | third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs new file mode 100644 index 000000000000..ce931eec9b41 --- /dev/null +++ b/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 + |