{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MultiParamTypeClasses,
             TypeFamilies #-}
module Data.SearchEngine.DocIdSet (
    DocId(DocId),
    DocIdSet(..),
    null,
    size,
    empty,
    singleton,
    fromList,
    toList,
    insert,
    delete,
    member,
    union,
    unions,
    intersection,
    invariant,
  ) where

import Data.Word
import qualified Data.Vector.Unboxed         as Vec
import qualified Data.Vector.Unboxed.Mutable as MVec
import qualified Data.Vector.Generic         as GVec
import qualified Data.Vector.Generic.Mutable as GMVec
import Control.Monad.ST
import Control.Monad (liftM)
import qualified Data.Set as Set
import qualified Data.List as List
import Data.Function (on)

import Prelude hiding (null)


newtype DocId = DocId { DocId -> Word32
unDocId :: Word32 }
  deriving (DocId -> DocId -> Bool
(DocId -> DocId -> Bool) -> (DocId -> DocId -> Bool) -> Eq DocId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocId -> DocId -> Bool
== :: DocId -> DocId -> Bool
$c/= :: DocId -> DocId -> Bool
/= :: DocId -> DocId -> Bool
Eq, Eq DocId
Eq DocId =>
(DocId -> DocId -> Ordering)
-> (DocId -> DocId -> Bool)
-> (DocId -> DocId -> Bool)
-> (DocId -> DocId -> Bool)
-> (DocId -> DocId -> Bool)
-> (DocId -> DocId -> DocId)
-> (DocId -> DocId -> DocId)
-> Ord DocId
DocId -> DocId -> Bool
DocId -> DocId -> Ordering
DocId -> DocId -> DocId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DocId -> DocId -> Ordering
compare :: DocId -> DocId -> Ordering
$c< :: DocId -> DocId -> Bool
< :: DocId -> DocId -> Bool
$c<= :: DocId -> DocId -> Bool
<= :: DocId -> DocId -> Bool
$c> :: DocId -> DocId -> Bool
> :: DocId -> DocId -> Bool
$c>= :: DocId -> DocId -> Bool
>= :: DocId -> DocId -> Bool
$cmax :: DocId -> DocId -> DocId
max :: DocId -> DocId -> DocId
$cmin :: DocId -> DocId -> DocId
min :: DocId -> DocId -> DocId
Ord, Int -> DocId -> ShowS
[DocId] -> ShowS
DocId -> String
(Int -> DocId -> ShowS)
-> (DocId -> String) -> ([DocId] -> ShowS) -> Show DocId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocId -> ShowS
showsPrec :: Int -> DocId -> ShowS
$cshow :: DocId -> String
show :: DocId -> String
$cshowList :: [DocId] -> ShowS
showList :: [DocId] -> ShowS
Show, Int -> DocId
DocId -> Int
DocId -> [DocId]
DocId -> DocId
DocId -> DocId -> [DocId]
DocId -> DocId -> DocId -> [DocId]
(DocId -> DocId)
-> (DocId -> DocId)
-> (Int -> DocId)
-> (DocId -> Int)
-> (DocId -> [DocId])
-> (DocId -> DocId -> [DocId])
-> (DocId -> DocId -> [DocId])
-> (DocId -> DocId -> DocId -> [DocId])
-> Enum DocId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DocId -> DocId
succ :: DocId -> DocId
$cpred :: DocId -> DocId
pred :: DocId -> DocId
$ctoEnum :: Int -> DocId
toEnum :: Int -> DocId
$cfromEnum :: DocId -> Int
fromEnum :: DocId -> Int
$cenumFrom :: DocId -> [DocId]
enumFrom :: DocId -> [DocId]
$cenumFromThen :: DocId -> DocId -> [DocId]
enumFromThen :: DocId -> DocId -> [DocId]
$cenumFromTo :: DocId -> DocId -> [DocId]
enumFromTo :: DocId -> DocId -> [DocId]
$cenumFromThenTo :: DocId -> DocId -> DocId -> [DocId]
enumFromThenTo :: DocId -> DocId -> DocId -> [DocId]
Enum, DocId
DocId -> DocId -> Bounded DocId
forall a. a -> a -> Bounded a
$cminBound :: DocId
minBound :: DocId
$cmaxBound :: DocId
maxBound :: DocId
Bounded)

newtype DocIdSet = DocIdSet (Vec.Vector DocId)
  deriving (DocIdSet -> DocIdSet -> Bool
(DocIdSet -> DocIdSet -> Bool)
-> (DocIdSet -> DocIdSet -> Bool) -> Eq DocIdSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocIdSet -> DocIdSet -> Bool
== :: DocIdSet -> DocIdSet -> Bool
$c/= :: DocIdSet -> DocIdSet -> Bool
/= :: DocIdSet -> DocIdSet -> Bool
Eq, Int -> DocIdSet -> ShowS
[DocIdSet] -> ShowS
DocIdSet -> String
(Int -> DocIdSet -> ShowS)
-> (DocIdSet -> String) -> ([DocIdSet] -> ShowS) -> Show DocIdSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocIdSet -> ShowS
showsPrec :: Int -> DocIdSet -> ShowS
$cshow :: DocIdSet -> String
show :: DocIdSet -> String
$cshowList :: [DocIdSet] -> ShowS
showList :: [DocIdSet] -> ShowS
Show)

-- represented as a sorted sequence of ids
invariant :: DocIdSet -> Bool
invariant :: DocIdSet -> Bool
invariant (DocIdSet Vector DocId
vec) =
    [DocId] -> Bool
forall {a}. Ord a => [a] -> Bool
strictlyAscending (Vector DocId -> [DocId]
forall a. Unbox a => Vector a -> [a]
Vec.toList Vector DocId
vec)
  where
    strictlyAscending :: [a] -> Bool
strictlyAscending (a
a:xs :: [a]
xs@(a
b:[a]
_)) = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b Bool -> Bool -> Bool
&& [a] -> Bool
strictlyAscending [a]
xs
    strictlyAscending [a]
_  = Bool
True


size :: DocIdSet -> Int
size :: DocIdSet -> Int
size (DocIdSet Vector DocId
vec) = Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
vec

null :: DocIdSet -> Bool
null :: DocIdSet -> Bool
null (DocIdSet Vector DocId
vec) = Vector DocId -> Bool
forall a. Unbox a => Vector a -> Bool
Vec.null Vector DocId
vec

empty :: DocIdSet
empty :: DocIdSet
empty = Vector DocId -> DocIdSet
DocIdSet Vector DocId
forall a. Unbox a => Vector a
Vec.empty

singleton :: DocId -> DocIdSet
singleton :: DocId -> DocIdSet
singleton = Vector DocId -> DocIdSet
DocIdSet (Vector DocId -> DocIdSet)
-> (DocId -> Vector DocId) -> DocId -> DocIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocId -> Vector DocId
forall a. Unbox a => a -> Vector a
Vec.singleton

fromList :: [DocId] -> DocIdSet
fromList :: [DocId] -> DocIdSet
fromList = Vector DocId -> DocIdSet
DocIdSet (Vector DocId -> DocIdSet)
-> ([DocId] -> Vector DocId) -> [DocId] -> DocIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocId] -> Vector DocId
forall a. Unbox a => [a] -> Vector a
Vec.fromList ([DocId] -> Vector DocId)
-> ([DocId] -> [DocId]) -> [DocId] -> Vector DocId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DocId -> [DocId]
forall a. Set a -> [a]
Set.toAscList (Set DocId -> [DocId])
-> ([DocId] -> Set DocId) -> [DocId] -> [DocId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocId] -> Set DocId
forall a. Ord a => [a] -> Set a
Set.fromList

toList ::  DocIdSet -> [DocId]
toList :: DocIdSet -> [DocId]
toList (DocIdSet Vector DocId
vec) = Vector DocId -> [DocId]
forall a. Unbox a => Vector a -> [a]
Vec.toList Vector DocId
vec

insert :: DocId -> DocIdSet -> DocIdSet
insert :: DocId -> DocIdSet -> DocIdSet
insert DocId
x (DocIdSet Vector DocId
vec) =
    case Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec Int
0 (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) DocId
x of
      (Int
_, Bool
True)  -> Vector DocId -> DocIdSet
DocIdSet Vector DocId
vec
      (Int
i, Bool
False) -> case Int -> Vector DocId -> (Vector DocId, Vector DocId)
forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
Vec.splitAt Int
i Vector DocId
vec of
                      (Vector DocId
before, Vector DocId
after) ->
                        Vector DocId -> DocIdSet
DocIdSet ([Vector DocId] -> Vector DocId
forall a. Unbox a => [Vector a] -> Vector a
Vec.concat [Vector DocId
before, DocId -> Vector DocId
forall a. Unbox a => a -> Vector a
Vec.singleton DocId
x, Vector DocId
after])

delete :: DocId -> DocIdSet -> DocIdSet
delete :: DocId -> DocIdSet -> DocIdSet
delete DocId
x (DocIdSet Vector DocId
vec) =
    case Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec Int
0 (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) DocId
x of
      (Int
_, Bool
False) -> Vector DocId -> DocIdSet
DocIdSet Vector DocId
vec
      (Int
i, Bool
True)  -> case Int -> Vector DocId -> (Vector DocId, Vector DocId)
forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
Vec.splitAt Int
i Vector DocId
vec of
                      (Vector DocId
before, Vector DocId
after) ->
                        Vector DocId -> DocIdSet
DocIdSet (Vector DocId
before Vector DocId -> Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a -> Vector a
Vec.++ Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
after)

member :: DocId -> DocIdSet -> Bool
member :: DocId -> DocIdSet -> Bool
member DocId
x (DocIdSet Vector DocId
vec) = (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd (Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec Int
0 (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) DocId
x)

binarySearch :: Vec.Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch :: Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec !Int
a !Int
b !DocId
key
  | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
b     = (Int
a, Bool
False)
  | Bool
otherwise =
    let mid :: Int
mid = (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
     in case DocId -> DocId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DocId
key (Vector DocId
vec Vector DocId -> Int -> DocId
forall a. Unbox a => Vector a -> Int -> a
Vec.! Int
mid) of
          Ordering
LT -> Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec Int
a (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) DocId
key
          Ordering
EQ -> (Int
mid, Bool
True)
          Ordering
GT -> Vector DocId -> Int -> Int -> DocId -> (Int, Bool)
binarySearch Vector DocId
vec (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
b DocId
key

unions :: [DocIdSet] -> DocIdSet
unions :: [DocIdSet] -> DocIdSet
unions = (DocIdSet -> DocIdSet -> DocIdSet)
-> DocIdSet -> [DocIdSet] -> DocIdSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' DocIdSet -> DocIdSet -> DocIdSet
union DocIdSet
empty
         -- a bit more effecient if we merge small ones first
       ([DocIdSet] -> DocIdSet)
-> ([DocIdSet] -> [DocIdSet]) -> [DocIdSet] -> DocIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocIdSet -> DocIdSet -> Ordering) -> [DocIdSet] -> [DocIdSet]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (DocIdSet -> Int) -> DocIdSet -> DocIdSet -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DocIdSet -> Int
size)

union :: DocIdSet -> DocIdSet -> DocIdSet
union :: DocIdSet -> DocIdSet -> DocIdSet
union DocIdSet
x DocIdSet
y | DocIdSet -> Bool
null DocIdSet
x = DocIdSet
y
          | DocIdSet -> Bool
null DocIdSet
y = DocIdSet
x
union (DocIdSet Vector DocId
xs) (DocIdSet Vector DocId
ys) =
    Vector DocId -> DocIdSet
DocIdSet ((forall s. ST s (MVector s DocId)) -> Vector DocId
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
Vec.create (Int -> ST s (MVector (PrimState (ST s)) DocId)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MVec.new Int
sizeBound ST s (MVector s DocId)
-> (MVector s DocId -> ST s (MVector s DocId))
-> ST s (MVector s DocId)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
forall s.
Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
writeMergedUnion Vector DocId
xs Vector DocId
ys))
  where
    sizeBound :: Int
sizeBound = Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
ys

writeMergedUnion :: Vec.Vector DocId -> Vec.Vector DocId ->
                    MVec.MVector s DocId -> ST s (MVec.MVector s DocId)
writeMergedUnion :: forall s.
Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
writeMergedUnion Vector DocId
xs0 Vector DocId
ys0 !MVector s DocId
out = do
    Int
i <- Vector DocId -> Vector DocId -> Int -> ST s Int
go Vector DocId
xs0 Vector DocId
ys0 Int
0
    MVector s DocId -> ST s (MVector s DocId)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s DocId -> ST s (MVector s DocId))
-> MVector s DocId -> ST s (MVector s DocId)
forall a b. (a -> b) -> a -> b
$! Int -> MVector s DocId -> MVector s DocId
forall a s. Unbox a => Int -> MVector s a -> MVector s a
MVec.take Int
i MVector s DocId
out
  where
    go :: Vector DocId -> Vector DocId -> Int -> ST s Int
go !Vector DocId
xs !Vector DocId
ys !Int
i
      | Vector DocId -> Bool
forall a. Unbox a => Vector a -> Bool
Vec.null Vector DocId
xs = do MVector (PrimState (ST s)) DocId -> Vector DocId -> ST s ()
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
Vec.copy (Int -> Int -> MVector s DocId -> MVector s DocId
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MVec.slice Int
i (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
ys) MVector s DocId
out) Vector DocId
ys
                         Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
ys)
      | Vector DocId -> Bool
forall a. Unbox a => Vector a -> Bool
Vec.null Vector DocId
ys = do MVector (PrimState (ST s)) DocId -> Vector DocId -> ST s ()
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
Vec.copy (Int -> Int -> MVector s DocId -> MVector s DocId
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MVec.slice Int
i (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
xs) MVector s DocId
out) Vector DocId
xs
                         Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
xs)
      | Bool
otherwise   = let x :: DocId
x = Vector DocId -> DocId
forall a. Unbox a => Vector a -> a
Vec.head Vector DocId
xs; y :: DocId
y = Vector DocId -> DocId
forall a. Unbox a => Vector a -> a
Vec.head Vector DocId
ys
                      in case DocId -> DocId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DocId
x DocId
y of
                          Ordering
GT -> do MVector (PrimState (ST s)) DocId -> Int -> DocId -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MVec.write MVector s DocId
MVector (PrimState (ST s)) DocId
out Int
i DocId
y
                                   Vector DocId -> Vector DocId -> Int -> ST s Int
go           Vector DocId
xs  (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
ys) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                          Ordering
EQ -> do MVector (PrimState (ST s)) DocId -> Int -> DocId -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MVec.write MVector s DocId
MVector (PrimState (ST s)) DocId
out Int
i DocId
x
                                   Vector DocId -> Vector DocId -> Int -> ST s Int
go (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
xs) (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
ys) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                          Ordering
LT -> do MVector (PrimState (ST s)) DocId -> Int -> DocId -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MVec.write MVector s DocId
MVector (PrimState (ST s)) DocId
out Int
i DocId
x
                                   Vector DocId -> Vector DocId -> Int -> ST s Int
go (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
xs)           Vector DocId
ys  (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

intersection :: DocIdSet -> DocIdSet -> DocIdSet
intersection :: DocIdSet -> DocIdSet -> DocIdSet
intersection DocIdSet
x DocIdSet
y | DocIdSet -> Bool
null DocIdSet
x = DocIdSet
empty
                 | DocIdSet -> Bool
null DocIdSet
y = DocIdSet
empty
intersection (DocIdSet Vector DocId
xs) (DocIdSet Vector DocId
ys) =
    Vector DocId -> DocIdSet
DocIdSet ((forall s. ST s (MVector s DocId)) -> Vector DocId
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
Vec.create (Int -> ST s (MVector (PrimState (ST s)) DocId)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MVec.new Int
sizeBound ST s (MVector s DocId)
-> (MVector s DocId -> ST s (MVector s DocId))
-> ST s (MVector s DocId)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
forall s.
Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
writeMergedIntersection Vector DocId
xs Vector DocId
ys))
  where
    sizeBound :: Int
sizeBound = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
xs) (Vector DocId -> Int
forall a. Unbox a => Vector a -> Int
Vec.length Vector DocId
ys)

writeMergedIntersection :: Vec.Vector DocId -> Vec.Vector DocId ->
                           MVec.MVector s DocId -> ST s (MVec.MVector s DocId)
writeMergedIntersection :: forall s.
Vector DocId
-> Vector DocId -> MVector s DocId -> ST s (MVector s DocId)
writeMergedIntersection Vector DocId
xs0 Vector DocId
ys0 !MVector s DocId
out = do
    Int
i <- Vector DocId -> Vector DocId -> Int -> ST s Int
go Vector DocId
xs0 Vector DocId
ys0 Int
0
    MVector s DocId -> ST s (MVector s DocId)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s DocId -> ST s (MVector s DocId))
-> MVector s DocId -> ST s (MVector s DocId)
forall a b. (a -> b) -> a -> b
$! Int -> MVector s DocId -> MVector s DocId
forall a s. Unbox a => Int -> MVector s a -> MVector s a
MVec.take Int
i MVector s DocId
out
  where
    go :: Vector DocId -> Vector DocId -> Int -> ST s Int
go !Vector DocId
xs !Vector DocId
ys !Int
i
      | Vector DocId -> Bool
forall a. Unbox a => Vector a -> Bool
Vec.null Vector DocId
xs = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
      | Vector DocId -> Bool
forall a. Unbox a => Vector a -> Bool
Vec.null Vector DocId
ys = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
      | Bool
otherwise   = let x :: DocId
x = Vector DocId -> DocId
forall a. Unbox a => Vector a -> a
Vec.head Vector DocId
xs; y :: DocId
y = Vector DocId -> DocId
forall a. Unbox a => Vector a -> a
Vec.head Vector DocId
ys
                      in case DocId -> DocId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DocId
x DocId
y of
                          Ordering
GT ->    Vector DocId -> Vector DocId -> Int -> ST s Int
go           Vector DocId
xs  (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
ys)  Int
i
                          Ordering
EQ -> do MVector (PrimState (ST s)) DocId -> Int -> DocId -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MVec.write MVector s DocId
MVector (PrimState (ST s)) DocId
out Int
i DocId
x
                                   Vector DocId -> Vector DocId -> Int -> ST s Int
go (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
xs) (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
ys) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                          Ordering
LT ->    Vector DocId -> Vector DocId -> Int -> ST s Int
go (Vector DocId -> Vector DocId
forall a. Unbox a => Vector a -> Vector a
Vec.tail Vector DocId
xs)           Vector DocId
ys   Int
i

------------------------------------------------------------------------------
-- verbose Unbox instances
--

instance MVec.Unbox DocId

newtype instance MVec.MVector s DocId = MV_DocId (MVec.MVector s Word32)

instance GMVec.MVector MVec.MVector DocId where
    basicLength :: forall s. MVector s DocId -> Int
basicLength          (MV_DocId MVector s Word32
v) = MVector s Word32 -> Int
forall s. MVector s Word32 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GMVec.basicLength MVector s Word32
v
    basicUnsafeSlice :: forall s. Int -> Int -> MVector s DocId -> MVector s DocId
basicUnsafeSlice Int
i Int
l (MV_DocId MVector s Word32
v) = MVector s Word32 -> MVector s DocId
forall s. MVector s Word32 -> MVector s DocId
MV_DocId (Int -> Int -> MVector s Word32 -> MVector s Word32
forall s. Int -> Int -> MVector s Word32 -> MVector s Word32
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GMVec.basicUnsafeSlice Int
i Int
l MVector s Word32
v)
    basicUnsafeNew :: forall s. Int -> ST s (MVector s DocId)
basicUnsafeNew     Int
l              = MVector s Word32 -> MVector s DocId
forall s. MVector s Word32 -> MVector s DocId
MV_DocId (MVector s Word32 -> MVector s DocId)
-> ST s (MVector s Word32) -> ST s (MVector s DocId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s Word32)
forall s. Int -> ST s (MVector s Word32)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GMVec.basicUnsafeNew Int
l
    basicInitialize :: forall s. MVector s DocId -> ST s ()
basicInitialize      (MV_DocId MVector s Word32
v) = MVector s Word32 -> ST s ()
forall s. MVector s Word32 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GMVec.basicInitialize MVector s Word32
v
    basicUnsafeReplicate :: forall s. Int -> DocId -> ST s (MVector s DocId)
basicUnsafeReplicate Int
l DocId
x          = MVector s Word32 -> MVector s DocId
forall s. MVector s Word32 -> MVector s DocId
MV_DocId (MVector s Word32 -> MVector s DocId)
-> ST s (MVector s Word32) -> ST s (MVector s DocId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> Word32 -> ST s (MVector s Word32)
forall s. Int -> Word32 -> ST s (MVector s Word32)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
GMVec.basicUnsafeReplicate Int
l (DocId -> Word32
unDocId DocId
x)
    basicUnsafeRead :: forall s. MVector s DocId -> Int -> ST s DocId
basicUnsafeRead  (MV_DocId MVector s Word32
v) Int
i   = Word32 -> DocId
DocId (Word32 -> DocId) -> ST s Word32 -> ST s DocId
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM`    MVector s Word32 -> Int -> ST s Word32
forall s. MVector s Word32 -> Int -> ST s Word32
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GMVec.basicUnsafeRead MVector s Word32
v Int
i
    basicUnsafeWrite :: forall s. MVector s DocId -> Int -> DocId -> ST s ()
basicUnsafeWrite (MV_DocId MVector s Word32
v) Int
i DocId
x = MVector s Word32 -> Int -> Word32 -> ST s ()
forall s. MVector s Word32 -> Int -> Word32 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GMVec.basicUnsafeWrite MVector s Word32
v Int
i (DocId -> Word32
unDocId DocId
x)
    basicClear :: forall s. MVector s DocId -> ST s ()
basicClear       (MV_DocId MVector s Word32
v)     = MVector s Word32 -> ST s ()
forall s. MVector s Word32 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GMVec.basicClear MVector s Word32
v
    basicSet :: forall s. MVector s DocId -> DocId -> ST s ()
basicSet         (MV_DocId MVector s Word32
v) DocId
x   = MVector s Word32 -> Word32 -> ST s ()
forall s. MVector s Word32 -> Word32 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
GMVec.basicSet MVector s Word32
v (DocId -> Word32
unDocId DocId
x)
    basicUnsafeGrow :: forall s. MVector s DocId -> Int -> ST s (MVector s DocId)
basicUnsafeGrow  (MV_DocId MVector s Word32
v) Int
l   = MVector s Word32 -> MVector s DocId
forall s. MVector s Word32 -> MVector s DocId
MV_DocId (MVector s Word32 -> MVector s DocId)
-> ST s (MVector s Word32) -> ST s (MVector s DocId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s Word32 -> Int -> ST s (MVector s Word32)
forall s. MVector s Word32 -> Int -> ST s (MVector s Word32)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GMVec.basicUnsafeGrow MVector s Word32
v Int
l
    basicUnsafeCopy :: forall s. MVector s DocId -> MVector s DocId -> ST s ()
basicUnsafeCopy  (MV_DocId MVector s Word32
v) (MV_DocId MVector s Word32
v') = MVector s Word32 -> MVector s Word32 -> ST s ()
forall s. MVector s Word32 -> MVector s Word32 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GMVec.basicUnsafeCopy MVector s Word32
v MVector s Word32
v'
    basicUnsafeMove :: forall s. MVector s DocId -> MVector s DocId -> ST s ()
basicUnsafeMove  (MV_DocId MVector s Word32
v) (MV_DocId MVector s Word32
v') = MVector s Word32 -> MVector s Word32 -> ST s ()
forall s. MVector s Word32 -> MVector s Word32 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GMVec.basicUnsafeMove MVector s Word32
v MVector s Word32
v'
    basicOverlaps :: forall s. MVector s DocId -> MVector s DocId -> Bool
basicOverlaps    (MV_DocId MVector s Word32
v) (MV_DocId MVector s Word32
v') = MVector s Word32 -> MVector s Word32 -> Bool
forall s. MVector s Word32 -> MVector s Word32 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GMVec.basicOverlaps   MVector s Word32
v MVector s Word32
v'
    {-# INLINE basicLength #-}
    {-# INLINE basicUnsafeSlice #-}
    {-# INLINE basicOverlaps #-}
    {-# INLINE basicUnsafeNew #-}
    {-# INLINE basicInitialize #-}
    {-# INLINE basicUnsafeReplicate #-}
    {-# INLINE basicUnsafeRead #-}
    {-# INLINE basicUnsafeWrite #-}
    {-# INLINE basicClear #-}
    {-# INLINE basicSet #-}
    {-# INLINE basicUnsafeCopy #-}
    {-# INLINE basicUnsafeMove #-}
    {-# INLINE basicUnsafeGrow #-}

newtype instance Vec.Vector DocId = V_DocId (Vec.Vector Word32)

instance GVec.Vector Vec.Vector DocId where
    basicUnsafeFreeze :: forall s. Mutable Vector s DocId -> ST s (Vector DocId)
basicUnsafeFreeze (MV_DocId MVector s Word32
mv)  = Vector Word32 -> Vector DocId
V_DocId  (Vector Word32 -> Vector DocId)
-> ST s (Vector Word32) -> ST s (Vector DocId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s Word32 -> ST s (Vector Word32)
forall s. Mutable Vector s Word32 -> ST s (Vector Word32)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
GVec.basicUnsafeFreeze MVector s Word32
Mutable Vector s Word32
mv
    basicUnsafeThaw :: forall s. Vector DocId -> ST s (Mutable Vector s DocId)
basicUnsafeThaw   (V_DocId  Vector Word32
v)   = MVector s Word32 -> MVector s DocId
forall s. MVector s Word32 -> MVector s DocId
MV_DocId (MVector s Word32 -> MVector s DocId)
-> ST s (MVector s Word32) -> ST s (MVector s DocId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector Word32 -> ST s (Mutable Vector s Word32)
forall s. Vector Word32 -> ST s (Mutable Vector s Word32)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
GVec.basicUnsafeThaw Vector Word32
v
    basicLength :: Vector DocId -> Int
basicLength       (V_DocId  Vector Word32
v)   = Vector Word32 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
GVec.basicLength Vector Word32
v
    basicUnsafeSlice :: Int -> Int -> Vector DocId -> Vector DocId
basicUnsafeSlice Int
i Int
l (V_DocId Vector Word32
v) = Vector Word32 -> Vector DocId
V_DocId (Int -> Int -> Vector Word32 -> Vector Word32
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVec.basicUnsafeSlice Int
i Int
l Vector Word32
v)
    basicUnsafeIndexM :: Vector DocId -> Int -> Box DocId
basicUnsafeIndexM (V_DocId  Vector Word32
v) Int
i = Word32 -> DocId
DocId (Word32 -> DocId) -> Box Word32 -> Box DocId
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector Word32 -> Int -> Box Word32
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
GVec.basicUnsafeIndexM Vector Word32
v Int
i
    basicUnsafeCopy :: forall s. Mutable Vector s DocId -> Vector DocId -> ST s ()
basicUnsafeCopy   (MV_DocId MVector s Word32
mv)
                      (V_DocId  Vector Word32
v)   = Mutable Vector s Word32 -> Vector Word32 -> ST s ()
forall s. Mutable Vector s Word32 -> Vector Word32 -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
GVec.basicUnsafeCopy MVector s Word32
Mutable Vector s Word32
mv Vector Word32
v
    elemseq :: forall b. Vector DocId -> DocId -> b -> b
elemseq           (V_DocId  Vector Word32
v) DocId
x = Vector Word32 -> Word32 -> b -> b
forall b. Vector Word32 -> Word32 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
GVec.elemseq Vector Word32
v (DocId -> Word32
unDocId DocId
x)
    {-# INLINE basicUnsafeFreeze #-}
    {-# INLINE basicUnsafeThaw #-}
    {-# INLINE basicLength #-}
    {-# INLINE basicUnsafeSlice #-}
    {-# INLINE basicUnsafeIndexM #-}
    {-# INLINE basicUnsafeCopy #-}
    {-# INLINE elemseq #-}