{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

-- | A strict finger tree.
--
-- * amortized O(1) 'cons', 'snoc', 'uncons', 'unsnoc' when a sequence is used
--   once; O(log n) in the worst case, which a program can hit repeatedly only
--   by going back to the same old version
-- * O(1) 'size'
-- * O(log n) 'lookup', 'append', 'take', 'drop'
-- * no laziness anywhere: every field is strict, nothing is a thunk
--
-- The shape is Hinze and Paterson's: a prefix digit, a middle that is a
-- sequence of nodes, a suffix digit.  The differences are that the middle is
-- strict, digits hold up to 'maxD' items, and nodes are mostly eight wide.
-- The one invariant is that both digits of a tree with a middle have an item
-- (so the ends, and what is near them, are found without going down).  A
-- digit that fills up sheds a node of eight into the middle, and a digit
-- that empties takes a node out of it.
--
-- Digits are short lists, so that adding or removing an item at an end
-- allocates one cell or none.  A node's children are in an array (or, for the
-- nodes of eight leaves, in the node itself): a node is built once and then
-- only read.
module Unison.Util.Deque.Internal
  ( -- * The type
    Seq,
    pattern Empty,
    pattern (:<|),
    pattern (:|>),

    -- * Construction
    empty,
    singleton,
    cons,
    snoc,
    append,
    (<|),
    (|>),
    (><),
    fromList,
    fromListN,
    unsafeFromListN,
    fromFunction,

    -- * Queries
    size,
    length,
    null,
    lookup,
    toList,

    -- * Taking apart
    uncons,
    unsnoc,
    take,
    drop,
    splitAt,

    -- * Whole-sequence transformations (these rebuild the sequence)
    sort,
    sortBy,
    unstableSort,
    unstableSortBy,
    intersperse,
    reverse,

    -- * For tests
    valid,

    -- * The parts 'Unison.Util.Rope' is built from: digits, nodes, and the

    -- middle of a tree, which is a sequence of nodes that knows how many
    -- leaves are under each
    Deque (..),
    SList (..),
    Node (..),
    Mid (..),
    Arr,
    takeS,
    dropS,
    appendS,
    lenS,
    revS,
    revOnto,
    listS,
    arr8,
    fromSListA,
    nodeSize,
    nodeArity,
    nodeAt,
    nodeTakeRev,
    nodeDropFwd,
    maxD,
    mk,
    tsize,
    tpc,
    tsc,
    sizeM,
    consM,
    snocM,
    unconsM,
    unsnocM,
    scanFwd,
    scanBwd,
    scanKids,
    takeM,
    dropM,
    appM,
    foldrM,
    foldrS,
    foldrRev,
    foldrNode,
    foldlM,
    foldlS,
    foldlRev,
    foldlNode,
    validM,
  )
where

import Control.DeepSeq (NFData (..))
import Control.Monad (unless, when)
import Control.Monad.ST (ST)
import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.))
import Data.Foldable qualified as F
import Data.Functor.Classes (Eq1 (..), Ord1 (..), Show1 (..))
import Data.List qualified as L
import Data.Primitive.SmallArray
  ( SmallArray,
    SmallMutableArray,
    cloneSmallArray,
    indexSmallArray,
    newSmallArray,
    runSmallArray,
    sizeofSmallArray,
    writeSmallArray,
  )
import GHC.Exts qualified as Exts
import Prelude hiding (drop, length, lookup, null, reverse, splitAt, take)

------------------------------------------------------------------------
-- Strict lists: the digits

data SList a = SNil | SCons !a !(SList a)

takeS :: Int -> SList a -> SList a
takeS :: forall a. Int -> SList a -> SList a
takeS Int
0 SList a
_ = SList a
forall a. SList a
SNil
takeS Int
k (SCons a
x SList a
r) = a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
r)
takeS Int
_ SList a
SNil = SList a
forall a. SList a
SNil

dropS :: Int -> SList a -> SList a
dropS :: forall a. Int -> SList a -> SList a
dropS Int
0 SList a
l = SList a
l
dropS Int
k (SCons a
_ SList a
r) = Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
r
dropS Int
_ SList a
SNil = SList a
forall a. SList a
SNil

appendS :: SList a -> SList a -> SList a
appendS :: forall a. SList a -> SList a -> SList a
appendS SList a
SNil SList a
ys = SList a
ys
appendS (SCons a
x SList a
r) SList a
ys = a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
appendS SList a
r SList a
ys)

lenS :: SList a -> Int
lenS :: forall a. SList a -> Int
lenS = Int -> SList a -> Int
forall {t} {a}. Num t => t -> SList a -> t
go Int
0
  where
    go :: t -> SList a -> t
go !t
n SList a
SNil = t
n
    go !t
n (SCons a
_ SList a
r) = t -> SList a -> t
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) SList a
r

revS :: SList a -> SList a
revS :: forall a. SList a -> SList a
revS SList a
l = SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
l SList a
forall a. SList a
SNil

-- the first list reversed, then the second
revOnto :: SList a -> SList a -> SList a
revOnto :: forall a. SList a -> SList a -> SList a
revOnto SList a
SNil SList a
acc = SList a
acc
revOnto (SCons a
x SList a
r) SList a
acc = SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
r (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
acc)

nthS :: Int -> SList a -> a
nthS :: forall a. Int -> SList a -> a
nthS Int
k (SCons a
x SList a
r)
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a
x
  | Bool
otherwise = Int -> SList a -> a
forall a. Int -> SList a -> a
nthS (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
r
nthS Int
_ SList a
SNil = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque: index past the end of a digit"

listS :: SList a -> [a]
listS :: forall a. SList a -> [a]
listS SList a
SNil = []
listS (SCons a
x SList a
r) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: SList a -> [a]
forall a. SList a -> [a]
listS SList a
r

------------------------------------------------------------------------
-- Arrays: the children of most nodes.  Every element is evaluated before
-- it is stored.  They are filled with single writes, which compile to a
-- store each; the bulk copy operations are calls into the runtime that cost
-- more than they save at these sizes.

type Arr = SmallArray

lenA :: Arr a -> Int
lenA :: forall a. Arr a -> Int
lenA = SmallArray a -> Int
forall a. Arr a -> Int
sizeofSmallArray
{-# INLINE lenA #-}

ixA :: Arr a -> Int -> a
ixA :: forall a. Arr a -> Int -> a
ixA = SmallArray a -> Int -> a
forall a. Arr a -> Int -> a
indexSmallArray
{-# INLINE ixA #-}

hole :: a
hole :: forall a. a
hole = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque: an array element that was never written"
{-# NOINLINE hole #-}

arr8 :: a -> a -> a -> a -> a -> a -> a -> a -> Arr a
arr8 :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> Arr a
arr8 !a
a !a
b !a
c !a
d !a
e !a
f !a
g !a
h = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s a
m <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
8 a
a
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
1 a
b
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
2 a
c
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
3 a
d
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
4 a
e
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
5 a
f
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
6 a
g
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
7 a
h
  pure SmallMutableArray s a
m

-- n elements starting at off
sliceA :: Arr a -> Int -> Int -> Arr a
sliceA :: forall a. Arr a -> Int -> Int -> Arr a
sliceA = SmallArray a -> Int -> Int -> SmallArray a
forall a. Arr a -> Int -> Int -> Arr a
cloneSmallArray
{-# INLINE sliceA #-}

-- items of a list go into slots i, i + 1, ...
writeUp :: SmallMutableArray s a -> Int -> SList a -> ST s ()
writeUp :: forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeUp SmallMutableArray s a
m !Int
i (SCons a
x SList a
r) = SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
i a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmallMutableArray s a -> Int -> SList a -> ST s ()
forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeUp SmallMutableArray s a
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SList a
r
writeUp SmallMutableArray s a
_ Int
_ SList a
SNil = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- items of a list go into slots i, i - 1, ...
writeDown :: SmallMutableArray s a -> Int -> SList a -> ST s ()
writeDown :: forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeDown SmallMutableArray s a
m !Int
i (SCons a
x SList a
r) = SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
i a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmallMutableArray s a -> Int -> SList a -> ST s ()
forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeDown SmallMutableArray s a
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
r
writeDown SmallMutableArray s a
_ Int
_ SList a
SNil = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- the first n items of a list that has at least n
fromSListA :: Int -> SList a -> Arr a
fromSListA :: forall a. Int -> SList a -> Arr a
fromSListA Int
n SList a
l = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s a
m <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n a
forall a. a
hole
  let go :: Int -> SList a -> ST s ()
go !Int
i (SCons a
x SList a
r) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
m Int
i a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> SList a -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SList a
r
      go Int
_ SList a
_ = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Int -> SList a -> ST s ()
go Int
0 SList a
l
  pure SmallMutableArray s a
m

-- A list that runs back to front, then two that run front to back, as one
-- array of c items: c is the three lengths added up, and the first list has
-- nb items.
gather :: Int -> Int -> SList a -> SList a -> SList a -> Arr a
gather :: forall a. Int -> Int -> SList a -> SList a -> SList a -> Arr a
gather Int
c Int
nb SList a
back SList a
mid SList a
front = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s a
m <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
c a
forall a. a
hole
  SmallMutableArray s a -> Int -> SList a -> ST s ()
forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeDown SmallMutableArray s a
m (Int
nb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
back
  SmallMutableArray s a -> Int -> SList a -> ST s ()
forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeUp SmallMutableArray s a
m Int
nb SList a
mid
  SmallMutableArray s a -> Int -> SList a -> ST s ()
forall s a. SmallMutableArray s a -> Int -> SList a -> ST s ()
writeUp SmallMutableArray s a
m (Int
nb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SList a -> Int
forall a. SList a -> Int
lenS SList a
mid) SList a
front
  pure SmallMutableArray s a
m

mapA :: (a -> b) -> Arr a -> Arr b
mapA :: forall a b. (a -> b) -> Arr a -> Arr b
mapA a -> b
f Arr a
a = (forall s. ST s (SmallMutableArray s b)) -> SmallArray b
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray do
  SmallMutableArray s b
m <- Int -> b -> ST s (SmallMutableArray (PrimState (ST s)) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n b
forall a. a
hole
  let go :: Int -> ST s ()
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = case a -> b
f (Arr a -> Int -> a
forall a. Arr a -> Int -> a
ixA Arr a
a Int
i) of !b
x -> SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
m Int
i b
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> ST s ()
go Int
0
  pure SmallMutableArray s b
m
  where
    !n :: Int
n = Arr a -> Int
forall a. Arr a -> Int
lenA Arr a
a
{-# INLINE mapA #-}

foldrA :: (a -> r -> r) -> r -> Arr a -> r
foldrA :: forall a r. (a -> r -> r) -> r -> Arr a -> r
foldrA a -> r -> r
f r
z Arr a
a = Int -> r
go Int
0
  where
    !n :: Int
n = Arr a -> Int
forall a. Arr a -> Int
lenA Arr a
a
    go :: Int -> r
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = r
z
      | Bool
otherwise = a -> r -> r
f (Arr a -> Int -> a
forall a. Arr a -> Int -> a
ixA Arr a
a Int
i) (Int -> r
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

foldlA :: (r -> a -> r) -> r -> Arr a -> r
foldlA :: forall r a. (r -> a -> r) -> r -> Arr a -> r
foldlA r -> a -> r
f r
z0 Arr a
a = Int -> r -> r
go Int
0 r
z0
  where
    !n :: Int
n = Arr a -> Int
forall a. Arr a -> Int
lenA Arr a
a
    go :: Int -> r -> r
go !Int
i !r
z
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = r
z
      | Bool
otherwise = Int -> r -> r
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (r -> a -> r
f r
z (Arr a -> Int -> a
forall a. Arr a -> Int -> a
ixA Arr a
a Int
i))

------------------------------------------------------------------------
-- Nodes.  A node made by a top-level digit that filled up has eight leaves.
-- Every other node has two to eight children in an array, and the number of
-- leaves under it: the nodes below the first level of nodes, and the nodes
-- that 'append' makes.

data Node a
  = N8 !a !a !a !a !a !a !a !a
  | NA !Int !(Arr a)

nodeSize :: Node a -> Int
nodeSize :: forall a. Node a -> Int
nodeSize (N8 {}) = Int
8
nodeSize (NA Int
n Arr a
_) = Int
n
{-# INLINE nodeSize #-}

nodeArity :: Node a -> Int
nodeArity :: forall a. Node a -> Int
nodeArity (N8 {}) = Int
8
nodeArity (NA Int
_ Arr a
a) = Arr a -> Int
forall a. Arr a -> Int
lenA Arr a
a
{-# INLINE nodeArity #-}

-- the k-th child (0-based)
nodeAt :: Int -> Node a -> a
nodeAt :: forall a. Int -> Node a -> a
nodeAt Int
k (N8 a
a a
b a
c a
d a
e a
f a
g a
h) = case Int
k of
  Int
0 -> a
a
  Int
1 -> a
b
  Int
2 -> a
c
  Int
3 -> a
d
  Int
4 -> a
e
  Int
5 -> a
f
  Int
6 -> a
g
  Int
_ -> a
h
nodeAt Int
k (NA Int
_ Arr a
a) = Arr a -> Int -> a
forall a. Arr a -> Int -> a
ixA Arr a
a Int
k

-- the first k children, back to front
nodeTakeRev :: Int -> Node a -> SList a
nodeTakeRev :: forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node a
nd = Int -> SList a -> SList a
go Int
0 SList a
forall a. SList a
SNil
  where
    go :: Int -> SList a -> SList a
go !Int
i SList a
acc
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k = SList a
acc
      | Bool
otherwise = Int -> SList a -> SList a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons (Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
i Node a
nd) SList a
acc)

-- all but the first k children, front to back
nodeDropFwd :: Int -> Node a -> SList a
nodeDropFwd :: forall a. Int -> Node a -> SList a
nodeDropFwd Int
k Node a
nd = Int -> SList a
go Int
k
  where
    !n :: Int
n = Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd
    go :: Int -> SList a
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = SList a
forall a. SList a
SNil
      | Bool
otherwise = a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons (Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
i Node a
nd) (Int -> SList a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

sumA :: Arr (Node a) -> Int
sumA :: forall a. Arr (Node a) -> Int
sumA Arr (Node a)
a = Int -> Int -> Int
go Int
0 Int
0
  where
    !n :: Int
n = Arr (Node a) -> Int
forall a. Arr a -> Int
lenA Arr (Node a)
a
    go :: Int -> Int -> Int
go !Int
i !Int
s
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Int
s
      | Bool
otherwise = Int -> Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeSize (Arr (Node a) -> Int -> Node a
forall a. Arr a -> Int -> a
ixA Arr (Node a)
a Int
i))

sumS :: SList (Node a) -> Int
sumS :: forall a. SList (Node a) -> Int
sumS = Int -> SList (Node a) -> Int
forall {a}. Int -> SList (Node a) -> Int
go Int
0
  where
    go :: Int -> SList (Node a) -> Int
go !Int
n SList (Node a)
SNil = Int
n
    go !Int
n (SCons Node a
x SList (Node a)
r) = Int -> SList (Node a) -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeSize Node a
x) SList (Node a)
r

-- the index of the node holding leaf number i, and the leaves before it
scanA :: Int -> Arr (Node a) -> (Int, Int)
scanA :: forall a. Int -> Arr (Node a) -> (Int, Int)
scanA Int
i Arr (Node a)
a = Int -> Int -> (Int, Int)
go Int
0 Int
0
  where
    go :: Int -> Int -> (Int, Int)
go !Int
q !Int
sb =
      let !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize (Arr (Node a) -> Int -> Node a
forall a. Arr a -> Int -> a
ixA Arr (Node a)
a Int
q)
       in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s
            then ((Int
q, Int
sb))
            else Int -> Int -> (Int, Int)
go (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s)
{-# INLINE scanA #-}

------------------------------------------------------------------------
-- The tree.
--
-- A prefix runs front to back and a suffix back to front, so the item at
-- the outer end of either is the head of its list.
--
-- The first field of 'Deep' and 'MDeep' packs three numbers: the number of
-- leaves in the tree (bits 8 and up), the number of items in the suffix (bits
-- 4 to 7) and in the prefix (bits 0 to 3).  'MDeep' also has the number of
-- leaves under its prefix, which 'lookup' needs to step over the prefix
-- without reading it.
--
-- 'Mid' is the same thing as 'Deque' one level down, where the items are
-- nodes.

data Deque a
  = Nil
  | Deep !Int !(SList a) !(Mid a) !(SList a)

data Mid a
  = MNil
  | MDeep !Int !Int !(SList (Node a)) !(Mid (Node a)) !(SList (Node a))

-- the most items a digit holds; it must fit in four bits and be at least nine
maxD :: Int
maxD :: Int
maxD = Int
10

mk :: Int -> Int -> Int -> Int -- leaves, prefix count, suffix count
mk :: Int -> Int -> Int -> Int
mk Int
n Int
p Int
s = (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
p
{-# INLINE mk #-}

tsize, tpc, tsc :: Int -> Int
tsize :: Int -> Int
tsize Int
t = Int
t Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
tpc :: Int -> Int
tpc Int
t = Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15
tsc :: Int -> Int
tsc Int
t = (Int
t Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15
{-# INLINE tsize #-}
{-# INLINE tpc #-}
{-# INLINE tsc #-}

sizeM :: Mid a -> Int
sizeM :: forall a. Mid a -> Int
sizeM Mid a
MNil = Int
0
sizeM (MDeep Int
t Int
_ SList (Node a)
_ Mid (Node a)
_ SList (Node a)
_) = Int -> Int
tsize Int
t
{-# INLINE sizeM #-}

empty :: Deque a
empty :: forall a. Deque a
empty = Deque a
forall a. Deque a
Nil

singleton :: a -> Deque a
singleton :: forall a. a -> Deque a
singleton a
x = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep Int
0x101 (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
forall a. SList a
SNil) Mid a
forall a. Mid a
MNil SList a
forall a. SList a
SNil

size :: Deque a -> Int
size :: forall a. Deque a -> Int
size Deque a
Nil = Int
0
size (Deep Int
t SList a
_ Mid a
_ SList a
_) = Int -> Int
tsize Int
t
{-# INLINE size #-}

------------------------------------------------------------------------
-- Adding at the ends.  The wrappers are INLINE and the paths that touch the
-- middle are not, so that a call site gets only the common case.

cons :: a -> Deque a -> Deque a
cons :: forall a. a -> Deque a -> Deque a
cons a
x Deque a
Nil = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep Int
0x101 (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
forall a. SList a
SNil) Mid a
forall a. Mid a
MNil SList a
forall a. SList a
SNil
cons a
x (Deep Int
t SList a
pr Mid a
m SList a
sf)
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxD = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x101) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
pr) Mid a
m SList a
sf
  | Bool
otherwise = a -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. a -> Int -> SList a -> Mid a -> SList a -> Deque a
consFull a
x Int
t SList a
pr Mid a
m SList a
sf
{-# INLINE cons #-}

snoc :: Deque a -> a -> Deque a
snoc :: forall a. Deque a -> a -> Deque a
snoc Deque a
Nil a
x = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep Int
0x110 SList a
forall a. SList a
SNil Mid a
forall a. Mid a
MNil (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
forall a. SList a
SNil)
snoc (Deep Int
t SList a
pr Mid a
m SList a
sf) a
x
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxD Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x110) SList a
pr Mid a
m (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x SList a
sf)
  | Bool
otherwise = a -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. a -> Int -> SList a -> Mid a -> SList a -> Deque a
snocFull a
x Int
t SList a
pr Mid a
m SList a
sf
{-# INLINE snoc #-}

-- A full prefix keeps its two outermost items and sheds the other eight.
-- If the suffix is empty there is no middle yet, and the far half of the
-- prefix becomes the suffix.
consFull :: a -> Int -> SList a -> Mid a -> SList a -> Deque a
consFull :: forall a. a -> Int -> SList a -> Mid a -> SList a -> Deque a
consFull a
x !Int
t SList a
pr Mid a
m SList a
sf
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
6 Int
5) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
5 SList a
pr)) Mid a
forall a. Mid a
MNil (SList a -> SList a
forall a. SList a -> SList a
revS (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
5 SList a
pr))
  | Bool
otherwise = case SList a
pr of
      SCons a
p1 (SCons a
p2 (SCons a
a (SCons a
b (SCons a
c (SCons a
d (SCons a
e (SCons a
f (SCons a
g (SCons a
h SList a
_))))))))) ->
        Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
p1 (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
p2 SList a
forall a. SList a
SNil))) (Node a -> Mid a -> Mid a
forall a. Node a -> Mid a -> Mid a
consM (a -> a -> a -> a -> a -> a -> a -> a -> Node a
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Node a
N8 a
a a
b a
c a
d a
e a
f a
g a
h) Mid a
m) SList a
sf
      SList a
_ -> [Char] -> Deque a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.cons: short prefix"
{-# NOINLINE consFull #-}

snocFull :: a -> Int -> SList a -> Mid a -> SList a -> Deque a
snocFull :: forall a. a -> Int -> SList a -> Mid a -> SList a -> Deque a
snocFull a
x !Int
t SList a
pr Mid a
m SList a
sf
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
5 Int
6) (SList a -> SList a
forall a. SList a -> SList a
revS (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
5 SList a
sf)) Mid a
forall a. Mid a
MNil (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
5 SList a
sf))
  | Bool
otherwise = case SList a
sf of
      SCons a
s1 (SCons a
s2 (SCons a
h (SCons a
g (SCons a
f (SCons a
e (SCons a
d (SCons a
c (SCons a
b (SCons a
a SList a
_))))))))) ->
        Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x70) SList a
pr (Mid a -> Node a -> Mid a
forall a. Mid a -> Node a -> Mid a
snocM Mid a
m (a -> a -> a -> a -> a -> a -> a -> a -> Node a
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Node a
N8 a
a a
b a
c a
d a
e a
f a
g a
h)) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
x (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
s1 (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
s2 SList a
forall a. SList a
SNil)))
      SList a
_ -> [Char] -> Deque a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.snoc: short suffix"
{-# NOINLINE snocFull #-}

consM :: Node a -> Mid a -> Mid a
consM :: forall a. Node a -> Mid a -> Mid a
consM !Node a
n Mid a
MNil = let !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
s Int
1 Int
0) Int
s (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n SList (Node a)
forall a. SList a
SNil) Mid (Node a)
forall a. Mid a
MNil SList (Node a)
forall a. SList a
SNil
consM Node a
n (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf)
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxD = Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n SList (Node a)
pr) Mid (Node a)
m SList (Node a)
sf
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      let !kept :: SList (Node a)
kept = Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
5 SList (Node a)
pr
       in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
6 Int
5) (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SList (Node a) -> Int
forall a. SList (Node a) -> Int
sumS SList (Node a)
kept) (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n SList (Node a)
kept) Mid (Node a)
forall a. Mid a
MNil (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
5 SList (Node a)
pr))
  | Bool
otherwise = case SList (Node a)
pr of
      SCons Node a
p1 (SCons Node a
p2 (SCons Node a
a (SCons Node a
b (SCons Node a
c (SCons Node a
d (SCons Node a
e (SCons Node a
f (SCons Node a
g (SCons Node a
h SList (Node a)
_))))))))) ->
        let !keep :: Int
keep = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeSize Node a
p2
         in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep
              (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
              (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keep)
              (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
p1 (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
p2 SList (Node a)
forall a. SList a
SNil)))
              (Node (Node a) -> Mid (Node a) -> Mid (Node a)
forall a. Node a -> Mid a -> Mid a
consM (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA (Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
keep) (Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Arr (Node a)
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Arr a
arr8 Node a
a Node a
b Node a
c Node a
d Node a
e Node a
f Node a
g Node a
h)) Mid (Node a)
m)
              SList (Node a)
sf
      SList (Node a)
_ -> [Char] -> Mid a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.consM: short prefix"
  where
    !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n

snocM :: Mid a -> Node a -> Mid a
snocM :: forall a. Mid a -> Node a -> Mid a
snocM Mid a
MNil !Node a
n = Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n) Int
0 Int
1) Int
0 SList (Node a)
forall a. SList a
SNil Mid (Node a)
forall a. Mid a
MNil (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n SList (Node a)
forall a. SList a
SNil)
snocM (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) Node a
n
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxD Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 = Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x10) Int
ps SList (Node a)
pr Mid (Node a)
m (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n SList (Node a)
sf)
  | Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      let !pr' :: SList (Node a)
pr' = SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
5 SList (Node a)
sf)
       in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
5 Int
6) (SList (Node a) -> Int
forall a. SList (Node a) -> Int
sumS SList (Node a)
pr') SList (Node a)
pr' Mid (Node a)
forall a. Mid a
MNil (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
5 SList (Node a)
sf))
  | Bool
otherwise = case SList (Node a)
sf of
      SCons Node a
s1 (SCons Node a
s2 (SCons Node a
h (SCons Node a
g (SCons Node a
f (SCons Node a
e (SCons Node a
d (SCons Node a
c (SCons Node a
b (SCons Node a
a SList (Node a)
_))))))))) ->
        let !shed :: Int
shed = Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Node a -> Int
nodeSize Node a
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Node a -> Int
nodeSize Node a
s2
         in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep
              (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x70)
              Int
ps
              SList (Node a)
pr
              (Mid (Node a) -> Node (Node a) -> Mid (Node a)
forall a. Mid a -> Node a -> Mid a
snocM Mid (Node a)
m (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
shed (Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Arr (Node a)
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Arr a
arr8 Node a
a Node a
b Node a
c Node a
d Node a
e Node a
f Node a
g Node a
h)))
              (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
n (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
s1 (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons Node a
s2 SList (Node a)
forall a. SList a
SNil)))
      SList (Node a)
_ -> [Char] -> Mid a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.snocM: short suffix"
  where
    !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n

------------------------------------------------------------------------
-- Removing at the ends

uncons :: Deque a -> Maybe (a, Deque a)
uncons :: forall a. Deque a -> Maybe (a, Deque a)
uncons Deque a
Nil = Maybe (a, Deque a)
forall a. Maybe a
Nothing
uncons (Deep Int
t SList a
pr Mid a
m SList a
sf) = case SList a
pr of
  SCons a
x pr' :: SList a
pr'@(SCons a
_ SList a
_) -> (a, Deque a) -> Maybe (a, Deque a)
forall a. a -> Maybe a
Just (a
x, Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x101) SList a
pr' Mid a
m SList a
sf)
  SCons a
x SList a
SNil -> (a, Deque a) -> Maybe (a, Deque a)
forall a. a -> Maybe a
Just (a
x, Int -> Mid a -> SList a -> Deque a
forall a. Int -> Mid a -> SList a -> Deque a
unconsLast Int
t Mid a
m SList a
sf)
  SList a
SNil -> Int -> SList a -> Maybe (a, Deque a)
forall a. Int -> SList a -> Maybe (a, Deque a)
unconsSlow Int
t SList a
sf
{-# INLINE uncons #-}

unsnoc :: Deque a -> Maybe (Deque a, a)
unsnoc :: forall a. Deque a -> Maybe (Deque a, a)
unsnoc Deque a
Nil = Maybe (Deque a, a)
forall a. Maybe a
Nothing
unsnoc (Deep Int
t SList a
pr Mid a
m SList a
sf) = case SList a
sf of
  SCons a
x sf' :: SList a
sf'@(SCons a
_ SList a
_) -> (Deque a, a) -> Maybe (Deque a, a)
forall a. a -> Maybe a
Just (Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x110) SList a
pr Mid a
m SList a
sf', a
x)
  SCons a
x SList a
SNil -> (Deque a, a) -> Maybe (Deque a, a)
forall a. a -> Maybe a
Just (Int -> SList a -> Mid a -> Deque a
forall a. Int -> SList a -> Mid a -> Deque a
unsnocLast Int
t SList a
pr Mid a
m, a
x)
  SList a
SNil -> Int -> SList a -> Maybe (Deque a, a)
forall a. Int -> SList a -> Maybe (Deque a, a)
unsnocSlow Int
t SList a
pr
{-# INLINE unsnoc #-}

-- The prefix's only item is being removed: the first node of the middle, if
-- there is one, becomes the prefix.
unconsLast :: Int -> Mid a -> SList a -> Deque a
unconsLast :: forall a. Int -> Mid a -> SList a -> Deque a
unconsLast !Int
t Mid a
m SList a
sf
  | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x200 = Deque a
forall a. Deque a
Nil
  | Bool
otherwise = case Mid a
m of
      Mid a
MNil -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x101) SList a
forall a. SList a
SNil Mid a
forall a. Mid a
MNil SList a
sf
      Mid a
_ -> case Mid a -> (Node a, Mid a)
forall a. Mid a -> (Node a, Mid a)
unconsM Mid a
m of
        (Node a
nd, Mid a
m') -> case Node a
nd of
          N8 a
a a
b a
c a
d a
e a
f a
g a
h ->
            Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x101 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
a (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
b (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
c (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
d (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
e (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
f (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
g (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
h SList a
forall a. SList a
SNil)))))))) Mid a
m' SList a
sf
          Node a
_ -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x101 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd Int
0 Node a
nd) Mid a
m' SList a
sf
{-# NOINLINE unconsLast #-}

unsnocLast :: Int -> SList a -> Mid a -> Deque a
unsnocLast :: forall a. Int -> SList a -> Mid a -> Deque a
unsnocLast !Int
t SList a
pr Mid a
m
  | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x200 = Deque a
forall a. Deque a
Nil
  | Bool
otherwise = case Mid a
m of
      Mid a
MNil -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x110) SList a
pr Mid a
forall a. Mid a
MNil SList a
forall a. SList a
SNil
      Mid a
_ -> case Mid a -> (Mid a, Node a)
forall a. Mid a -> (Mid a, Node a)
unsnocM Mid a
m of
        (Mid a
m', Node a
nd) -> case Node a
nd of
          N8 a
a a
b a
c a
d a
e a
f a
g a
h ->
            Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x110 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80) SList a
pr Mid a
m' (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
h (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
g (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
f (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
e (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
d (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
c (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
b (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
a SList a
forall a. SList a
SNil))))))))
          Node a
_ -> let !k :: Int
k = Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd in Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x110 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4)) SList a
pr Mid a
m' (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node a
nd)
{-# NOINLINE unsnocLast #-}

-- The prefix is empty, so there is no middle and everything is in the
-- suffix: half of it moves over.
unconsSlow :: Int -> SList a -> Maybe (a, Deque a)
unconsSlow :: forall a. Int -> SList a -> Maybe (a, Deque a)
unconsSlow !Int
t SList a
sf
  | Int
sc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = case SList a
sf of
      SCons a
x SList a
_ -> (a, Deque a) -> Maybe (a, Deque a)
forall a. a -> Maybe a
Just (a
x, Deque a
forall a. Deque a
Nil)
      SList a
SNil -> [Char] -> Maybe (a, Deque a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.uncons: empty"
  | Bool
otherwise =
      let !q :: Int
q = (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
          !p :: Int
p = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q
       in case SList a -> SList a
forall a. SList a -> SList a
revS (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
q SList a
sf) of
            SCons a
x SList a
pr -> (a, Deque a) -> Maybe (a, Deque a)
forall a. a -> Maybe a
Just (a
x, Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
p Int
q) SList a
pr Mid a
forall a. Mid a
MNil (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
q SList a
sf))
            SList a
SNil -> [Char] -> Maybe (a, Deque a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.uncons: empty"
  where
    !sc :: Int
sc = Int -> Int
tsc Int
t
{-# NOINLINE unconsSlow #-}

unsnocSlow :: Int -> SList a -> Maybe (Deque a, a)
unsnocSlow :: forall a. Int -> SList a -> Maybe (Deque a, a)
unsnocSlow !Int
t SList a
pr
  | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = case SList a
pr of
      SCons a
x SList a
_ -> (Deque a, a) -> Maybe (Deque a, a)
forall a. a -> Maybe a
Just (Deque a
forall a. Deque a
Nil, a
x)
      SList a
SNil -> [Char] -> Maybe (Deque a, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unsnoc: empty"
  | Bool
otherwise =
      let !p :: Int
p = (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
          !q :: Int
q = Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
       in case SList a -> SList a
forall a. SList a -> SList a
revS (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
p SList a
pr) of
            SCons a
x SList a
sf -> (Deque a, a) -> Maybe (Deque a, a)
forall a. a -> Maybe a
Just (Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
p Int
q) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
p SList a
pr) Mid a
forall a. Mid a
MNil SList a
sf, a
x)
            SList a
SNil -> [Char] -> Maybe (Deque a, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unsnoc: empty"
  where
    !pc :: Int
pc = Int -> Int
tpc Int
t
{-# NOINLINE unsnocSlow #-}

-- the first node and the rest; the argument is not empty
unconsM :: Mid a -> (Node a, Mid a)
unconsM :: forall a. Mid a -> (Node a, Mid a)
unconsM Mid a
MNil = [Char] -> (Node a, Mid a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unconsM: empty"
unconsM (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = case SList (Node a)
pr of
  SCons Node a
n SList (Node a)
SNil | MDeep {} <- Mid (Node a)
m -> case Mid (Node a) -> (Node (Node a), Mid (Node a))
forall a. Mid a -> (Node a, Mid a)
unconsM Mid (Node a)
m of
    (Node (Node a)
nn, Mid (Node a)
m') ->
      (Node a
n, Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node (Node a) -> Int
forall a. Node a -> Int
nodeArity Node (Node a)
nn) (Node (Node a) -> Int
forall a. Node a -> Int
nodeSize Node (Node a)
nn) (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeDropFwd Int
0 Node (Node a)
nn) Mid (Node a)
m' SList (Node a)
sf)
  SCons Node a
n SList (Node a)
pr' ->
    let !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n
        !t' :: Int
t' = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     in if Int
t' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x100 then (Node a
n, Mid a
forall a. Mid a
MNil) else (Node a
n, Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep Int
t' (Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList (Node a)
pr' Mid (Node a)
m SList (Node a)
sf)
  SList (Node a)
SNil ->
    let !sc :: Int
sc = Int -> Int
tsc Int
t
        !q :: Int
q = (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        !p :: Int
p = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q
     in case SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
q SList (Node a)
sf) of
          SCons Node a
n SList (Node a)
pr'
            | Int
sc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (Node a
n, Mid a
forall a. Mid a
MNil)
            | Bool
otherwise -> (Node a
n, Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n) Int
p Int
q) (SList (Node a) -> Int
forall a. SList (Node a) -> Int
sumS SList (Node a)
pr') SList (Node a)
pr' Mid (Node a)
forall a. Mid a
MNil (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
q SList (Node a)
sf))
          SList (Node a)
SNil -> [Char] -> (Node a, Mid a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unconsM: empty"

unsnocM :: Mid a -> (Mid a, Node a)
unsnocM :: forall a. Mid a -> (Mid a, Node a)
unsnocM Mid a
MNil = [Char] -> (Mid a, Node a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unsnocM: empty"
unsnocM (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = case SList (Node a)
sf of
  SCons Node a
n SList (Node a)
SNil | MDeep {} <- Mid (Node a)
m -> case Mid (Node a) -> (Mid (Node a), Node (Node a))
forall a. Mid a -> (Mid a, Node a)
unsnocM Mid (Node a)
m of
    (Mid (Node a)
m', Node (Node a)
nn) ->
      let !k :: Int
k = Node (Node a) -> Int
forall a. Node a -> Int
nodeArity Node (Node a)
nn
       in (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4)) Int
ps SList (Node a)
pr Mid (Node a)
m' (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node (Node a)
nn), Node a
n)
  SCons Node a
n SList (Node a)
sf' ->
    let !t' :: Int
t' = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10
     in if Int
t' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x100 then (Mid a
forall a. Mid a
MNil, Node a
n) else (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep Int
t' Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf', Node a
n)
  SList (Node a)
SNil ->
    let !pc :: Int
pc = Int -> Int
tpc Int
t
        !p :: Int
p = (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        !q :: Int
q = Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
     in case SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
p SList (Node a)
pr) of
          SCons Node a
n SList (Node a)
sf'
            | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (Mid a
forall a. Mid a
MNil, Node a
n)
            | Bool
otherwise ->
                let !pr' :: SList (Node a)
pr' = Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
p SList (Node a)
pr
                 in (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n) Int
p Int
q) (SList (Node a) -> Int
forall a. SList (Node a) -> Int
sumS SList (Node a)
pr') SList (Node a)
pr' Mid (Node a)
forall a. Mid a
MNil SList (Node a)
sf', Node a
n)
          SList (Node a)
SNil -> [Char] -> (Mid a, Node a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.unsnocM: empty"

-- A tree whose suffix would be empty: the suffix gets the last node of the
-- middle, if there is one.  And the same for a prefix.
deepR :: Int -> Int -> SList a -> Mid a -> Deque a
deepR :: forall a. Int -> Int -> SList a -> Mid a -> Deque a
deepR Int
n Int
pc SList a
pr Mid a
MNil = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
0) SList a
pr Mid a
forall a. Mid a
MNil SList a
forall a. SList a
SNil
deepR Int
n Int
pc SList a
pr Mid a
m = case Mid a -> (Mid a, Node a)
forall a. Mid a -> (Mid a, Node a)
unsnocM Mid a
m of
  (Mid a
m', Node a
nd) -> let !k :: Int
k = Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd in Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
k) SList a
pr Mid a
m' (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node a
nd)

deepL :: Int -> Int -> Mid a -> SList a -> Deque a
deepL :: forall a. Int -> Int -> Mid a -> SList a -> Deque a
deepL Int
n Int
sc Mid a
MNil SList a
sf = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
0 Int
sc) SList a
forall a. SList a
SNil Mid a
forall a. Mid a
MNil SList a
sf
deepL Int
n Int
sc Mid a
m SList a
sf = case Mid a -> (Node a, Mid a)
forall a. Mid a -> (Node a, Mid a)
unconsM Mid a
m of
  (Node a
nd, Mid a
m') -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n (Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd) Int
sc) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd Int
0 Node a
nd) Mid a
m' SList a
sf

mdeepR :: Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
mdeepR :: forall a.
Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
mdeepR Int
n Int
pc Int
ps SList (Node a)
pr Mid (Node a)
MNil = Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
0) Int
ps SList (Node a)
pr Mid (Node a)
forall a. Mid a
MNil SList (Node a)
forall a. SList a
SNil
mdeepR Int
n Int
pc Int
ps SList (Node a)
pr Mid (Node a)
m = case Mid (Node a) -> (Mid (Node a), Node (Node a))
forall a. Mid a -> (Mid a, Node a)
unsnocM Mid (Node a)
m of
  (Mid (Node a)
m', Node (Node a)
nn) -> let !k :: Int
k = Node (Node a) -> Int
forall a. Node a -> Int
nodeArity Node (Node a)
nn in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
k) Int
ps SList (Node a)
pr Mid (Node a)
m' (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node (Node a)
nn)

mdeepL :: Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
mdeepL :: forall a. Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
mdeepL Int
n Int
sc Mid (Node a)
MNil SList (Node a)
sf = Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n Int
0 Int
sc) Int
0 SList (Node a)
forall a. SList a
SNil Mid (Node a)
forall a. Mid a
MNil SList (Node a)
sf
mdeepL Int
n Int
sc Mid (Node a)
m SList (Node a)
sf = case Mid (Node a) -> (Node (Node a), Mid (Node a))
forall a. Mid a -> (Node a, Mid a)
unconsM Mid (Node a)
m of
  (Node (Node a)
nn, Mid (Node a)
m') -> Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n (Node (Node a) -> Int
forall a. Node a -> Int
nodeArity Node (Node a)
nn) Int
sc) (Node (Node a) -> Int
forall a. Node a -> Int
nodeSize Node (Node a)
nn) (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeDropFwd Int
0 Node (Node a)
nn) Mid (Node a)
m' SList (Node a)
sf

------------------------------------------------------------------------
-- Lookup.  Results flow upward in unboxed tuples: a level hands back the
-- node holding the leaf and the leaf's offset in it, and the level above
-- picks the child.

lookup :: Int -> Deque a -> Maybe a
lookup :: forall a. Int -> Deque a -> Maybe a
lookup !Int
_ Deque a
Nil = Maybe a
forall a. Maybe a
Nothing
lookup Int
i (Deep Int
t SList a
pr Mid a
m SList a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Maybe a
forall a. Maybe a
Nothing
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pc = let !r :: a
r = Int -> SList a -> a
forall a. Int -> SList a -> a
nthS Int
i SList a
pr in a -> Maybe a
forall a. a -> Maybe a
Just a
r
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
tsc Int
t = let !r :: a
r = Int -> SList a -> a
forall a. Int -> SList a -> a
nthS Int
j SList a
sf in a -> Maybe a
forall a. a -> Maybe a
Just a
r
  | Bool
otherwise = case Int -> Int -> Mid a -> (Node a, Int)
forall a. Int -> Int -> Mid a -> (Node a, Int)
lookM Int
0 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pc) Mid a
m of
      (Node a
nd, !Int
off) -> let !r :: a
r = Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
off Node a
nd in a -> Maybe a
forall a. a -> Maybe a
Just a
r
  where
    !n :: Int
n = Int -> Int
tsize Int
t
    !pc :: Int
pc = Int -> Int
tpc Int
t
    !j :: Int
j = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i

-- sh: a full child of this level's nodes has 2^sh leaves
lookM :: Int -> Int -> Mid a -> (Node a, Int)
lookM :: forall a. Int -> Int -> Mid a -> (Node a, Int)
lookM !Int
_ !Int
_ Mid a
MNil = [Char] -> (Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.lookup: empty middle"
lookM Int
sh Int
i (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ps = Int -> SList (Node a) -> (Node a, Int)
forall a. Int -> SList (Node a) -> (Node a, Int)
scanFwd Int
i SList (Node a)
pr
  | Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ms = case Int -> Int -> Mid (Node a) -> (Node (Node a), Int)
forall a. Int -> Int -> Mid a -> (Node a, Int)
lookM (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
i' Mid (Node a)
m of
      (Node (Node a)
nn, !Int
off) -> case Node (Node a)
nn of
        NA Int
s Arr (Node a)
kids
          | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3),
            Arr (Node a) -> Int
forall a. Arr a -> Int
lenA Arr (Node a)
kids Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 ->
              case Int
off Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. ((Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) of
                Int
o -> (Arr (Node a) -> Int -> Node a
forall a. Arr a -> Int -> a
ixA Arr (Node a)
kids (Int
off Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)), Int
o)
          | Bool
otherwise -> case Int -> Arr (Node a) -> (Int, Int)
forall a. Int -> Arr (Node a) -> (Int, Int)
scanA Int
off Arr (Node a)
kids of
              (!Int
q, !Int
sb) -> let !o :: Int
o = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb in (Arr (Node a) -> Int -> Node a
forall a. Arr a -> Int -> a
ixA Arr (Node a)
kids Int
q, Int
o)
        N8 {} -> [Char] -> (Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.lookup: a node of leaves below the first level"
  | Bool
otherwise = Int -> SList (Node a) -> (Node a, Int)
forall a. Int -> SList (Node a) -> (Node a, Int)
scanBwd (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) SList (Node a)
sf
  where
    !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps
    !ms :: Int
ms = Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m

scanFwd :: Int -> SList (Node a) -> (Node a, Int)
scanFwd :: forall a. Int -> SList (Node a) -> (Node a, Int)
scanFwd !Int
i (SCons Node a
n SList (Node a)
r)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = (Node a
n, Int
i)
  | Bool
otherwise = Int -> SList (Node a) -> (Node a, Int)
forall a. Int -> SList (Node a) -> (Node a, Int)
scanFwd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList (Node a)
r
  where
    !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n
scanFwd Int
_ SList (Node a)
SNil = [Char] -> (Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.lookup: past the end of a prefix"

-- r: the number of leaves after the one looked for
scanBwd :: Int -> SList (Node a) -> (Node a, Int)
scanBwd :: forall a. Int -> SList (Node a) -> (Node a, Int)
scanBwd !Int
r (SCons Node a
n SList (Node a)
rest)
  | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = let !i :: Int
i = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r in (Node a
n, Int
i)
  | Bool
otherwise = Int -> SList (Node a) -> (Node a, Int)
forall a. Int -> SList (Node a) -> (Node a, Int)
scanBwd (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList (Node a)
rest
  where
    !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
n
scanBwd Int
_ SList (Node a)
SNil = [Char] -> (Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.lookup: past the end of a suffix"

-- the index of the child holding leaf number i, and the leaves before it
scanKids :: Int -> Node (Node a) -> (Int, Int)
scanKids :: forall a. Int -> Node (Node a) -> (Int, Int)
scanKids Int
i (NA Int
_ Arr (Node a)
kids) = Int -> Arr (Node a) -> (Int, Int)
forall a. Int -> Arr (Node a) -> (Int, Int)
scanA Int
i Arr (Node a)
kids
scanKids Int
_ (N8 {}) = [Char] -> (Int, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque: a node of leaves below the first level"
{-# INLINE scanKids #-}

------------------------------------------------------------------------
-- take and drop.  The cut falls in a prefix, in a suffix, or in the middle;
-- in the middle, the level below hands back the node the cut falls in and
-- the part of itself that is wholly on the side being kept, and the kept
-- children of that node become this level's digit on the cut side.

take :: Int -> Deque a -> Deque a
take :: forall a. Int -> Deque a -> Deque a
take !Int
_ Deque a
Nil = Deque a
forall a. Deque a
Nil
take Int
i d :: Deque a
d@(Deep Int
t SList a
pr Mid a
m SList a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Deque a
forall a. Deque a
Nil
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Deque a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pc = Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
i Int
i Int
0) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
i SList a
pr) Mid a
forall a. Mid a
MNil SList a
forall a. SList a
SNil
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc = let !k :: Int
k = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc) in if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> Int -> SList a -> Mid a -> Deque a
forall a. Int -> Int -> SList a -> Mid a -> Deque a
deepR Int
i Int
pc SList a
pr Mid a
m else Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
i Int
pc Int
k) SList a
pr Mid a
m (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) SList a
sf)
  | Bool
otherwise = case Int -> Mid a -> (Mid a, Node a, Int)
forall a. Int -> Mid a -> (Mid a, Node a, Int)
takeM (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pc) Mid a
m of
      (Mid a
m', Node a
nd, Int
k) -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
i Int
pc Int
k) SList a
pr Mid a
m' (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node a
nd)
  where
    !n :: Int
n = Int -> Int
tsize Int
t
    !pc :: Int
pc = Int -> Int
tpc Int
t
    !sc :: Int
sc = Int -> Int
tsc Int
t

drop :: Int -> Deque a -> Deque a
drop :: forall a. Int -> Deque a -> Deque a
drop !Int
_ Deque a
Nil = Deque a
forall a. Deque a
Nil
drop Int
i d :: Deque a
d@(Deep Int
t SList a
pr Mid a
m SList a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Deque a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Deque a
forall a. Deque a
Nil
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc = let !r :: Int
r = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i in Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
r Int
0 Int
r) SList a
forall a. SList a
SNil Mid a
forall a. Mid a
MNil (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
r SList a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pc = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pc then Int -> Int -> Mid a -> SList a -> Deque a
forall a. Int -> Int -> Mid a -> SList a -> Deque a
deepL (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
sc Mid a
m SList a
sf else Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
sc) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
i SList a
pr) Mid a
m SList a
sf
  | Bool
otherwise = case Int -> Mid a -> (Node a, Int, Mid a)
forall a. Int -> Mid a -> (Node a, Int, Mid a)
dropM (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pc) Mid a
m of
      (Node a
nd, !Int
k, Mid a
m') ->
        Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) (Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Int
sc) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd Int
k Node a
nd) Mid a
m' SList a
sf
  where
    !n :: Int
n = Int -> Int
tsize Int
t
    !pc :: Int
pc = Int -> Int
tpc Int
t
    !sc :: Int
sc = Int -> Int
tsc Int
t

-- | @splitAt i d = (take i d, drop i d)@
splitAt :: Int -> Deque a -> (Deque a, Deque a)
splitAt :: forall a. Int -> Deque a -> (Deque a, Deque a)
splitAt Int
i Deque a
d = (Int -> Deque a -> Deque a
forall a. Int -> Deque a -> Deque a
take Int
i Deque a
d, Int -> Deque a -> Deque a
forall a. Int -> Deque a -> Deque a
drop Int
i Deque a
d)

-- The first j leaves, 0 < j <= size: the node holding the last of them, the
-- number of its leaves that are among them, and everything before that node.
takeM :: Int -> Mid a -> (Mid a, Node a, Int)
takeM :: forall a. Int -> Mid a -> (Mid a, Node a, Int)
takeM !Int
_ Mid a
MNil = [Char] -> (Mid a, Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.take: empty middle"
takeM Int
j (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf)
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ps = Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goP Int
0 Int
0 SList (Node a)
pr
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ms = case Int -> Mid (Node a) -> (Mid (Node a), Node (Node a), Int)
forall a. Int -> Mid a -> (Mid a, Node a, Int)
takeM (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps) Mid (Node a)
m of
      (Mid (Node a)
m', Node (Node a)
nn, !Int
k) -> case Int -> Node (Node a) -> (Int, Int)
forall a. Int -> Node (Node a) -> (Int, Int)
scanKids (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Node (Node a)
nn of
        -- the children of the node the level below cut in: those before the
        -- one holding the cut make the new suffix
        (!Int
q, !Int
sb) ->
          let !total :: Int
total = Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sb
           in case Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb of
                !Int
k'
                  | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Mid a
forall a. Mid a
MNil, Int -> Node (Node a) -> Node a
forall a. Int -> Node a -> a
nodeAt Int
q Node (Node a)
nn, Int
k')
                  | Int
q Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
forall a.
Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
mdeepR Int
total Int
pc Int
ps SList (Node a)
pr Mid (Node a)
m', Int -> Node (Node a) -> Node a
forall a. Int -> Node a -> a
nodeAt Int
q Node (Node a)
nn, Int
k')
                  | Bool
otherwise -> (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
total Int
pc Int
q) Int
ps SList (Node a)
pr Mid (Node a)
m' (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeTakeRev Int
q Node (Node a)
nn), Int -> Node (Node a) -> Node a
forall a. Int -> Node a -> a
nodeAt Int
q Node (Node a)
nn, Int
k')
  | Bool
otherwise = Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goS (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j) Int
sc SList (Node a)
sf
  where
    !n :: Int
n = Int -> Int
tsize Int
t
    !pc :: Int
pc = Int -> Int
tpc Int
t
    !sc :: Int
sc = Int -> Int
tsc Int
t
    !ms :: Int
ms = Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m
    -- q whole nodes of the prefix, with sb leaves, come before the cut
    goP :: Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goP !Int
q !Int
sb (SCons Node a
nd SList (Node a)
r)
      | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd =
          case Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb of
            Int
k
              | Int
q Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Mid a
forall a. Mid a
MNil, Node a
nd, Int
k)
              | Bool
otherwise -> (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
sb Int
q Int
0) Int
sb (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
q SList (Node a)
pr) Mid (Node a)
forall a. Mid a
MNil SList (Node a)
forall a. SList a
SNil, Node a
nd, Int
k)
      | Bool
otherwise = Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goP (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd) SList (Node a)
r
    goP Int
_ Int
_ SList (Node a)
SNil = [Char] -> (Mid a, Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.take: past the end of a prefix"
    -- r leaves are to go from the back; cnt nodes of the suffix are left
    goS :: Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goS !Int
r !Int
cnt (SCons Node a
nd SList (Node a)
rest)
      | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = Int -> Int -> SList (Node a) -> (Mid a, Node a, Int)
goS (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList (Node a)
rest
      | Bool
otherwise =
          let !keep :: Int
keep = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
              !total :: Int
total = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
keep
           in case Int
keep of
                Int
k
                  | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Mid a
forall a. Mid a
MNil, Node a
nd, Int
k)
                  | Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
forall a.
Int -> Int -> Int -> SList (Node a) -> Mid (Node a) -> Mid a
mdeepR Int
total Int
pc Int
ps SList (Node a)
pr Mid (Node a)
m, Node a
nd, Int
k)
                  | Bool
otherwise -> (Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
total Int
pc (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
rest, Node a
nd, Int
k)
      where
        !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd
    goS Int
_ Int
_ SList (Node a)
SNil = [Char] -> (Mid a, Node a, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.take: past the end of a suffix"

-- All but the first j leaves, 0 <= j < size: the node holding leaf j, the
-- number of its leaves to drop, and everything after that node.
dropM :: Int -> Mid a -> (Node a, Int, Mid a)
dropM :: forall a. Int -> Mid a -> (Node a, Int, Mid a)
dropM !Int
_ Mid a
MNil = [Char] -> (Node a, Int, Mid a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.drop: empty middle"
dropM Int
j (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf)
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ps = Int -> Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goP Int
j Int
pc Int
ps Int
n SList (Node a)
pr
  | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ms = case Int -> Mid (Node a) -> (Node (Node a), Int, Mid (Node a))
forall a. Int -> Mid a -> (Node a, Int, Mid a)
dropM (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps) Mid (Node a)
m of
      (Node (Node a)
nn, !Int
k, Mid (Node a)
m') -> case Int -> Node (Node a) -> (Int, Int)
forall a. Int -> Node (Node a) -> (Int, Int)
scanKids Int
k Node (Node a)
nn of
        -- the children of the node the level below cut in: those after the
        -- one holding the cut make the new prefix
        (!Int
q, !Int
sb) ->
          let !nd :: Node a
nd = Int -> Node (Node a) -> Node a
forall a. Int -> Node a -> a
nodeAt Int
q Node (Node a)
nn
              !c :: Int
c = Node (Node a) -> Int
forall a. Node a -> Int
nodeArity Node (Node a)
nn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
              !sa :: Int
sa = Node (Node a) -> Int
forall a. Node a -> Int
nodeSize Node (Node a)
nn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd
              !total :: Int
total = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ms)
           in case Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb of
                !Int
k'
                  | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Node a
nd, Int
k', Mid a
forall a. Mid a
MNil)
                  | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Node a
nd, Int
k', Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
forall a. Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
mdeepL Int
total Int
sc Mid (Node a)
m' SList (Node a)
sf)
                  | Bool
otherwise -> (Node a
nd, Int
k', Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
total Int
c Int
sc) Int
sa (Int -> Node (Node a) -> SList (Node a)
forall a. Int -> Node a -> SList a
nodeDropFwd (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Node (Node a)
nn) Mid (Node a)
m' SList (Node a)
sf)
  | Bool
otherwise = Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goS (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j) Int
0 Int
0 SList (Node a)
sf
  where
    !n :: Int
n = Int -> Int
tsize Int
t
    !pc :: Int
pc = Int -> Int
tpc Int
t
    !sc :: Int
sc = Int -> Int
tsc Int
t
    !ms :: Int
ms = Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m
    -- k leaves still to drop; the prefix has cnt nodes and psz leaves left,
    -- the tree tot leaves
    goP :: Int -> Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goP !Int
k !Int
cnt !Int
psz !Int
tot (SCons Node a
nd SList (Node a)
r)
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = Int -> Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goP (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
psz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList (Node a)
r
      | Bool
otherwise =
          case Int
k of
            Int
k
              | Int
tot Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s -> (Node a
nd, Int
k, Mid a
forall a. Mid a
MNil)
              | Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (Node a
nd, Int
k, Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
forall a. Int -> Int -> Mid (Node a) -> SList (Node a) -> Mid a
mdeepL (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Int
sc Mid (Node a)
m SList (Node a)
sf)
              | Bool
otherwise -> (Node a
nd, Int
k, Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
sc) (Int
psz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList (Node a)
r Mid (Node a)
m SList (Node a)
sf)
      where
        !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd
    goP Int
_ Int
_ Int
_ Int
_ SList (Node a)
SNil = [Char] -> (Node a, Int, Mid a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.drop: past the end of a prefix"
    -- r leaves come after leaf j; c nodes of the suffix, with sa leaves, are
    -- wholly after it
    goS :: Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goS !Int
r !Int
c !Int
sa (SCons Node a
nd SList (Node a)
rest)
      | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = Int -> Int -> Int -> SList (Node a) -> (Node a, Int, Mid a)
goS (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) SList (Node a)
rest
      | Bool
otherwise =
          case Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r of
            !Int
k
              | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> (Node a
nd, Int
k, Mid a
forall a. Mid a
MNil)
              | Bool
otherwise -> (Node a
nd, Int
k, Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
sa Int
0 Int
c) Int
0 SList (Node a)
forall a. SList a
SNil Mid (Node a)
forall a. Mid a
MNil (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
c SList (Node a)
sf))
      where
        !s :: Int
s = Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd
    goS Int
_ Int
_ Int
_ SList (Node a)
SNil = [Char] -> (Node a, Int, Mid a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.drop: past the end of a suffix"

------------------------------------------------------------------------
-- Append.  The digits that end up inside (the left side's suffix and the
-- right side's prefix) either join the outer digit of a side that has no
-- middle, when they fit there, or are packed into nodes and handed down
-- between the two middles.

append :: Deque a -> Deque a -> Deque a
append :: forall a. Deque a -> Deque a -> Deque a
append Deque a
Nil Deque a
b = Deque a
b
append Deque a
a Deque a
Nil = Deque a
a
append a :: Deque a
a@(Deep Int
t1 SList a
pr1 Mid a
m1 SList a
sf1) b :: Deque a
b@(Deep Int
t2 SList a
pr2 Mid a
m2 SList a
sf2)
  | Mid a
MNil <- Mid a
m1,
    Int -> Int
tpc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) (Int -> Int
tsc Int
t2)) (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
appendS SList a
pr1 (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
sf1 SList a
pr2)) Mid a
m2 SList a
sf2
  | Mid a
MNil <- Mid a
m2,
    Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsc Int
t2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsc Int
t2)) SList a
pr1 Mid a
m1 (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
appendS SList a
sf2 (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
pr2 SList a
sf1))
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2,
    Int
t1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0,
    Int
t2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
      Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1) (Int -> Int
tsc Int
t2)) SList a
pr1 (Mid a -> Int -> SList (Node a) -> Mid a -> Mid a
forall a. Mid a -> Int -> SList (Node a) -> Mid a -> Mid a
appM Mid a
m1 Int
c (Int -> Int -> SList a -> SList a -> SList (Node a)
forall a. Int -> Int -> SList a -> SList a -> SList (Node a)
packLeaves Int
c (Int -> Int
tsc Int
t1) SList a
sf1 SList a
pr2) Mid a
m2) SList a
sf2
  -- what is left: a side with no middle whose outer digit is empty, or a
  -- single item inside
  | Mid a
MNil <- Mid a
m1 = SList a -> Deque a -> Deque a
forall a. SList a -> Deque a -> Deque a
consEach (SList a -> SList a
forall a. SList a -> SList a
revS SList a
pr1) (SList a -> Deque a -> Deque a
forall a. SList a -> Deque a -> Deque a
consEach SList a
sf1 Deque a
b)
  | Bool
otherwise = Deque a -> SList a -> Deque a
forall a. Deque a -> SList a -> Deque a
snocEach (Deque a -> SList a -> Deque a
forall a. Deque a -> SList a -> Deque a
snocEach Deque a
a SList a
pr2) (SList a -> SList a
forall a. SList a -> SList a
revS SList a
sf2)
  where
    !n :: Int
n = Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsize Int
t2
    !c :: Int
c = Int -> Int
tsc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tpc Int
t2

-- cons each item, in list order (so the list runs back to front)
consEach :: SList a -> Deque a -> Deque a
consEach :: forall a. SList a -> Deque a -> Deque a
consEach SList a
SNil Deque a
d = Deque a
d
consEach (SCons a
x SList a
r) Deque a
d = SList a -> Deque a -> Deque a
forall a. SList a -> Deque a -> Deque a
consEach SList a
r (a -> Deque a -> Deque a
forall a. a -> Deque a -> Deque a
cons a
x Deque a
d)

snocEach :: Deque a -> SList a -> Deque a
snocEach :: forall a. Deque a -> SList a -> Deque a
snocEach Deque a
d SList a
SNil = Deque a
d
snocEach Deque a
d (SCons a
x SList a
r) = Deque a -> SList a -> Deque a
forall a. Deque a -> SList a -> Deque a
snocEach (Deque a -> a -> Deque a
forall a. Deque a -> a -> Deque a
snoc Deque a
d a
x) SList a
r

-- A node of the first k items of a list, which are leaves.
leafNode :: Int -> SList a -> Node a
leafNode :: forall a. Int -> SList a -> Node a
leafNode Int
8 (SCons a
a (SCons a
b (SCons a
c (SCons a
d (SCons a
e (SCons a
f (SCons a
g (SCons a
h SList a
_)))))))) = a -> a -> a -> a -> a -> a -> a -> a -> Node a
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Node a
N8 a
a a
b a
c a
d a
e a
f a
g a
h
leafNode Int
k SList a
l = Int -> Arr a -> Node a
forall a. Int -> Arr a -> Node a
NA Int
k (Int -> SList a -> Arr a
forall a. Int -> SList a -> Arr a
fromSListA Int
k SList a
l)

-- The leaves between two middles, as nodes: a suffix (back to front, nb
-- items) and then a prefix, c items in all.  c is 0 or 2 to 2 * maxD.  The
-- nodes have eight leaves while that leaves none or at least two for the
-- next (nine make a five and a four).
packLeaves :: Int -> Int -> SList a -> SList a -> SList (Node a)
packLeaves :: forall a. Int -> Int -> SList a -> SList a -> SList (Node a)
packLeaves Int
c Int
nb SList a
back SList a
front
  | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = SList (Node a)
forall a. SList a
SNil
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (Int -> Arr a -> Node a
forall a. Int -> Arr a -> Node a
NA Int
c (Int -> Int -> SList a -> SList a -> SList a -> Arr a
forall a. Int -> Int -> SList a -> SList a -> SList a -> Arr a
gather Int
c Int
nb SList a
back SList a
forall a. SList a
SNil SList a
front)) SList (Node a)
forall a. SList a
SNil
  | Bool
otherwise = Int -> SList a -> SList (Node a)
forall {a}. Int -> SList a -> SList (Node a)
go Int
c (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
back SList a
front)
  where
    go :: Int -> SList a -> SList (Node a)
go !Int
left SList a
l
      | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = SList (Node a)
forall a. SList a
SNil
      | Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 = Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (Int -> SList a -> Node a
forall a. Int -> SList a -> Node a
leafNode Int
left SList a
l) SList (Node a)
forall a. SList a
SNil
      | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9 = Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (Int -> SList a -> Node a
forall a. Int -> SList a -> Node a
leafNode Int
5 SList a
l) (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (Int -> SList a -> Node a
forall a. Int -> SList a -> Node a
leafNode Int
4 (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
5 SList a
l)) SList (Node a)
forall a. SList a
SNil)
      | Bool
otherwise = Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (Int -> SList a -> Node a
forall a. Int -> SList a -> Node a
leafNode Int
8 SList a
l) (Int -> SList a -> SList (Node a)
go (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
dropS Int
8 SList a
l))

-- The same one level down: a suffix, the nodes handed down, a prefix; c
-- nodes in all, at least 2, with sz leaves under them.
packNodes :: Int -> Int -> Int -> SList (Node a) -> SList (Node a) -> SList (Node a) -> SList (Node (Node a))
packNodes :: forall a.
Int
-> Int
-> Int
-> SList (Node a)
-> SList (Node a)
-> SList (Node a)
-> SList (Node (Node a))
packNodes Int
c Int
sz Int
nb SList (Node a)
back SList (Node a)
mid SList (Node a)
front
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 = Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
sz Arr (Node a)
items) SList (Node (Node a))
forall a. SList a
SNil
  | Bool
otherwise =
      -- two or three nodes of about the same number of children
      let !q :: Int
q = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3
          !k1 :: Int
k1 = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
q
          !x :: Arr (Node a)
x = Arr (Node a) -> Int -> Int -> Arr (Node a)
forall a. Arr a -> Int -> Int -> Arr a
sliceA Arr (Node a)
items Int
0 Int
k1
          !sx :: Int
sx = Arr (Node a) -> Int
forall a. Arr (Node a) -> Int
sumA Arr (Node a)
x
       in if Int
q Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
            then Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
sx Arr (Node a)
x) (Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) (Arr (Node a) -> Int -> Int -> Arr (Node a)
forall a. Arr a -> Int -> Int -> Arr a
sliceA Arr (Node a)
items Int
k1 (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1))) SList (Node (Node a))
forall a. SList a
SNil)
            else
              let !k2 :: Int
k2 = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                  !y :: Arr (Node a)
y = Arr (Node a) -> Int -> Int -> Arr (Node a)
forall a. Arr a -> Int -> Int -> Arr a
sliceA Arr (Node a)
items Int
k1 Int
k2
                  !sy :: Int
sy = Arr (Node a) -> Int
forall a. Arr (Node a) -> Int
sumA Arr (Node a)
y
               in Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
sx Arr (Node a)
x) (Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
sy Arr (Node a)
y) (Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sy) (Arr (Node a) -> Int -> Int -> Arr (Node a)
forall a. Arr a -> Int -> Int -> Arr a
sliceA Arr (Node a)
items (Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k2) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k2))) SList (Node (Node a))
forall a. SList a
SNil))
  where
    !items :: Arr (Node a)
items = Int
-> Int
-> SList (Node a)
-> SList (Node a)
-> SList (Node a)
-> Arr (Node a)
forall a. Int -> Int -> SList a -> SList a -> SList a -> Arr a
gather Int
c Int
nb SList (Node a)
back SList (Node a)
mid SList (Node a)
front

consEachM :: SList (Node a) -> Mid a -> Mid a
consEachM :: forall a. SList (Node a) -> Mid a -> Mid a
consEachM SList (Node a)
SNil Mid a
d = Mid a
d
consEachM (SCons Node a
x SList (Node a)
r) Mid a
d = SList (Node a) -> Mid a -> Mid a
forall a. SList (Node a) -> Mid a -> Mid a
consEachM SList (Node a)
r (Node a -> Mid a -> Mid a
forall a. Node a -> Mid a -> Mid a
consM Node a
x Mid a
d)

snocEachM :: Mid a -> SList (Node a) -> Mid a
snocEachM :: forall a. Mid a -> SList (Node a) -> Mid a
snocEachM Mid a
d SList (Node a)
SNil = Mid a
d
snocEachM Mid a
d (SCons Node a
x SList (Node a)
r) = Mid a -> SList (Node a) -> Mid a
forall a. Mid a -> SList (Node a) -> Mid a
snocEachM (Mid a -> Node a -> Mid a
forall a. Mid a -> Node a -> Mid a
snocM Mid a
d Node a
x) SList (Node a)
r

-- The nodes between the two middles run front to back and hold sns leaves.
appM :: Mid a -> Int -> SList (Node a) -> Mid a -> Mid a
appM :: forall a. Mid a -> Int -> SList (Node a) -> Mid a -> Mid a
appM Mid a
MNil Int
_ SList (Node a)
ns Mid a
b = SList (Node a) -> Mid a -> Mid a
forall a. SList (Node a) -> Mid a -> Mid a
consEachM (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
ns) Mid a
b
appM Mid a
a Int
_ SList (Node a)
ns Mid a
MNil = Mid a -> SList (Node a) -> Mid a
forall a. Mid a -> SList (Node a) -> Mid a
snocEachM Mid a
a SList (Node a)
ns
appM a :: Mid a
a@(MDeep Int
t1 Int
ps1 SList (Node a)
pr1 Mid (Node a)
m1 SList (Node a)
sf1) Int
sns SList (Node a)
ns b :: Mid a
b@(MDeep Int
t2 Int
ps2 SList (Node a)
pr2 Mid (Node a)
m2 SList (Node a)
sf2)
  | Mid (Node a)
MNil <- Mid (Node a)
m1,
    Int -> Int
tpc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) (Int -> Int
tsc Int
t2)) (Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ps2) (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
appendS SList (Node a)
pr1 (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
revOnto SList (Node a)
sf1 (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
appendS SList (Node a)
ns SList (Node a)
pr2))) Mid (Node a)
m2 SList (Node a)
sf2
  | Mid (Node a)
MNil <- Mid (Node a)
m2,
    Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsc Int
t2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsc Int
t2)) Int
ps1 SList (Node a)
pr1 Mid (Node a)
m1 (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
appendS SList (Node a)
sf2 (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
revOnto SList (Node a)
pr2 (SList (Node a) -> SList (Node a) -> SList (Node a)
forall a. SList a -> SList a -> SList a
revOnto SList (Node a)
ns SList (Node a)
sf1)))
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2,
    Int
t1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0,
    Int
t2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xF0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
      let !sz :: Int
sz = (Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ps2
       in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk Int
n (Int -> Int
tpc Int
t1) (Int -> Int
tsc Int
t2)) Int
ps1 SList (Node a)
pr1 (Mid (Node a)
-> Int -> SList (Node (Node a)) -> Mid (Node a) -> Mid (Node a)
forall a. Mid a -> Int -> SList (Node a) -> Mid a -> Mid a
appM Mid (Node a)
m1 Int
sz (Int
-> Int
-> Int
-> SList (Node a)
-> SList (Node a)
-> SList (Node a)
-> SList (Node (Node a))
forall a.
Int
-> Int
-> Int
-> SList (Node a)
-> SList (Node a)
-> SList (Node a)
-> SList (Node (Node a))
packNodes Int
c Int
sz (Int -> Int
tsc Int
t1) SList (Node a)
sf1 SList (Node a)
ns SList (Node a)
pr2) Mid (Node a)
m2) SList (Node a)
sf2
  | Mid (Node a)
MNil <- Mid (Node a)
m1 = SList (Node a) -> Mid a -> Mid a
forall a. SList (Node a) -> Mid a -> Mid a
consEachM (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
pr1) (SList (Node a) -> Mid a -> Mid a
forall a. SList (Node a) -> Mid a -> Mid a
consEachM SList (Node a)
sf1 (SList (Node a) -> Mid a -> Mid a
forall a. SList (Node a) -> Mid a -> Mid a
consEachM (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
ns) Mid a
b))
  | Bool
otherwise = Mid a -> SList (Node a) -> Mid a
forall a. Mid a -> SList (Node a) -> Mid a
snocEachM (Mid a -> SList (Node a) -> Mid a
forall a. Mid a -> SList (Node a) -> Mid a
snocEachM (Mid a -> SList (Node a) -> Mid a
forall a. Mid a -> SList (Node a) -> Mid a
snocEachM Mid a
a SList (Node a)
ns) SList (Node a)
pr2) (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
sf2)
  where
    !n :: Int
n = Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsize Int
t2
    !c :: Int
c = Int -> Int
tsc Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SList (Node a) -> Int
forall a. SList a -> Int
lenS SList (Node a)
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tpc Int
t2

------------------------------------------------------------------------
-- Lists

-- | The elements in order.  Lazy: the list is produced as it is consumed.
toList :: Deque a -> [a]
toList :: forall a. Deque a -> [a]
toList = (a -> [a] -> [a]) -> [a] -> Deque a -> [a]
forall a r. (a -> r -> r) -> r -> Deque a -> r
foldrI (:) []

-- | O(n).  A fold, so that it fuses with a list that is being produced.
fromList :: [a] -> Deque a
fromList :: forall a. [a] -> Deque a
fromList = (Deque a -> a -> Deque a) -> Deque a -> [a] -> Deque a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Deque a -> a -> Deque a
forall a. Deque a -> a -> Deque a
snoc Deque a
forall a. Deque a
Nil
{-# INLINE fromList #-}

-- | 'fromList' for a list whose length is known.  O(n).  Exactly @n@
-- elements are taken; a shorter list is an error.  ('unsafeFromListN' is
-- the same without the check, for a caller that built the list to length.)
fromListN :: Int -> [a] -> Deque a
fromListN :: forall a. Int -> [a] -> Deque a
fromListN Int
n [a]
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Deque a
forall a. Deque a
Nil
  | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
front Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = [Char] -> Deque a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Deque.fromListN: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" elements asked for, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
front) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" given")
  | Bool
otherwise = Int -> [a] -> Deque a
forall a. Int -> [a] -> Deque a
unsafeFromListN Int
n [a]
front
  where
    front :: [a]
front = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
n [a]
xs

-- | 'fromListN' for a list known to have exactly @n@ elements.  O(n).  Builds
-- the levels directly: each gets a prefix of two to nine items and a suffix
-- of five, and what is between them goes, in nodes of eight, to the level
-- below.  The count is trusted: with more elements than @n@ the suffix
-- holds them all while the packed count says five, and a later append
-- writes outside an array.
unsafeFromListN :: Int -> [a] -> Deque a
unsafeFromListN :: forall a. Int -> [a] -> Deque a
unsafeFromListN Int
n [a]
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Deque a
forall a. Deque a
Nil
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      let !p :: Int
p = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
       in case Int -> [a] -> (SList a, [a])
forall a. Int -> [a] -> (SList a, [a])
takeL Int
p [a]
xs of
            (SList a
pl, [a]
rest) -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
p (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p)) SList a
pl Mid a
forall a. Mid a
MNil ([a] -> SList a
forall a. [a] -> SList a
revL [a]
rest)
  | Bool
otherwise =
      let !k :: Int
k = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          !p :: Int
p = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k
       in case Int -> [a] -> (SList a, [a])
forall a. Int -> [a] -> (SList a, [a])
takeL Int
p [a]
xs of
            (SList a
pl, [a]
rest) -> case Int -> [a] -> (SList (Node a), [a])
forall a. Int -> [a] -> (SList (Node a), [a])
leafNodes Int
k [a]
rest of
              (SList (Node a)
nodes, [a]
rest') -> Int -> SList a -> Mid a -> SList a -> Deque a
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
p Int
5) SList a
pl (Int -> Int -> SList (Node a) -> Mid a
forall a. Int -> Int -> SList (Node a) -> Mid a
buildMid Int
8 Int
k SList (Node a)
nodes) ([a] -> SList a
forall a. [a] -> SList a
revL [a]
rest')

-- the first k elements, in order, and the rest (k is small)
takeL :: Int -> [a] -> (SList a, [a])
takeL :: forall a. Int -> [a] -> (SList a, [a])
takeL Int
0 [a]
ys = (SList a
forall a. SList a
SNil, [a]
ys)
takeL Int
k (a
y : [a]
ys) = case Int -> [a] -> (SList a, [a])
forall a. Int -> [a] -> (SList a, [a])
takeL (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
ys of (SList a
l, [a]
r) -> (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
y SList a
l, [a]
r)
takeL Int
_ [] = (SList a
forall a. SList a
SNil, [])

revL :: [a] -> SList a
revL :: forall a. [a] -> SList a
revL = SList a -> [a] -> SList a
forall {a}. SList a -> [a] -> SList a
go SList a
forall a. SList a
SNil
  where
    go :: SList a -> [a] -> SList a
go SList a
acc [] = SList a
acc
    go SList a
acc (a
y : [a]
ys) = SList a -> [a] -> SList a
go (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
y SList a
acc) [a]
ys

-- k nodes of eight elements each from the front of a list, in order
leafNodes :: Int -> [a] -> (SList (Node a), [a])
leafNodes :: forall a. Int -> [a] -> (SList (Node a), [a])
leafNodes = SList (Node a) -> Int -> [a] -> (SList (Node a), [a])
forall {t} {a}.
(Eq t, Num t) =>
SList (Node a) -> t -> [a] -> (SList (Node a), [a])
go SList (Node a)
forall a. SList a
SNil
  where
    go :: SList (Node a) -> t -> [a] -> (SList (Node a), [a])
go SList (Node a)
acc t
0 [a]
ys = (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
acc, [a]
ys)
    go SList (Node a)
acc t
k (a
a : a
b : a
c : a
d : a
e : a
f : a
g : a
h : [a]
ys) = SList (Node a) -> t -> [a] -> (SList (Node a), [a])
go (Node a -> SList (Node a) -> SList (Node a)
forall a. a -> SList a -> SList a
SCons (a -> a -> a -> a -> a -> a -> a -> a -> Node a
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Node a
N8 a
a a
b a
c a
d a
e a
f a
g a
h) SList (Node a)
acc) (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [a]
ys
    go SList (Node a)
_ t
_ [a]
_ = [Char] -> (SList (Node a), [a])
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.fromList: the list is shorter than its length"

-- c nodes of s leaves each, in order
buildMid :: Int -> Int -> SList (Node a) -> Mid a
buildMid :: forall a. Int -> Int -> SList (Node a) -> Mid a
buildMid !Int
s !Int
c SList (Node a)
ns
  | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Mid a
forall a. Mid a
MNil
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
      let !p :: Int
p = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
       in Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) Int
p (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p)) (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
p SList (Node a)
ns) Mid (Node a)
forall a. Mid a
MNil (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
p SList (Node a)
ns))
  | Bool
otherwise =
      let !k :: Int
k = (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          !p :: Int
p = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k
       in case Int
-> SList (Node (Node a))
-> Int
-> SList (Node a)
-> (SList (Node (Node a)), SList (Node a))
forall a.
Int
-> SList (Node (Node a))
-> Int
-> SList (Node a)
-> (SList (Node (Node a)), SList (Node a))
innerNodes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) SList (Node (Node a))
forall a. SList a
SNil Int
k (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
dropS Int
p SList (Node a)
ns) of
            (SList (Node (Node a))
nodes, SList (Node a)
rest) -> Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep (Int -> Int -> Int -> Int
mk (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) Int
p Int
5) (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) (Int -> SList (Node a) -> SList (Node a)
forall a. Int -> SList a -> SList a
takeS Int
p SList (Node a)
ns) (Int -> Int -> SList (Node (Node a)) -> Mid (Node a)
forall a. Int -> Int -> SList (Node a) -> Mid a
buildMid (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) Int
k SList (Node (Node a))
nodes) (SList (Node a) -> SList (Node a)
forall a. SList a -> SList a
revS SList (Node a)
rest)

innerNodes :: Int -> SList (Node (Node a)) -> Int -> SList (Node a) -> (SList (Node (Node a)), SList (Node a))
innerNodes :: forall a.
Int
-> SList (Node (Node a))
-> Int
-> SList (Node a)
-> (SList (Node (Node a)), SList (Node a))
innerNodes !Int
_ SList (Node (Node a))
acc Int
0 SList (Node a)
ys = (SList (Node (Node a)) -> SList (Node (Node a))
forall a. SList a -> SList a
revS SList (Node (Node a))
acc, SList (Node a)
ys)
innerNodes Int
s SList (Node (Node a))
acc Int
k (SCons Node a
a (SCons Node a
b (SCons Node a
c (SCons Node a
d (SCons Node a
e (SCons Node a
f (SCons Node a
g (SCons Node a
h SList (Node a)
ys)))))))) =
  Int
-> SList (Node (Node a))
-> Int
-> SList (Node a)
-> (SList (Node (Node a)), SList (Node a))
forall a.
Int
-> SList (Node (Node a))
-> Int
-> SList (Node a)
-> (SList (Node (Node a)), SList (Node a))
innerNodes Int
s (Node (Node a) -> SList (Node (Node a)) -> SList (Node (Node a))
forall a. a -> SList a -> SList a
SCons (Int -> Arr (Node a) -> Node (Node a)
forall a. Int -> Arr a -> Node a
NA Int
s (Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Node a
-> Arr (Node a)
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Arr a
arr8 Node a
a Node a
b Node a
c Node a
d Node a
e Node a
f Node a
g Node a
h)) SList (Node (Node a))
acc) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList (Node a)
ys
innerNodes Int
_ SList (Node (Node a))
_ Int
_ SList (Node a)
_ = [Char] -> (SList (Node (Node a)), SList (Node a))
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.fromList: short list of nodes"

-- | @fromFunction n f@ is @f 0, f 1, ..., f (n - 1)@.
fromFunction :: Int -> (Int -> a) -> Deque a
fromFunction :: forall a. Int -> (Int -> a) -> Deque a
fromFunction Int
n Int -> a
f
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Deque a
forall a. HasCallStack => [Char] -> a
error [Char]
"Deque.fromFunction called with negative len"
  | Bool
otherwise = Int -> [a] -> Deque a
forall a. Int -> [a] -> Deque a
unsafeFromListN Int
n ((Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
L.map Int -> a
f [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])

------------------------------------------------------------------------
-- Folds.  Each walks the prefix, then the middle, then the suffix.  Below
-- the top level an item is a node, so the function handed down folds over a
-- node's children.

-- | Right fold, lazy in the accumulator.
foldrD :: (a -> r -> r) -> r -> Deque a -> r
foldrD :: forall a r. (a -> r -> r) -> r -> Deque a -> r
foldrD a -> r -> r
_ r
z Deque a
Nil = r
z
foldrD a -> r -> r
f r
z (Deep Int
_ SList a
pr Mid a
m SList a
sf) = (a -> r -> r) -> r -> SList a -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrS a -> r -> r
f ((Node a -> r -> r) -> r -> Mid a -> r
forall a r. (Node a -> r -> r) -> r -> Mid a -> r
foldrM ((a -> r -> r) -> Node a -> r -> r
forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNode a -> r -> r
f) ((a -> r -> r) -> r -> SList a -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrRev a -> r -> r
f r
z SList a
sf) Mid a
m) SList a
pr

-- The same, inlined where it is used, so that a known function is applied
-- directly to the children of the leaf nodes, where nearly all the elements
-- are.  With (:) that builds a leaf's eight cells with no calls in between.
foldrI :: (a -> r -> r) -> r -> Deque a -> r
foldrI :: forall a r. (a -> r -> r) -> r -> Deque a -> r
foldrI a -> r -> r
_ r
z Deque a
Nil = r
z
foldrI a -> r -> r
f r
z (Deep Int
_ SList a
pr Mid a
m SList a
sf) = (a -> r -> r) -> r -> SList a -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrS a -> r -> r
f ((Node a -> r -> r) -> r -> Mid a -> r
forall a r. (Node a -> r -> r) -> r -> Mid a -> r
foldrM (\Node a
nd r
acc -> (a -> r -> r) -> Node a -> r -> r
forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNodeI a -> r -> r
f Node a
nd r
acc) ((a -> r -> r) -> r -> SList a -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrRev a -> r -> r
f r
z SList a
sf) Mid a
m) SList a
pr
{-# INLINE foldrI #-}

foldrNodeI :: (a -> r -> r) -> Node a -> r -> r
foldrNodeI :: forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNodeI a -> r -> r
fn (N8 a
a a
b a
c a
d a
e a
f a
g a
h) r
z = a -> r -> r
fn a
a (a -> r -> r
fn a
b (a -> r -> r
fn a
c (a -> r -> r
fn a
d (a -> r -> r
fn a
e (a -> r -> r
fn a
f (a -> r -> r
fn a
g (a -> r -> r
fn a
h r
z)))))))
foldrNodeI a -> r -> r
fn (NA Int
_ Arr a
a) r
z = (a -> r -> r) -> r -> Arr a -> r
forall a r. (a -> r -> r) -> r -> Arr a -> r
foldrA a -> r -> r
fn r
z Arr a
a
{-# INLINE foldrNodeI #-}

foldrM :: (Node a -> r -> r) -> r -> Mid a -> r
foldrM :: forall a r. (Node a -> r -> r) -> r -> Mid a -> r
foldrM Node a -> r -> r
_ r
z Mid a
MNil = r
z
foldrM Node a -> r -> r
f r
z (MDeep Int
_ Int
_ SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = (Node a -> r -> r) -> r -> SList (Node a) -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrS Node a -> r -> r
f ((Node (Node a) -> r -> r) -> r -> Mid (Node a) -> r
forall a r. (Node a -> r -> r) -> r -> Mid a -> r
foldrM ((Node a -> r -> r) -> Node (Node a) -> r -> r
forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNode Node a -> r -> r
f) ((Node a -> r -> r) -> r -> SList (Node a) -> r
forall a r. (a -> r -> r) -> r -> SList a -> r
foldrRev Node a -> r -> r
f r
z SList (Node a)
sf) Mid (Node a)
m) SList (Node a)
pr

foldrS :: (a -> r -> r) -> r -> SList a -> r
foldrS :: forall a r. (a -> r -> r) -> r -> SList a -> r
foldrS a -> r -> r
f r
z = SList a -> r
go
  where
    go :: SList a -> r
go SList a
SNil = r
z
    go (SCons a
x SList a
r) = a -> r -> r
f a
x (SList a -> r
go SList a
r)

-- a right fold over a list that runs back to front
foldrRev :: (a -> r -> r) -> r -> SList a -> r
foldrRev :: forall a r. (a -> r -> r) -> r -> SList a -> r
foldrRev a -> r -> r
f = r -> SList a -> r
go
  where
    go :: r -> SList a -> r
go r
acc SList a
SNil = r
acc
    go r
acc (SCons a
x SList a
r) = r -> SList a -> r
go (a -> r -> r
f a
x r
acc) SList a
r

foldrNode :: (a -> r -> r) -> Node a -> r -> r
foldrNode :: forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNode a -> r -> r
fn (N8 a
a a
b a
c a
d a
e a
f a
g a
h) r
z = a -> r -> r
fn a
a (a -> r -> r
fn a
b (a -> r -> r
fn a
c (a -> r -> r
fn a
d (a -> r -> r
fn a
e (a -> r -> r
fn a
f (a -> r -> r
fn a
g (a -> r -> r
fn a
h r
z)))))))
foldrNode a -> r -> r
fn (NA Int
_ Arr a
a) r
z = (a -> r -> r) -> r -> Arr a -> r
forall a r. (a -> r -> r) -> r -> Arr a -> r
foldrA a -> r -> r
fn r
z Arr a
a

-- | Strict left fold.
foldlD' :: (r -> a -> r) -> r -> Deque a -> r
foldlD' :: forall r a. (r -> a -> r) -> r -> Deque a -> r
foldlD' r -> a -> r
_ !r
z Deque a
Nil = r
z
foldlD' r -> a -> r
f r
z (Deep Int
_ SList a
pr Mid a
m SList a
sf) = (r -> a -> r) -> r -> SList a -> r
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlRev r -> a -> r
f ((r -> Node a -> r) -> r -> Mid a -> r
forall r a. (r -> Node a -> r) -> r -> Mid a -> r
foldlM ((r -> a -> r) -> r -> Node a -> r
forall r a. (r -> a -> r) -> r -> Node a -> r
foldlNode r -> a -> r
f) ((r -> a -> r) -> r -> SList a -> r
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlS r -> a -> r
f r
z SList a
pr) Mid a
m) SList a
sf

foldlM :: (r -> Node a -> r) -> r -> Mid a -> r
foldlM :: forall r a. (r -> Node a -> r) -> r -> Mid a -> r
foldlM r -> Node a -> r
_ !r
z Mid a
MNil = r
z
foldlM r -> Node a -> r
f r
z (MDeep Int
_ Int
_ SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = (r -> Node a -> r) -> r -> SList (Node a) -> r
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlRev r -> Node a -> r
f ((r -> Node (Node a) -> r) -> r -> Mid (Node a) -> r
forall r a. (r -> Node a -> r) -> r -> Mid a -> r
foldlM ((r -> Node a -> r) -> r -> Node (Node a) -> r
forall r a. (r -> a -> r) -> r -> Node a -> r
foldlNode r -> Node a -> r
f) ((r -> Node a -> r) -> r -> SList (Node a) -> r
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlS r -> Node a -> r
f r
z SList (Node a)
pr) Mid (Node a)
m) SList (Node a)
sf

foldlS :: (r -> a -> r) -> r -> SList a -> r
foldlS :: forall r a. (r -> a -> r) -> r -> SList a -> r
foldlS r -> a -> r
f = r -> SList a -> r
go
  where
    go :: r -> SList a -> r
go !r
z SList a
SNil = r
z
    go !r
z (SCons a
x SList a
r) = r -> SList a -> r
go (r -> a -> r
f r
z a
x) SList a
r

-- a strict left fold over a list that runs back to front
foldlRev :: (r -> a -> r) -> r -> SList a -> r
foldlRev :: forall r a. (r -> a -> r) -> r -> SList a -> r
foldlRev r -> a -> r
f !r
z = SList a -> r
go
  where
    go :: SList a -> r
go SList a
SNil = r
z
    go (SCons a
x SList a
r) = let !a :: r
a = SList a -> r
go SList a
r in r -> a -> r
f r
a a
x

foldlNode :: (r -> a -> r) -> r -> Node a -> r
foldlNode :: forall r a. (r -> a -> r) -> r -> Node a -> r
foldlNode r -> a -> r
fn !r
z (N8 a
a a
b a
c a
d a
e a
f a
g a
h) =
  let !z1 :: r
z1 = r -> a -> r
fn r
z a
a; !z2 :: r
z2 = r -> a -> r
fn r
z1 a
b; !z3 :: r
z3 = r -> a -> r
fn r
z2 a
c; !z4 :: r
z4 = r -> a -> r
fn r
z3 a
d; !z5 :: r
z5 = r -> a -> r
fn r
z4 a
e; !z6 :: r
z6 = r -> a -> r
fn r
z5 a
f; !z7 :: r
z7 = r -> a -> r
fn r
z6 a
g
   in r -> a -> r
fn r
z7 a
h
foldlNode r -> a -> r
fn !r
z (NA Int
_ Arr a
a) = (r -> a -> r) -> r -> Arr a -> r
forall r a. (r -> a -> r) -> r -> Arr a -> r
foldlA r -> a -> r
fn r
z Arr a
a

------------------------------------------------------------------------
-- Mapping keeps the shape

mapD :: (a -> b) -> Deque a -> Deque b
mapD :: forall a b. (a -> b) -> Deque a -> Deque b
mapD a -> b
_ Deque a
Nil = Deque b
forall a. Deque a
Nil
mapD a -> b
f (Deep Int
t SList a
pr Mid a
m SList a
sf) = Int -> SList b -> Mid b -> SList b -> Deque b
forall a. Int -> SList a -> Mid a -> SList a -> Deque a
Deep Int
t ((a -> b) -> SList a -> SList b
forall a b. (a -> b) -> SList a -> SList b
mapS a -> b
f SList a
pr) ((Node a -> Node b) -> Mid a -> Mid b
forall a b. (Node a -> Node b) -> Mid a -> Mid b
mapM' ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
mapNode a -> b
f) Mid a
m) ((a -> b) -> SList a -> SList b
forall a b. (a -> b) -> SList a -> SList b
mapS a -> b
f SList a
sf)

mapM' :: (Node a -> Node b) -> Mid a -> Mid b
mapM' :: forall a b. (Node a -> Node b) -> Mid a -> Mid b
mapM' Node a -> Node b
_ Mid a
MNil = Mid b
forall a. Mid a
MNil
mapM' Node a -> Node b
f (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = Int
-> Int -> SList (Node b) -> Mid (Node b) -> SList (Node b) -> Mid b
forall a.
Int
-> Int -> SList (Node a) -> Mid (Node a) -> SList (Node a) -> Mid a
MDeep Int
t Int
ps ((Node a -> Node b) -> SList (Node a) -> SList (Node b)
forall a b. (a -> b) -> SList a -> SList b
mapS Node a -> Node b
f SList (Node a)
pr) ((Node (Node a) -> Node (Node b)) -> Mid (Node a) -> Mid (Node b)
forall a b. (Node a -> Node b) -> Mid a -> Mid b
mapM' ((Node a -> Node b) -> Node (Node a) -> Node (Node b)
forall a b. (a -> b) -> Node a -> Node b
mapNode Node a -> Node b
f) Mid (Node a)
m) ((Node a -> Node b) -> SList (Node a) -> SList (Node b)
forall a b. (a -> b) -> SList a -> SList b
mapS Node a -> Node b
f SList (Node a)
sf)

mapS :: (a -> b) -> SList a -> SList b
mapS :: forall a b. (a -> b) -> SList a -> SList b
mapS a -> b
f = SList a -> SList b
go
  where
    go :: SList a -> SList b
go SList a
SNil = SList b
forall a. SList a
SNil
    go (SCons a
x SList a
r) = b -> SList b -> SList b
forall a. a -> SList a -> SList a
SCons (a -> b
f a
x) (SList a -> SList b
go SList a
r)

mapNode :: (a -> b) -> Node a -> Node b
mapNode :: forall a b. (a -> b) -> Node a -> Node b
mapNode a -> b
fn (N8 a
a a
b a
c a
d a
e a
f a
g a
h) = b -> b -> b -> b -> b -> b -> b -> b -> Node b
forall a. a -> a -> a -> a -> a -> a -> a -> a -> Node a
N8 (a -> b
fn a
a) (a -> b
fn a
b) (a -> b
fn a
c) (a -> b
fn a
d) (a -> b
fn a
e) (a -> b
fn a
f) (a -> b
fn a
g) (a -> b
fn a
h)
mapNode a -> b
fn (NA Int
n Arr a
a) = Int -> Arr b -> Node b
forall a. Int -> Arr a -> Node a
NA Int
n ((a -> b) -> Arr a -> Arr b
forall a b. (a -> b) -> Arr a -> Arr b
mapA a -> b
fn Arr a
a)

------------------------------------------------------------------------
-- Invariant checker, for tests

valid :: Deque a -> Either String ()
valid :: forall a. Deque a -> Either [Char] ()
valid Deque a
Nil = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
valid (Deep Int
t SList a
pr Mid a
m SList a
sf) = do
  let n :: Int
n = Int -> Int
tsize Int
t
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"a Deep with no leaves"
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SList a -> Int
forall a. SList a -> Int
lenS SList a
pr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
tpc Int
t) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"top prefix count"
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SList a -> Int
forall a. SList a -> Int
lenS SList a
sf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
tsc Int
t) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"top suffix count"
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int
tpc Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxD Bool -> Bool -> Bool
|| Int -> Int
tsc Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxD) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"top digit too long"
  Int
ms <- Int -> (a -> Either [Char] Int) -> Mid a -> Either [Char] Int
forall a.
Int -> (a -> Either [Char] Int) -> Mid a -> Either [Char] Int
validM (Int
1 :: Int) (\a
_ -> Int -> Either [Char] Int
forall a b. b -> Either a b
Right Int
1) Mid a
m
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int -> Int
tpc Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int -> Int
tsc Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"top: an empty digit beside a middle"
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
tpc Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsc Int
t) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char]
"top size: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" /= " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int
tpc Int
t, Int
ms, Int -> Int
tsc Int
t))

validM :: Int -> (a -> Either String Int) -> Mid a -> Either String Int
validM :: forall a.
Int -> (a -> Either [Char] Int) -> Mid a -> Either [Char] Int
validM Int
_ a -> Either [Char] Int
_ Mid a
MNil = Int -> Either [Char] Int
forall a b. b -> Either a b
Right Int
0
validM Int
lvl a -> Either [Char] Int
chk (MDeep Int
t Int
ps SList (Node a)
pr Mid (Node a)
m SList (Node a)
sf) = do
  let n :: Int
n = Int -> Int
tsize Int
t
      at :: [Char] -> [Char]
at [Char]
s = [Char]
"level " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lvl [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"an MDeep with no leaves")
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SList (Node a) -> Int
forall a. SList a -> Int
lenS SList (Node a)
pr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
tpc Int
t) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"prefix count")
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SList (Node a) -> Int
forall a. SList a -> Int
lenS SList (Node a)
sf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
tsc Int
t) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"suffix count")
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int
tpc Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxD Bool -> Bool -> Bool
|| Int -> Int
tsc Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxD) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"digit too long")
  Int
psz <- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> Either [Char] [Int] -> Either [Char] Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node a -> Either [Char] Int) -> [Node a] -> Either [Char] [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
forall a.
Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
checkNode Int
lvl a -> Either [Char] Int
chk) (SList (Node a) -> [Node a]
forall a. SList a -> [a]
listS SList (Node a)
pr)
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
psz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ps) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"prefix size")
  Int
ssz <- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> Either [Char] [Int] -> Either [Char] Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node a -> Either [Char] Int) -> [Node a] -> Either [Char] [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
forall a.
Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
checkNode Int
lvl a -> Either [Char] Int
chk) (SList (Node a) -> [Node a]
forall a. SList a -> [a]
listS SList (Node a)
sf)
  Int
ms <- Int
-> (Node a -> Either [Char] Int)
-> Mid (Node a)
-> Either [Char] Int
forall a.
Int -> (a -> Either [Char] Int) -> Mid a -> Either [Char] Int
validM (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
forall a.
Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
checkNode Int
lvl a -> Either [Char] Int
chk) Mid (Node a)
m
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Int -> Int
tpc Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int -> Int
tsc Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at [Char]
"an empty digit beside a middle")
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
psz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ssz) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> [Char]
at ([Char]
"size: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" /= " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
psz, Int
ms, Int
ssz)))
  pure Int
n

-- lvl: the level of the digit the node is in; only at the first are a
-- node's children leaves
checkNode :: Int -> (a -> Either String Int) -> Node a -> Either String Int
checkNode :: forall a.
Int -> (a -> Either [Char] Int) -> Node a -> Either [Char] Int
checkNode Int
lvl a -> Either [Char] Int
chk Node a
nd = do
  let kids :: [a]
kids = [Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
i Node a
nd | Int
i <- [Int
0 .. Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  Int
s <- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> Either [Char] [Int] -> Either [Char] Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Either [Char] Int) -> [a] -> Either [Char] [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> Either [Char] Int
chk [a]
kids
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"node size"
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
kids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
kids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"node arity"
  case Node a
nd of
    N8 {} | Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"a node of eight leaves below the first level"
    Node a
_ -> () -> Either [Char] ()
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure Int
s

------------------------------------------------------------------------
-- The names Data.Sequence uses, so that this module can stand in for it.

type Seq = Deque

length :: Deque a -> Int
length :: forall a. Deque a -> Int
length = Deque a -> Int
forall a. Deque a -> Int
size
{-# INLINE length #-}

null :: Deque a -> Bool
null :: forall a. Deque a -> Bool
null Deque a
Nil = Bool
True
null Deque a
_ = Bool
False
{-# INLINE null #-}

infixr 5 <|

infixl 5 |>

infixr 5 ><

(<|) :: a -> Deque a -> Deque a
<| :: forall a. a -> Deque a -> Deque a
(<|) = a -> Deque a -> Deque a
forall a. a -> Deque a -> Deque a
cons
{-# INLINE (<|) #-}

(|>) :: Deque a -> a -> Deque a
|> :: forall a. Deque a -> a -> Deque a
(|>) = Deque a -> a -> Deque a
forall a. Deque a -> a -> Deque a
snoc
{-# INLINE (|>) #-}

(><) :: Deque a -> Deque a -> Deque a
>< :: forall a. Deque a -> Deque a -> Deque a
(><) = Deque a -> Deque a -> Deque a
forall a. Deque a -> Deque a -> Deque a
append
{-# INLINE (><) #-}

infixr 5 :<|

infixl 5 :|>

pattern Empty :: Deque a
pattern $mEmpty :: forall {r} {a}. Deque a -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmpty :: forall a. Deque a
Empty <- (null -> True)
  where
    Empty = Deque a
forall a. Deque a
Nil

pattern (:<|) :: a -> Deque a -> Deque a
pattern x $m:<| :: forall {r} {a}. Deque a -> (a -> Deque a -> r) -> ((# #) -> r) -> r
$b:<| :: forall a. a -> Deque a -> Deque a
:<| xs <- (uncons -> Just (x, xs))
  where
    a
x :<| Deque a
xs = a -> Deque a -> Deque a
forall a. a -> Deque a -> Deque a
cons a
x Deque a
xs

pattern (:|>) :: Deque a -> a -> Deque a
pattern xs $m:|> :: forall {r} {a}. Deque a -> (Deque a -> a -> r) -> ((# #) -> r) -> r
$b:|> :: forall a. Deque a -> a -> Deque a
:|> x <- (unsnoc -> Just (xs, x))
  where
    Deque a
xs :|> a
x = Deque a -> a -> Deque a
forall a. Deque a -> a -> Deque a
snoc Deque a
xs a
x

{-# COMPLETE (:<|), Empty #-}

{-# COMPLETE (:|>), Empty #-}

-- | A stable sort.  O(n log n); goes through a list.
sort :: (Ord a) => Deque a -> Deque a
sort :: forall a. Ord a => Deque a -> Deque a
sort = (a -> a -> Ordering) -> Deque a -> Deque a
forall a. (a -> a -> Ordering) -> Deque a -> Deque a
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

sortBy :: (a -> a -> Ordering) -> Deque a -> Deque a
sortBy :: forall a. (a -> a -> Ordering) -> Deque a -> Deque a
sortBy a -> a -> Ordering
cmp Deque a
d = Int -> [a] -> Deque a
forall a. Int -> [a] -> Deque a
unsafeFromListN (Deque a -> Int
forall a. Deque a -> Int
size Deque a
d) ((a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
cmp (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
d))

-- | The same as 'sort' here; Data.Sequence has both.
unstableSort :: (Ord a) => Deque a -> Deque a
unstableSort :: forall a. Ord a => Deque a -> Deque a
unstableSort = Deque a -> Deque a
forall a. Ord a => Deque a -> Deque a
sort

unstableSortBy :: (a -> a -> Ordering) -> Deque a -> Deque a
unstableSortBy :: forall a. (a -> a -> Ordering) -> Deque a -> Deque a
unstableSortBy = (a -> a -> Ordering) -> Deque a -> Deque a
forall a. (a -> a -> Ordering) -> Deque a -> Deque a
sortBy

intersperse :: a -> Deque a -> Deque a
intersperse :: forall a. a -> Deque a -> Deque a
intersperse a
sep = [a] -> Deque a
forall a. [a] -> Deque a
fromList ([a] -> Deque a) -> (Deque a -> [a]) -> Deque a -> Deque a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. a -> [a] -> [a]
L.intersperse a
sep ([a] -> [a]) -> (Deque a -> [a]) -> Deque a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deque a -> [a]
forall a. Deque a -> [a]
toList

reverse :: Deque a -> Deque a
reverse :: forall a. Deque a -> Deque a
reverse = (Deque a -> a -> Deque a) -> Deque a -> Deque a -> Deque a
forall r a. (r -> a -> r) -> r -> Deque a -> r
foldlD' ((a -> Deque a -> Deque a) -> Deque a -> a -> Deque a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Deque a -> Deque a
forall a. a -> Deque a -> Deque a
cons) Deque a
forall a. Deque a
empty

------------------------------------------------------------------------
-- Instances

instance Semigroup (Deque a) where
  <> :: Deque a -> Deque a -> Deque a
(<>) = Deque a -> Deque a -> Deque a
forall a. Deque a -> Deque a -> Deque a
append

instance Monoid (Deque a) where
  mempty :: Deque a
mempty = Deque a
forall a. Deque a
empty

instance Foldable Deque where
  foldr :: forall a r. (a -> r -> r) -> r -> Deque a -> r
foldr = (a -> b -> b) -> b -> Deque a -> b
forall a r. (a -> r -> r) -> r -> Deque a -> r
foldrD
  foldl' :: forall r a. (r -> a -> r) -> r -> Deque a -> r
foldl' = (b -> a -> b) -> b -> Deque a -> b
forall r a. (r -> a -> r) -> r -> Deque a -> r
foldlD'
  toList :: forall a. Deque a -> [a]
toList = Deque a -> [a]
forall a. Deque a -> [a]
toList
  length :: forall a. Deque a -> Int
length = Deque a -> Int
forall a. Deque a -> Int
size
  null :: forall a. Deque a -> Bool
null = Deque a -> Bool
forall a. Deque a -> Bool
null

instance Functor Deque where
  fmap :: forall a b. (a -> b) -> Deque a -> Deque b
fmap = (a -> b) -> Deque a -> Deque b
forall a b. (a -> b) -> Deque a -> Deque b
mapD

-- | Rebuilds the sequence.  O(n).
instance Traversable Deque where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deque a -> f (Deque b)
traverse a -> f b
f Deque a
d = Int -> [b] -> Deque b
forall a. Int -> [a] -> Deque a
fromListN (Deque a -> Int
forall a. Deque a -> Int
size Deque a
d) ([b] -> Deque b) -> f [b] -> f (Deque b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> f b
f (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
d)

instance (Eq a) => Eq (Deque a) where
  Deque a
a == :: Deque a -> Deque a -> Bool
== Deque a
b = Deque a -> Int
forall a. Deque a -> Int
size Deque a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Deque a -> Int
forall a. Deque a -> Int
size Deque a
b Bool -> Bool -> Bool
&& Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
a [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
b

-- | Lexicographic, as for lists.
instance (Ord a) => Ord (Deque a) where
  compare :: Deque a -> Deque a -> Ordering
compare Deque a
a Deque a
b = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
a) (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
b)

instance Eq1 Deque where
  liftEq :: forall a b. (a -> b -> Bool) -> Deque a -> Deque b -> Bool
liftEq a -> b -> Bool
eq Deque a
a Deque b
b = Deque a -> Int
forall a. Deque a -> Int
size Deque a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Deque b -> Int
forall a. Deque a -> Int
size Deque b
b Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
a) (Deque b -> [b]
forall a. Deque a -> [a]
toList Deque b
b)

instance Ord1 Deque where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Deque a -> Deque b -> Ordering
liftCompare a -> b -> Ordering
cmp Deque a
a Deque b
b = (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
a) (Deque b -> [b]
forall a. Deque a -> [a]
toList Deque b
b)

instance (Show a) => Show (Deque a) where
  showsPrec :: Int -> Deque a -> [Char] -> [Char]
showsPrec Int
p Deque a
d = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
showString [Char]
"fromList " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
d)

instance Show1 Deque where
  liftShowsPrec :: forall a.
(Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> Int -> Deque a -> [Char] -> [Char]
liftShowsPrec Int -> a -> [Char] -> [Char]
_ [a] -> [Char] -> [Char]
sl Int
p Deque a
d = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
showString [Char]
"fromList " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Char] -> [Char]
sl (Deque a -> [a]
forall a. Deque a -> [a]
toList Deque a
d)

-- | The structure is always evaluated; this evaluates the elements fully.
instance (NFData a) => NFData (Deque a) where
  rnf :: Deque a -> ()
rnf = (() -> a -> ()) -> () -> Deque a -> ()
forall r a. (r -> a -> r) -> r -> Deque a -> r
foldlD' (\() a
x -> a -> ()
forall a. NFData a => a -> ()
rnf a
x) ()

instance Exts.IsList (Deque a) where
  type Item (Deque a) = a
  fromList :: [Item (Deque a)] -> Deque a
fromList = [a] -> Deque a
[Item (Deque a)] -> Deque a
forall a. [a] -> Deque a
fromList
  toList :: Deque a -> [Item (Deque a)]
toList = Deque a -> [a]
Deque a -> [Item (Deque a)]
forall a. Deque a -> [a]
toList