{-# LANGUAGE Trustworthy, MagicHash, MultiParamTypeClasses, FlexibleInstances #-}

{- |
    Module      :  SDP.Vector.Unboxed
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    @SDP.Vector.Unboxed@ provides 'Vector' - immutable strict unboxed vector.
    
    This module uses the Unbox and Unboxed classes. Looking at similar names
    and, in general, general purpose, they are fundamentally different:
    
    Despite similar names, classes are very different:
    * 'Unboxed' is a low-level interface that generalizes access to data.
    * 'Unbox' is a service class that combines Vector and MVector.
-}
module SDP.Vector.Unboxed
(
  -- * Exports
  module SDP.Indexed,
  module SDP.Unboxed,
  module SDP.Sort,
  module SDP.Scan,
  
  -- * Vector
  Unbox, Vector
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.IndexedM
import SDP.Indexed
import SDP.Unboxed
import SDP.Sort
import SDP.Scan

import SDP.ByteList.STUblist
import SDP.ByteList.IOUblist

import SDP.Prim.SBytes
import SDP.SortM.Tim

import Data.Vector.Unboxed ( Vector, Unbox )
import qualified Data.Vector.Unboxed as V

default ()

--------------------------------------------------------------------------------

{- Nullable, Scan and Estimate instances. -}

instance (Unbox e) => Nullable (Vector e)
  where
    isNull :: Vector e -> Bool
isNull = Vector e -> Bool
forall e. Unbox e => Vector e -> Bool
V.null
    lzero :: Vector e
lzero  = Vector e
forall e. Unbox e => Vector e
V.empty

instance (Unbox e) => Scan (Vector e) e

instance (Unbox e) => Estimate (Vector e)
  where
    <==> :: Compare (Vector e)
(<==>) = (Int -> Int -> Ordering) -> (Vector e -> Int) -> Compare (Vector e)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>=. :: Vector e -> Vector e -> Bool
(.>=.) = (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Vector e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<=. :: Vector e -> Vector e -> Bool
(.<=.) = (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Vector e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>. :: Vector e -> Vector e -> Bool
(.>.)  = (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Vector e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)  Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<. :: Vector e -> Vector e -> Bool
(.<.)  = (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Vector e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)  Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    
    <.=> :: Vector e -> Int -> Ordering
(<.=>) = Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) (Int -> Int -> Ordering)
-> (Vector e -> Int) -> Vector e -> Int -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>= :: Vector e -> Int -> Bool
(.>=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<= :: Vector e -> Int -> Bool
(.<=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .> :: Vector e -> Int -> Bool
(.>)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)   (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .< :: Vector e -> Int -> Bool
(.<)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)   (Int -> Int -> Bool)
-> (Vector e -> Int) -> Vector e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf

--------------------------------------------------------------------------------

{- Linear, Split and Bordered instances. -}

instance (Unbox e) => Linear (Vector e) e
  where
    single :: e -> Vector e
single = e -> Vector e
forall e. Unbox e => e -> Vector e
V.singleton
    toHead :: e -> Vector e -> Vector e
toHead = e -> Vector e -> Vector e
forall e. Unbox e => e -> Vector e -> Vector e
V.cons
    toLast :: Vector e -> e -> Vector e
toLast = Vector e -> e -> Vector e
forall e. Unbox e => Vector e -> e -> Vector e
V.snoc
    
    listL :: Vector e -> [e]
listL = Vector e -> [e]
forall e. Unbox e => Vector e -> [e]
V.toList
    force :: Vector e -> Vector e
force = Vector e -> Vector e
forall e. Unbox e => Vector e -> Vector e
V.force
    head :: Vector e -> e
head  = Vector e -> e
forall e. Unbox e => Vector e -> e
V.head
    tail :: Vector e -> Vector e
tail  = Vector e -> Vector e
forall e. Unbox e => Vector e -> Vector e
V.tail
    init :: Vector e -> Vector e
init  = Vector e -> Vector e
forall e. Unbox e => Vector e -> Vector e
V.init
    last :: Vector e -> e
last  = Vector e -> e
forall e. Unbox e => Vector e -> e
V.last
    nub :: Vector e -> Vector e
nub   = Vector e -> Vector e
forall e. (Unbox e, Eq e) => Vector e -> Vector e
V.uniq
    
    !^ :: Vector e -> Int -> e
(!^) = Vector e -> Int -> e
forall e. Unbox e => Vector e -> Int -> e
V.unsafeIndex
    ++ :: Vector e -> Vector e -> Vector e
(++) = Vector e -> Vector e -> Vector e
forall e. Unbox e => Vector e -> Vector e -> Vector e
(V.++)
    
    write :: Vector e -> Int -> e -> Vector e
write Vector e
es = (Vector e
es Vector e -> [(Int, e)] -> Vector e
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
V.//) ([(Int, e)] -> Vector e)
-> ((Int, e) -> [(Int, e)]) -> (Int, e) -> Vector e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> [(Int, e)]
forall l e. Linear l e => e -> l
single ((Int, e) -> Vector e)
-> (Int -> e -> (Int, e)) -> Int -> e -> Vector e
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (,)
    
    partitions :: f (e -> Bool) -> Vector e -> [Vector e]
partitions f (e -> Bool)
ps = ([e] -> Vector e) -> [[e]] -> [Vector e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Vector e
forall l e. Linear l e => [e] -> l
fromList ([[e]] -> [Vector e])
-> (Vector e -> [[e]]) -> Vector e -> [Vector e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (e -> Bool) -> [e] -> [[e]]
forall l e (f :: * -> *).
(Linear l e, Foldable f) =>
f (e -> Bool) -> l -> [l]
partitions f (e -> Bool)
ps ([e] -> [[e]]) -> (Vector e -> [e]) -> Vector e -> [[e]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> [e]
forall l e. Linear l e => l -> [e]
listL
    concatMap :: (a -> Vector e) -> f a -> Vector e
concatMap   a -> Vector e
f = [Vector e] -> Vector e
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat ([Vector e] -> Vector e) -> (f a -> [Vector e]) -> f a -> Vector e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Vector e] -> [Vector e]) -> [Vector e] -> f a -> [Vector e]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Vector e -> [Vector e] -> [Vector e])
-> (a -> Vector e) -> a -> [Vector e] -> [Vector e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector e
f) []
    
    fromListN :: Int -> [e] -> Vector e
fromListN = Int -> [e] -> Vector e
forall e. Unbox e => Int -> [e] -> Vector e
V.fromListN
    replicate :: Int -> e -> Vector e
replicate = Int -> e -> Vector e
forall e. Unbox e => Int -> e -> Vector e
V.replicate
    partition :: (e -> Bool) -> Vector e -> (Vector e, Vector e)
partition = (e -> Bool) -> Vector e -> (Vector e, Vector e)
forall e.
Unbox e =>
(e -> Bool) -> Vector e -> (Vector e, Vector e)
V.partition
    fromList :: [e] -> Vector e
fromList  = [e] -> Vector e
forall e. Unbox e => [e] -> Vector e
V.fromList
    reverse :: Vector e -> Vector e
reverse   = Vector e -> Vector e
forall e. Unbox e => Vector e -> Vector e
V.reverse
    
    concat :: f (Vector e) -> Vector e
concat = [Vector e] -> Vector e
forall a. Unbox a => [Vector a] -> Vector a
V.concat ([Vector e] -> Vector e)
-> (f (Vector e) -> [Vector e]) -> f (Vector e) -> Vector e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Vector e) -> [Vector e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    filter :: (e -> Bool) -> Vector e -> Vector e
filter = (e -> Bool) -> Vector e -> Vector e
forall e. Unbox e => (e -> Bool) -> Vector e -> Vector e
V.filter
    
    ofoldl :: (Int -> b -> e -> b) -> b -> Vector e -> b
ofoldl  = (b -> Int -> e -> b) -> b -> Vector e -> b
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl ((b -> Int -> e -> b) -> b -> Vector e -> b)
-> ((Int -> b -> e -> b) -> b -> Int -> e -> b)
-> (Int -> b -> e -> b)
-> b
-> Vector e
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> e -> b) -> b -> Int -> e -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
    ofoldr :: (Int -> e -> b -> b) -> b -> Vector e -> b
ofoldr  = (Int -> e -> b -> b) -> b -> Vector e -> b
forall a b. Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr
    o_foldl :: (b -> e -> b) -> b -> Vector e -> b
o_foldl = (b -> e -> b) -> b -> Vector e -> b
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
V.foldl
    o_foldr :: (e -> b -> b) -> b -> Vector e -> b
o_foldr = (e -> b -> b) -> b -> Vector e -> b
forall a b. Unbox a => (a -> b -> b) -> b -> Vector a -> b
V.foldr

instance (Unbox e) => Split (Vector e) e
  where
    take :: Int -> Vector e -> Vector e
take = Int -> Vector e -> Vector e
forall e. Unbox e => Int -> Vector e -> Vector e
V.take
    drop :: Int -> Vector e -> Vector e
drop = Int -> Vector e -> Vector e
forall e. Unbox e => Int -> Vector e -> Vector e
V.drop
    
    split :: Int -> Vector e -> (Vector e, Vector e)
split = Int -> Vector e -> (Vector e, Vector e)
forall e. Unbox e => Int -> Vector e -> (Vector e, Vector e)
V.splitAt
    
    takeWhile :: (e -> Bool) -> Vector e -> Vector e
takeWhile = (e -> Bool) -> Vector e -> Vector e
forall e. Unbox e => (e -> Bool) -> Vector e -> Vector e
V.takeWhile
    dropWhile :: (e -> Bool) -> Vector e -> Vector e
dropWhile = (e -> Bool) -> Vector e -> Vector e
forall e. Unbox e => (e -> Bool) -> Vector e -> Vector e
V.dropWhile
    
    spanl :: (e -> Bool) -> Vector e -> (Vector e, Vector e)
spanl  = (e -> Bool) -> Vector e -> (Vector e, Vector e)
forall e.
Unbox e =>
(e -> Bool) -> Vector e -> (Vector e, Vector e)
V.span
    breakl :: (e -> Bool) -> Vector e -> (Vector e, Vector e)
breakl = (e -> Bool) -> Vector e -> (Vector e, Vector e)
forall e.
Unbox e =>
(e -> Bool) -> Vector e -> (Vector e, Vector e)
V.break
    
    prefix :: (e -> Bool) -> Vector e -> Int
prefix e -> Bool
p = (e -> Int -> Int) -> Int -> Vector e -> Int
forall a b. Unbox a => (a -> b -> b) -> b -> Vector a -> b
V.foldr (\ e
e Int
c -> e -> Bool
p e
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0
    suffix :: (e -> Bool) -> Vector e -> Int
suffix e -> Bool
p = (Int -> e -> Int) -> Int -> Vector e -> Int
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
V.foldl (\ Int
c e
e -> e -> Bool
p e
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0

instance (Unbox e) => Bordered (Vector e) Int
  where
    lower :: Vector e -> Int
lower   Vector e
_ = Int
0
    upper :: Vector e -> Int
upper  Vector e
es = Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf Vector e
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    bounds :: Vector e -> (Int, Int)
bounds Vector e
es = (Int
0, Vector e -> Int
forall b i. Bordered b i => b -> Int
sizeOf Vector e
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    
    sizeOf :: Vector e -> Int
sizeOf = Vector e -> Int
forall e. Unbox e => Vector e -> Int
V.length

--------------------------------------------------------------------------------

{- Map, Indexed, IFold and Sort instances. -}

instance (Unboxed e, Unbox e) => Map (Vector e) Int e
  where
    toMap :: [(Int, e)] -> Vector e
toMap [(Int, e)]
ascs = [(Int, e)] -> Bool
forall e. Nullable e => e -> Bool
isNull [(Int, e)]
ascs Bool -> Vector e -> Vector e -> Vector e
forall a. Bool -> a -> a -> a
? Vector e
forall e. Nullable e => e
Z (Vector e -> Vector e) -> Vector e -> Vector e
forall a b. (a -> b) -> a -> b
$ [(Int, e)] -> (Int, Int)
forall a b. Ord a => [(a, b)] -> (a, a)
ascsBounds [(Int, e)]
ascs (Int, Int) -> [(Int, e)] -> Vector e
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
`assoc` [(Int, e)]
ascs
    
    toMap' :: e -> [(Int, e)] -> Vector e
toMap' e
e [(Int, e)]
ascs = [(Int, e)] -> Bool
forall e. Nullable e => e -> Bool
isNull [(Int, e)]
ascs Bool -> Vector e -> Vector e -> Vector e
forall a. Bool -> a -> a -> a
? Vector e
forall e. Nullable e => e
Z (Vector e -> Vector e) -> Vector e -> Vector e
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> e -> [(Int, e)] -> Vector e
forall v i e. Indexed v i e => (i, i) -> e -> [(i, e)] -> v
assoc' ([(Int, e)] -> (Int, Int)
forall a b. Ord a => [(a, b)] -> (a, a)
ascsBounds [(Int, e)]
ascs) e
e [(Int, e)]
ascs
    
    .! :: Vector e -> Int -> e
(.!) = Vector e -> Int -> e
forall e. Unbox e => Vector e -> Int -> e
V.unsafeIndex
    !? :: Vector e -> Int -> Maybe e
(!?) = Vector e -> Int -> Maybe e
forall a. Unbox a => Vector a -> Int -> Maybe a
(V.!?)
    
    Vector e
Z  // :: Vector e -> [(Int, e)] -> Vector e
// [(Int, e)]
ascs = [(Int, e)] -> Vector e
forall map key e. Map map key e => [(key, e)] -> map
toMap [(Int, e)]
ascs
    Vector e
vs // [(Int, e)]
ascs = Vector e
vs Vector e -> [(Int, e)] -> Vector e
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
V.// [(Int, e)]
ascs
    
    .$ :: (e -> Bool) -> Vector e -> Maybe Int
(.$) = (e -> Bool) -> Vector e -> Maybe Int
forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
V.findIndex
    *$ :: (e -> Bool) -> Vector e -> [Int]
(*$) = Vector Int -> [Int]
forall l e. Linear l e => l -> [e]
listL (Vector Int -> [Int])
-> ((e -> Bool) -> Vector e -> Vector Int)
-> (e -> Bool)
-> Vector e
-> [Int]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (e -> Bool) -> Vector e -> Vector Int
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector Int
V.findIndices
    
    kfoldl :: (Int -> b -> e -> b) -> b -> Vector e -> b
kfoldl = (Int -> b -> e -> b) -> b -> Vector e -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl
    kfoldr :: (Int -> e -> b -> b) -> b -> Vector e -> b
kfoldr = (Int -> e -> b -> b) -> b -> Vector e -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr

instance (Unboxed e, Unbox e) => Indexed (Vector e) Int e
  where
    assoc :: (Int, Int) -> [(Int, e)] -> Vector e
assoc (Int, Int)
bnds [(Int, e)]
ascs = (forall s. ST s (Vector e)) -> Vector e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector e)) -> Vector e)
-> (forall s. ST s (Vector e)) -> Vector e
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [(Int, e)] -> ST s (STBytes# s e)
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> [(i, e)] -> m v
fromAssocs (Int, Int)
bnds [(Int, e)]
ascs ST s (STBytes# s e)
-> (STBytes# s e -> ST s (Vector e)) -> ST s (Vector e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s e -> ST s (Vector e)
forall e s. (Unboxed e, Unbox e) => STBytes# s e -> ST s (Vector e)
done
    
    assoc' :: (Int, Int) -> e -> [(Int, e)] -> Vector e
assoc' (Int, Int)
bnds e
e [(Int, e)]
ascs = (forall s. ST s (Vector e)) -> Vector e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector e)) -> Vector e)
-> (forall s. ST s (Vector e)) -> Vector e
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> e -> [(Int, e)] -> ST s (STBytes# s e)
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> e -> [(i, e)] -> m v
fromAssocs' (Int, Int)
bnds e
e [(Int, e)]
ascs ST s (STBytes# s e)
-> (STBytes# s e -> ST s (Vector e)) -> ST s (Vector e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s e -> ST s (Vector e)
forall e s. (Unboxed e, Unbox e) => STBytes# s e -> ST s (Vector e)
done
    
    fromIndexed :: m -> Vector e
fromIndexed m
es = Int -> (Int, Int)
forall i. Index i => Int -> (i, i)
defaultBounds (m -> Int
forall b i. Bordered b i => b -> Int
sizeOf m
es) (Int, Int) -> [(Int, e)] -> Vector e
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
`assoc`
      [ (m -> j -> Int
forall b i. Bordered b i => b -> i -> Int
offsetOf m
es j
i, e
e) | (j
i, e
e) <- m -> [(j, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs m
es, m -> j -> Bool
forall b i. Bordered b i => b -> i -> Bool
indexIn m
es j
i ]

instance (Unboxed e, Unbox e) => Sort (Vector e) e
  where
    sortBy :: Compare e -> Vector e -> Vector e
sortBy Compare e
cmp Vector e
es = (forall s. ST s (Vector e)) -> Vector e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector e)) -> Vector e)
-> (forall s. ST s (Vector e)) -> Vector e
forall a b. (a -> b) -> a -> b
$ do STBytes# s e
es' <- Vector e -> ST s (STBytes# s e)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw Vector e
es; Compare e -> STBytes# s e -> ST s ()
forall (m :: * -> *) v e i.
(LinearM m v e, BorderedM m v i) =>
Compare e -> v -> m ()
timSortBy Compare e
cmp STBytes# s e
es'; STBytes# s e -> ST s (Vector e)
forall e s. (Unboxed e, Unbox e) => STBytes# s e -> ST s (Vector e)
done STBytes# s e
es'
    
    sortedBy :: (e -> e -> Bool) -> Vector e -> Bool
sortedBy e -> e -> Bool
f = (e -> e -> Bool) -> [e] -> Bool
forall s e. Sort s e => (e -> e -> Bool) -> s -> Bool
sortedBy e -> e -> Bool
f ([e] -> Bool) -> (Vector e -> [e]) -> Vector e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> [e]
forall l e. Linear l e => l -> [e]
listL

--------------------------------------------------------------------------------

{- Thaw and Freeze instances. -}

instance (Unboxed e, Unbox e) => Thaw (ST s) (Vector e) (STBytes# s e) where thaw :: Vector e -> ST s (STBytes# s e)
thaw = Vector e -> ST s (STBytes# s e)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'
instance (Unboxed e, Unbox e) => Thaw (ST s) (Vector e) (STUblist s e) where thaw :: Vector e -> ST s (STUblist s e)
thaw = Vector e -> ST s (STUblist s e)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'

instance (MonadIO io, Unboxed e, Unbox e) => Thaw io (Vector e) (MIOBytes# io e) where thaw :: Vector e -> io (MIOBytes# io e)
thaw = Vector e -> io (MIOBytes# io e)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'
instance (MonadIO io, Unboxed e, Unbox e) => Thaw io (Vector e) (MIOUblist io e) where thaw :: Vector e -> io (MIOUblist io e)
thaw = Vector e -> io (MIOUblist io e)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'

instance (Unboxed e, Unbox e) => Freeze (ST s) (STBytes# s e) (Vector e) where freeze :: STBytes# s e -> ST s (Vector e)
freeze = ([e] -> Vector e) -> ST s [e] -> ST s (Vector e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Vector e
forall l e. Linear l e => [e] -> l
fromList (ST s [e] -> ST s (Vector e))
-> (STBytes# s e -> ST s [e]) -> STBytes# s e -> ST s (Vector e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STBytes# s e -> ST s [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
instance (Unboxed e, Unbox e) => Freeze (ST s) (STUblist s e) (Vector e) where freeze :: STUblist s e -> ST s (Vector e)
freeze = ([e] -> Vector e) -> ST s [e] -> ST s (Vector e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Vector e
forall l e. Linear l e => [e] -> l
fromList (ST s [e] -> ST s (Vector e))
-> (STUblist s e -> ST s [e]) -> STUblist s e -> ST s (Vector e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STUblist s e -> ST s [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft

instance (MonadIO io, Unboxed e, Unbox e) => Freeze io (MIOBytes# io e) (Vector e) where freeze :: MIOBytes# io e -> io (Vector e)
freeze = ([e] -> Vector e) -> io [e] -> io (Vector e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Vector e
forall l e. Linear l e => [e] -> l
fromList (io [e] -> io (Vector e))
-> (MIOBytes# io e -> io [e]) -> MIOBytes# io e -> io (Vector e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIOBytes# io e -> io [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
instance (MonadIO io, Unboxed e, Unbox e) => Freeze io (MIOUblist io e) (Vector e) where freeze :: MIOUblist io e -> io (Vector e)
freeze = ([e] -> Vector e) -> io [e] -> io (Vector e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Vector e
forall l e. Linear l e => [e] -> l
fromList (io [e] -> io (Vector e))
-> (MIOUblist io e -> io [e]) -> MIOUblist io e -> io (Vector e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIOUblist io e -> io [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft

--------------------------------------------------------------------------------

ascsBounds :: (Ord a) => [(a, b)] -> (a, a)
ascsBounds :: [(a, b)] -> (a, a)
ascsBounds =  \ ((a
x, b
_) : [(a, b)]
xs) -> ((a, b) -> (a, a) -> (a, a)) -> (a, a) -> [(a, b)] -> (a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (a
e, b
_) (a
mn, a
mx) -> (a -> a -> a
forall a. Ord a => a -> a -> a
min a
mn a
e, a -> a -> a
forall a. Ord a => a -> a -> a
max a
mx a
e)) (a
x, a
x) [(a, b)]
xs

done :: (Unboxed e, Unbox e) => STBytes# s e -> ST s (Vector e)
done :: STBytes# s e -> ST s (Vector e)
done =  STBytes# s e -> ST s (Vector e)
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze