{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-- The JIT's C helpers read and build these constructors (unison-runtime's
-- cbits/jit_rt.c), so their layout must be the same in every build: fields are
-- unpacked only when optimizing.
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

-- | A rope: a sequence of chunks that knows its size in elements (the
-- characters of a text, the bytes of a byte string).
--
-- * O(1) 'size'
-- * amortized O(1) 'cons', 'snoc', 'uncons', 'unsnoc' of a chunk, and so of a
--   short piece of text at either end
-- * O(log n) 'index', 'take', 'drop', append; close to O(1) near either end
--
-- It is the finger tree of "Unison.Util.Deque" with chunks for elements and
-- sizes counted in what the chunks hold.  The middle of the tree is the
-- Deque's own middle, a sequence of nodes that knows the size under each; only
-- the top level, whose items are chunks, is written here.
--
-- Invariants:
--
-- * no chunk is empty
-- * a rope of one chunk is 'One'; a 'Deep' has a chunk in each digit
-- * two chunks next to each other hold more than 'threshold' elements
--   between them, so a rope of n elements has at most @2n / threshold + 1@
--   chunks however it was built
module Unison.Util.Rope
  ( chunks,
    fromChunks,
    singleton,
    one,
    map,
    traverse,
    traverseWithPos_,
    null,
    flatten,
    two,
    cons,
    uncons,
    snoc,
    unsnoc,
    index,
    debugDepth,
    extractChunk,
    threshold,
    valid,
    Sized (..),
    Take (..),
    Drop (..),
    Reverse (..),
    Index (..),
    Rope (..),
  )
where

import Control.DeepSeq (NFData (..))
import Control.Monad (unless, when)
import Data.Bits (unsafeShiftL, (.&.))
import Data.Foldable qualified as F
import Data.Primitive.SmallArray (indexSmallArray, sizeofSmallArray)
import GHC.Exts (Int (I#), Int#)
import Unison.Util.Deque.Internal
  ( Mid (..),
    Node (..),
    SList (..),
    appM,
    arr8,
    consM,
    dropM,
    dropS,
    foldlM,
    foldlNode,
    foldlRev,
    foldlS,
    foldrM,
    foldrNode,
    foldrRev,
    foldrS,
    fromSListA,
    lenS,
    listS,
    maxD,
    mk,
    nodeArity,
    nodeAt,
    nodeDropFwd,
    nodeSize,
    nodeTakeRev,
    revOnto,
    revS,
    scanBwd,
    scanFwd,
    scanKids,
    sizeM,
    snocM,
    takeM,
    takeS,
    tpc,
    tsc,
    tsize,
    unconsM,
    unsnocM,
    validM,
  )
import Prelude hiding (drop, map, null, reverse, take, traverse)
import Prelude qualified as P

-- typeclasses used for abstracting over the chunk type
class Sized a where size :: a -> Int

class Take a where take :: Int -> a -> a

class Drop a where drop :: Int -> a -> a

class Index a elem where unsafeIndex :: Int -> a -> elem

class Reverse a where reverse :: a -> a

-- | The first 'Int' of 'Deep' packs three numbers, as in the Deque: the size
-- of the rope (bits 8 and up), the number of chunks in the suffix (bits 4 to
-- 7) and in the prefix (bits 0 to 3).  The second is the size of the prefix.
-- The prefix runs front to back and the suffix back to front, so the first
-- and last chunks of the rope are the heads of the two lists.
data Rope a
  = Empty
  | One !a
  | Deep !Int !Int !(SList a) !(Mid a) !(SList a)

-- | Two chunks next to each other with this many elements or fewer between
-- them are made one chunk.
--
-- See https://github.com/unisonweb/unison/pull/1899#discussion_r742953469
threshold :: Int
threshold :: Int
threshold = Int
64

instance (Sized a) => Sized (Rope a) where
  size :: Rope a -> Int
size = \case
    Rope a
Empty -> Int
0
    One a
a -> a -> Int
forall a. Sized a => a -> Int
size a
a
    Deep Int
t Int
_ SList a
_ Mid a
_ SList a
_ -> Int -> Int
tsize Int
t
  {-# INLINE size #-}

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

singleton, one :: (Sized a) => a -> Rope a
one :: forall a. Sized a => a -> Rope a
one a
a | a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Rope a
forall a. Rope a
Empty
one a
a = a -> Rope a
forall a. a -> Rope a
One a
a
singleton :: forall a. Sized a => a -> Rope a
singleton = a -> Rope a
forall a. Sized a => a -> Rope a
one
{-# INLINE one #-}
{-# INLINE singleton #-}

sumC :: (Sized a) => SList a -> Int
sumC :: forall a. Sized a => SList a -> Int
sumC = Int -> SList a -> Int
forall {a}. Sized a => Int -> SList a -> Int
go Int
0
  where
    go :: Int -> SList a -> Int
go !Int
n SList a
SNil = Int
n
    go !Int
n (SCons a
x SList a
r) = Int -> SList a -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
x) SList a
r
{-# INLINE sumC #-}

------------------------------------------------------------------------
-- Building a level whose digits may be short

-- chunks in order, at most a digit's worth
fromFwd :: (Sized a) => Int -> Int -> SList a -> Rope a
fromFwd :: forall a. Sized a => Int -> Int -> SList a -> Rope a
fromFwd !Int
n !Int
cnt SList a
l = case SList a
l of
  SList a
SNil -> Rope a
forall a. Rope a
Empty
  SCons a
x SList a
SNil -> a -> Rope a
forall a. a -> Rope a
One a
x
  SList a
_ ->
    let !p :: Int
p = (Int
cnt 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
        !pr :: SList a
pr = Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
p SList a
l
     in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
p (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p)) (SList a -> Int
forall a. Sized a => SList a -> Int
sumC SList a
pr) 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
p SList a
l))
{-# INLINEABLE fromFwd #-}

-- chunks back to front
fromBwd :: (Sized a) => Int -> Int -> SList a -> Rope a
fromBwd :: forall a. Sized a => Int -> Int -> SList a -> Rope a
fromBwd !Int
n !Int
cnt SList a
l = case SList a
l of
  SList a
SNil -> Rope a
forall a. Rope a
Empty
  SCons a
x SList a
SNil -> a -> Rope a
forall a. a -> Rope a
One a
x
  SList a
_ ->
    let !q :: Int
q = Int
cnt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        !pr :: SList a
pr = 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
l)
     in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q) Int
q) (SList a -> Int
forall a. Sized a => SList a -> Int
sumC SList a
pr) 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
l)
{-# INLINEABLE fromBwd #-}

-- A rope of n elements from the parts of a 'Deep', either of whose digits
-- may be empty: an empty digit takes a node from the middle, or half of the
-- other digit when there is no middle.
build :: (Sized a) => Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build :: forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build !Int
n !Int
pc !Int
ps SList a
pr Mid a
m !Int
sc SList a
sf
  | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = case Mid a
m of
      Mid a
MNil -> Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromBwd Int
n Int
sc 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') -> Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build Int
n (Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd) (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd Int
0 Node a
nd) Mid a
m' Int
sc SList a
sf
  | Int
sc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = case Mid a
m of
      Mid a
MNil -> Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromFwd Int
n Int
pc SList a
pr
      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) -> let !k :: Int
k = Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
k) Int
ps SList a
pr Mid a
m' (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev Int
k Node a
nd)
  | Bool
otherwise = Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc Int
sc) Int
ps SList a
pr Mid a
m SList a
sf
{-# INLINEABLE build #-}

------------------------------------------------------------------------
-- Adding a chunk at an end.  A chunk that fits in 'threshold' together with
-- the chunk already at that end is joined to it.

cons :: (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons :: forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons a
c Rope a
r = case a -> Int
forall a. Sized a => a -> Int
size a
c of
  Int
0 -> Rope a
r
  Int
s -> Int -> a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' Int
s a
c Rope a
r
{-# INLINE cons #-}

snoc :: (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc :: forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc Rope a
r a
c = case a -> Int
forall a. Sized a => a -> Int
size a
c of
  Int
0 -> Rope a
r
  Int
s -> Rope a -> Int -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
r Int
s a
c
{-# INLINE snoc #-}

cons' :: (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' :: forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' !Int
_ a
c Rope a
Empty = a -> Rope a
forall a. a -> Rope a
One a
c
cons' Int
s a
c (One a
a)
  | Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sa Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold = a -> Rope a
forall a. a -> Rope a
One (a
c a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
  | Bool
otherwise = Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sa) Int
1 Int
1) Int
s (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
c 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
a SList a
forall a. SList a
SNil)
  where
    !sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
cons' Int
s a
c (Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf) = case SList a
pr of
  SCons a
f SList a
pr'
    | Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold -> Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons (a
c a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
f) 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 -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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) (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
c SList a
pr) Mid a
m SList a
sf
  -- a full prefix keeps its two outermost chunks and sheds the other eight
  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
_))))))))) ->
    let !keep :: Int
keep = a -> Int
forall a. Sized a => a -> Int
size a
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
p2
     in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep
          (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)
          (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
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 (Int -> Arr a -> Node a
forall a. Int -> Arr a -> Node a
NA (Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
keep) (a -> a -> a -> a -> a -> a -> a -> a -> Arr a
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)) Mid a
m)
          SList a
sf
  SList a
_ -> [Char] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.cons: short prefix"
{-# INLINEABLE cons' #-}

snoc' :: (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' :: forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
Empty !Int
_ a
c = a -> Rope a
forall a. a -> Rope a
One a
c
snoc' (One a
a) Int
s a
c
  | Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold = a -> Rope a
forall a. a -> Rope a
One (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c)
  | Bool
otherwise = Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk (Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
1 Int
1) Int
sa (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
a 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
c SList a
forall a. SList a
SNil)
  where
    !sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
snoc' (Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf) Int
s a
c = case SList a
sf of
  SCons a
l SList a
sf'
    | a -> Int
forall a. Sized a => a -> Int
size a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold -> Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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
ps SList a
pr Mid a
m (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons (a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c) SList a
sf')
    | 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 a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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 a
pr Mid a
m (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons a
c SList a
sf)
  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
_))))))))) ->
    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 a -> Int
forall a. Mid a -> Int
sizeM Mid a
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
s2
     in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep
          (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 a
pr
          (Mid a -> Node a -> Mid a
forall a. Mid a -> Node a -> Mid a
snocM Mid a
m (Int -> Arr a -> Node a
forall a. Int -> Arr a -> Node a
NA Int
shed (a -> a -> a -> a -> a -> a -> a -> a -> Arr a
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)))
          (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
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] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.snoc: short suffix"
{-# INLINEABLE snoc' #-}

fromChunks :: (Sized a, Semigroup a) => [a] -> Rope a
fromChunks :: forall a. (Sized a, Semigroup a) => [a] -> Rope a
fromChunks = (Rope a -> a -> Rope a) -> Rope a -> [a] -> Rope a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Rope a -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc Rope a
forall a. Rope a
Empty
{-# INLINE fromChunks #-}

------------------------------------------------------------------------
-- Removing a chunk at an end

uncons :: (Sized a) => Rope a -> Maybe (a, Rope a)
uncons :: forall a. Sized a => Rope a -> Maybe (a, Rope a)
uncons = \case
  Rope a
Empty -> Maybe (a, Rope a)
forall a. Maybe a
Nothing
  One a
a -> (a, Rope a) -> Maybe (a, Rope a)
forall a. a -> Maybe a
Just (a
a, Rope a
forall a. Rope a
Empty)
  Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf -> case SList a
pr of
    SCons a
x SList a
pr' ->
      let !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
x
          !rest :: Rope a
rest = case SList a
pr' of
            SCons a
_ SList a
_ -> Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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) SList a
pr' Mid a
m SList a
sf
            SList a
SNil -> Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Int
0 Int
0 SList a
forall a. SList a
SNil Mid a
m (Int -> Int
tsc Int
t) SList a
sf
       in (a, Rope a) -> Maybe (a, Rope a)
forall a. a -> Maybe a
Just (a
x, Rope a
rest)
    SList a
SNil -> [Char] -> Maybe (a, Rope a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.uncons: empty prefix"
{-# INLINEABLE uncons #-}

unsnoc :: (Sized a) => Rope a -> Maybe (Rope a, a)
unsnoc :: forall a. Sized a => Rope a -> Maybe (Rope a, a)
unsnoc = \case
  Rope a
Empty -> Maybe (Rope a, a)
forall a. Maybe a
Nothing
  One a
a -> (Rope a, a) -> Maybe (Rope a, a)
forall a. a -> Maybe a
Just (Rope a
forall a. Rope a
Empty, a
a)
  Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf -> case SList a
sf of
    SCons a
x SList a
sf' ->
      let !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
x
          !rest :: Rope a
rest = case SList a
sf' of
            SCons a
_ SList a
_ -> Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (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 a
pr Mid a
m SList a
sf'
            SList a
SNil -> Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int -> Int
tsize Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int -> Int
tpc Int
t) Int
ps SList a
pr Mid a
m Int
0 SList a
forall a. SList a
SNil
       in (Rope a, a) -> Maybe (Rope a, a)
forall a. a -> Maybe a
Just (Rope a
rest, a
x)
    SList a
SNil -> [Char] -> Maybe (Rope a, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.unsnoc: empty suffix"
{-# INLINEABLE unsnoc #-}

------------------------------------------------------------------------
-- Finding the chunk that holds an element

-- The first-level node holding element i of a middle, and i's offset in it.
--
-- This and 'chunkAt' return unboxed pairs on purpose: measured on the rope
-- benchmark (2026-10-19, benchmarks/2026-10-19-unboxing.md in the JIT docs),
-- the boxed pair costs 5 to 8% on taking a text apart a character at a time,
-- where every character goes through 'chunkAt'; the Deque's lookups, written
-- with ordinary pairs, cost nothing, since GHC unboxes those results itself.
lookR :: Int -> Mid a -> (# Node a, Int# #)
lookR :: forall a. Int -> Mid a -> (# Node a, Int# #)
lookR !Int
_ Mid a
MNil = [Char] -> (# Node a, Int# #)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.index: empty middle"
lookR 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 = case Int -> SList (Node a) -> (Node a, Int)
forall a. Int -> SList (Node a) -> (Node a, Int)
scanFwd Int
i SList (Node a)
pr of (Node a
nd, I# Int#
off#) -> (# Node a
nd, Int#
off# #)
  | Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Mid (Node a) -> Int
forall a. Mid a -> Int
sizeM Mid (Node a)
m = case Int -> Mid (Node a) -> (# Node (Node a), Int# #)
forall a. Int -> Mid a -> (# Node a, Int# #)
lookR Int
i' Mid (Node a)
m of
      (# Node (Node a)
nn, Int#
off# #) -> case Int -> Node (Node a) -> (Int, Int)
forall a. Int -> Node (Node a) -> (Int, Int)
scanKids (Int# -> Int
I# Int#
off#) Node (Node a)
nn of
        (!Int
q, !Int
sb) -> case Int# -> Int
I# Int#
off# Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb of I# Int#
o# -> (# Int -> Node (Node a) -> Node a
forall a. Int -> Node a -> a
nodeAt Int
q Node (Node a)
nn, Int#
o# #)
  | Bool
otherwise = case 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 of (Node a
nd, I# Int#
off#) -> (# Node a
nd, Int#
off# #)
  where
    !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps

-- The chunk holding element i, 0 <= i < size, and i's offset in it.
chunkAt :: (Sized a) => Int -> Rope a -> (# a, Int# #)
chunkAt :: forall a. Sized a => Int -> Rope a -> (# a, Int# #)
chunkAt !Int
_ Rope a
Empty = [Char] -> (# a, Int# #)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.index: empty"
chunkAt (I# Int#
i#) (One a
a) = (# a
a, Int#
i# #)
chunkAt Int
i (Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ps = Int -> SList a -> (# a, Int# #)
forall {a}. Sized a => Int -> SList a -> (# a, Int# #)
fwd Int
i SList a
pr
  | Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Mid a -> Int
forall a. Mid a -> Int
sizeM Mid a
m = case Int -> Mid a -> (# Node a, Int# #)
forall a. Int -> Mid a -> (# Node a, Int# #)
lookR Int
i' Mid a
m of (# Node a
nd, Int#
off# #) -> Int -> Int -> Node a -> (# a, Int# #)
forall {a}. Sized a => Int -> Int -> Node a -> (# a, Int# #)
inNode Int
0 (Int# -> Int
I# Int#
off#) Node a
nd
  | Bool
otherwise = Int -> SList a -> (# a, Int# #)
forall {a}. Sized a => Int -> SList a -> (# a, Int# #)
bwd (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 a
sf
  where
    !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ps
    fwd :: Int -> SList a -> (# a, Int# #)
fwd !Int
k (SCons a
c SList a
r)
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = case Int
k of I# Int#
k# -> (# a
c, Int#
k# #)
      | Bool
otherwise = Int -> SList a -> (# a, Int# #)
fwd (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList a
r
      where
        !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
    fwd Int
_ SList a
SNil = [Char] -> (# a, Int# #)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.index: past the end of the prefix"
    bwd :: Int -> SList a -> (# a, Int# #)
bwd !Int
r (SCons a
c SList a
rest)
      | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = 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 I# Int#
k# -> (# a
c, Int#
k# #)
      | Bool
otherwise = Int -> SList a -> (# a, Int# #)
bwd (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) SList a
rest
      where
        !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
    bwd Int
_ SList a
SNil = [Char] -> (# a, Int# #)
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.index: past the end of the suffix"
    inNode :: Int -> Int -> Node a -> (# a, Int# #)
inNode !Int
q !Int
k Node a
nd
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = case Int
k of I# Int#
k# -> (# a
c, Int#
k# #)
      | Bool
otherwise = Int -> Int -> Node a -> (# a, Int# #)
inNode (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Node a
nd
      where
        !c :: a
c = Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
q Node a
nd
        !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
{-# INLINEABLE chunkAt #-}

index :: (Sized a, Index a ch) => Int -> Rope a -> Maybe ch
index :: forall a ch. (Sized a, Index a ch) => Int -> Rope a -> Maybe ch
index Int
i Rope a
r
  | 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
< Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r = ch -> Maybe ch
forall a. a -> Maybe a
Just (Int -> Rope a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex Int
i Rope a
r)
  | Bool
otherwise = Maybe ch
forall a. Maybe a
Nothing
{-# INLINE index #-}

instance (Sized a, Index a ch) => Index (Rope a) ch where
  unsafeIndex :: Int -> Rope a -> ch
unsafeIndex Int
i (One a
a) = Int -> a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex Int
i a
a
  unsafeIndex Int
i Rope a
r = case Int -> Rope a -> (# a, Int# #)
forall a. Sized a => Int -> Rope a -> (# a, Int# #)
chunkAt Int
i Rope a
r of (# a
c, Int#
o# #) -> Int -> a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex (Int# -> Int
I# Int#
o#) a
c
  {-# INLINE unsafeIndex #-}

-- Extracts a chunk from a rope that
--
--   1. Begins at the specified position in the rope.
--   2. Is at least the size specified.
--
-- When the chunk holding the position has that much after it, the result is a
-- slice of it; otherwise chunks are concatenated, so it is advisable not to
-- use a very large size.
--
-- This function *assumes* that the rope actually contains the necessary
-- elements. If that is not the case, #2 above will certainly not be
-- satisfied, but the exact behavior should not be relied upon.
extractChunk :: (Monoid a, Sized a, Take a, Drop a) => Int -> Int -> Rope a -> a
extractChunk :: forall a.
(Monoid a, Sized a, Take a, Drop a) =>
Int -> Int -> Rope a -> a
extractChunk Int
ix Int
ln Rope a
r
  | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r = a
forall a. Monoid a => a
mempty
  | Bool
otherwise = case Int -> Rope a -> (# a, Int# #)
forall a. Sized a => Int -> Rope a -> (# a, Int# #)
chunkAt Int
ix Rope a
r of
      (# a
c, Int#
o# #)
        | a -> Int
forall a. Sized a => a -> Int
size a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int# -> Int
I# Int#
o# Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ln -> Int -> a -> a
forall a. Drop a => Int -> a -> a
drop (Int# -> Int
I# Int#
o#) a
c
        | Bool
otherwise -> [a] -> a
forall a. Monoid a => [a] -> a
mconcat (Rope a -> [a]
forall a. Rope a -> [a]
chunks (Int -> Rope a -> Rope a
forall a. Take a => Int -> a -> a
take Int
ln (Int -> Rope a -> Rope a
forall a. Drop a => Int -> a -> a
drop Int
ix Rope a
r)))
{-# INLINEABLE extractChunk #-}

------------------------------------------------------------------------
-- take and drop.  The rope is cut between two chunks, by the Deque's code
-- when the cut is in the middle, and then the part of the chunk the cut falls
-- in is added back with 'snoc' or 'cons', which joins it to its neighbour if
-- the two are small.

instance (Sized a, Semigroup a, Take a) => Take (Rope a) where
  take :: Int -> Rope a -> Rope a
take = Int -> Rope a -> Rope a
forall a. (Sized a, Semigroup a, Take a) => Int -> Rope a -> Rope a
takeR
  {-# INLINE take #-}

instance (Sized a, Semigroup a, Drop a) => Drop (Rope a) where
  drop :: Int -> Rope a -> Rope a
drop = Int -> Rope a -> Rope a
forall a. (Sized a, Semigroup a, Drop a) => Int -> Rope a -> Rope a
dropR
  {-# INLINE drop #-}

takeR :: (Sized a, Semigroup a, Take a) => Int -> Rope a -> Rope a
takeR :: forall a. (Sized a, Semigroup a, Take a) => Int -> Rope a -> Rope a
takeR !Int
i Rope a
r = case Rope a
r of
  Rope a
Empty -> Rope a
forall a. Rope a
Empty
  One a
a
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Rope a
forall a. Rope a
Empty
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Sized a => a -> Int
size a
a -> Rope a
r
    | Bool
otherwise -> a -> Rope a
forall a. a -> Rope a
One (Int -> a -> a
forall a. Take a => Int -> a -> a
take Int
i a
a)
  Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Rope a
forall a. Rope a
Empty
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n -> Rope a
r
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ps -> Int -> Int -> SList a -> Rope a
inPrefix Int
0 Int
0 SList a
pr
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Mid a -> Int
forall a. Mid a -> Int
sizeM Mid a
m -> 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
ps) Mid a
m of
        (Mid a
m', Node a
nd, Int
k) -> Mid a -> Node a -> Int -> Int -> Int -> Rope a
inNode Mid a
m' Node a
nd Int
k Int
0 Int
0
    | Bool
otherwise -> Int -> Int -> SList a -> Rope a
inSuffix (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
sc 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
      -- q whole chunks of the prefix, with sb elements, come before the cut
      inPrefix :: Int -> Int -> SList a -> Rope a
inPrefix !Int
q !Int
sb (SCons a
c SList a
rest)
        | Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = Int -> Int -> SList a -> Rope a
inPrefix (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) SList a
rest
        | Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromFwd Int
i (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SList a
pr)
        | Bool
otherwise = Rope a -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc (Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromFwd Int
sb Int
q (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
q SList a
pr)) (Int -> a -> a
forall a. Take a => Int -> a -> a
take (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb) a
c)
        where
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
      inPrefix Int
_ Int
_ SList a
SNil = [Char] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.take: past the end of the prefix"
      -- the first k elements of the node are kept
      inNode :: Mid a -> Node a -> Int -> Int -> Int -> Rope a
inNode Mid a
m' Node a
nd !Int
k !Int
q !Int
sb
        | Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k = Mid a -> Node a -> Int -> Int -> Int -> Rope a
inNode Mid a
m' Node a
nd Int
k (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)
        | Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k = Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build Int
i Int
pc Int
ps SList a
pr Mid a
m' (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Node a
nd)
        | Bool
otherwise = Rope a -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc (Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb)) Int
pc Int
ps SList a
pr Mid a
m' Int
q (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeTakeRev Int
q Node a
nd)) (Int -> a -> a
forall a. Take a => Int -> a -> a
take (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb) a
c)
        where
          !c :: a
c = Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
q Node a
nd
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
      -- d elements are to go from the back; cnt chunks of the suffix are left
      inSuffix :: Int -> Int -> SList a -> Rope a
inSuffix !Int
d !Int
cnt l :: SList a
l@(SCons a
c SList a
rest)
        | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = Int -> Int -> SList a -> Rope a
inSuffix (Int
d 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 a
rest
        | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build Int
i Int
pc Int
ps SList a
pr Mid a
m Int
cnt SList a
l
        | Bool
otherwise = Rope a -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc (Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)) Int
pc Int
ps SList a
pr Mid a
m (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SList a
rest) (Int -> a -> a
forall a. Take a => Int -> a -> a
take (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d) a
c)
        where
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
      inSuffix Int
_ Int
_ SList a
SNil = [Char] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.take: past the end of the suffix"
{-# INLINEABLE takeR #-}

dropR :: (Sized a, Semigroup a, Drop a) => Int -> Rope a -> Rope a
dropR :: forall a. (Sized a, Semigroup a, Drop a) => Int -> Rope a -> Rope a
dropR !Int
i Rope a
r = case Rope a
r of
  Rope a
Empty -> Rope a
forall a. Rope a
Empty
  One a
a
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Rope a
r
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Sized a => a -> Int
size a
a -> Rope a
forall a. Rope a
Empty
    | Bool
otherwise -> a -> Rope a
forall a. a -> Rope a
One (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop Int
i a
a)
  Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Rope a
r
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n -> Rope a
forall a. Rope a
Empty
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ms -> Int -> Int -> SList a -> Rope a
inSuffix Int
0 Int
0 SList a
sf
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ps -> 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
ps) Mid a
m of
        (Node a
nd, !Int
k, Mid a
m') -> Node a -> Int -> Mid a -> Int -> Int -> Rope a
inNode Node a
nd Int
k Mid a
m' Int
0 Int
0
    | Bool
otherwise -> Int -> Int -> Int -> SList a -> Rope a
inPrefix Int
i Int
pc Int
ps SList a
pr
    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 a -> Int
forall a. Mid a -> Int
sizeM Mid a
m
      !left :: Int
left = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
      -- q whole chunks of the suffix, with sa elements, come after the cut
      inSuffix :: Int -> Int -> SList a -> Rope a
inSuffix !Int
q !Int
sa (SCons a
c SList a
rest)
        | Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
left = Int -> Int -> SList a -> Rope a
inSuffix (Int
q 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 a
rest
        | Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
left = Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromBwd Int
left (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SList a
sf)
        | Bool
otherwise = a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa)) a
c) (Int -> Int -> SList a -> Rope a
forall a. Sized a => Int -> Int -> SList a -> Rope a
fromBwd Int
sa Int
q (Int -> SList a -> SList a
forall a. Int -> SList a -> SList a
takeS Int
q SList a
sf))
        where
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
      inSuffix Int
_ Int
_ SList a
SNil = [Char] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.drop: past the end of the suffix"
      -- the first k elements of the node go
      inNode :: Node a -> Int -> Mid a -> Int -> Int -> Rope a
inNode Node a
nd !Int
k Mid a
m' !Int
q !Int
sb
        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s = Node a -> Int -> Mid a -> Int -> Int -> Rope a
inNode Node a
nd Int
k Mid a
m' (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)
        | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sb = Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build Int
left (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q) (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd Int
q Node a
nd) Mid a
m' Int
sc SList a
sf
        | Bool
otherwise =
            a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons
              (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb) a
x)
              (Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)) (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) (Node a -> Int
forall a. Node a -> Int
nodeSize Node a
nd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int -> Node a -> SList a
forall a. Int -> Node a -> SList a
nodeDropFwd (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Node a
nd) Mid a
m' Int
sc SList a
sf)
        where
          !x :: a
x = Int -> Node a -> a
forall a. Int -> Node a -> a
nodeAt Int
q Node a
nd
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
x
          !c :: Int
c = Node a -> Int
forall a. Node a -> Int
nodeArity Node a
nd
      -- k elements still to drop; the prefix has cnt chunks and psz elements left
      inPrefix :: Int -> Int -> Int -> SList a -> Rope a
inPrefix !Int
k !Int
cnt !Int
psz l :: SList a
l@(SCons a
c SList a
rest)
        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = Int -> Int -> Int -> SList a -> Rope a
inPrefix (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) SList a
rest
        | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build Int
left Int
cnt Int
psz SList a
l Mid a
m Int
sc SList a
sf
        | Bool
otherwise = a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop Int
k a
c) (Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)) (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) SList a
rest Mid a
m Int
sc SList a
sf)
        where
          !s :: Int
s = a -> Int
forall a. Sized a => a -> Int
size a
c
      inPrefix Int
_ Int
_ Int
_ SList a
SNil = [Char] -> Rope a
forall a. HasCallStack => [Char] -> a
error [Char]
"Rope.drop: past the end of the prefix"
{-# INLINEABLE dropR #-}

------------------------------------------------------------------------
-- Append.  If the two chunks that meet are small they are joined; then the
-- digits that end up inside are packed into nodes and handed to the Deque's
-- append of two middles.

instance (Sized a, Semigroup a) => Semigroup (Rope a) where
  <> :: Rope a -> Rope a -> Rope a
(<>) = Rope a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
append
  {-# INLINE (<>) #-}

instance (Sized a, Semigroup a) => Monoid (Rope a) where
  mempty :: Rope a
mempty = Rope a
forall a. Rope a
Empty

two :: (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
two :: forall a. (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
two = Rope a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
append
{-# INLINE two #-}

append :: (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
append :: forall a. (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
append Rope a
Empty Rope a
b = Rope a
b
append Rope a
a Rope a
Empty = Rope a
a
append (One a
a) Rope a
b = Int -> a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' (a -> Int
forall a. Sized a => a -> Int
size a
a) a
a Rope a
b
append Rope a
a (One a
c) = Rope a -> Int -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
a (a -> Int
forall a. Sized a => a -> Int
size a
c) a
c
append (Deep Int
t1 Int
ps1 SList a
pr1 Mid a
m1 SList a
sf1) (Deep Int
t2 Int
ps2 SList a
pr2 Mid a
m2 SList a
sf2) = case SList a
sf1 of
  SCons a
l SList a
sf1'
    | SCons a
f SList a
pr2' <- SList a
pr2,
      a -> Int
forall a. Sized a => a -> Int
size a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold ->
        -- the two chunks that meet become one, the last of the left side
        SList a -> SList a -> Int -> Int -> Rope a
inner (a -> SList a -> SList a
forall a. a -> SList a -> SList a
SCons (a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
f) SList a
sf1') SList a
pr2' (Int -> Int
tpc Int
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> Int
forall a. Sized a => a -> Int
size a
f)
  SList a
_ -> SList a -> SList a -> Int -> Int -> Rope a
inner SList a
sf1 SList a
pr2 (Int -> Int
tpc Int
t2) Int
0
  where
    !n :: Int
n = Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
tsize Int
t2
    !pc1 :: Int
pc1 = Int -> Int
tpc Int
t1
    !sc1 :: Int
sc1 = Int -> Int
tsc Int
t1
    !sc2 :: Int
sc2 = Int -> Int
tsc Int
t2
    flat :: Mid a -> Bool
flat Mid a
MNil = Bool
True
    flat Mid a
_ = Bool
False
    -- isf: the left side's suffix; ipr: the ipc chunks of the right side's
    -- prefix that are still its own (d characters of it went to the left).
    -- The digits that end up inside join the outer digit of a side that has
    -- no middle, if they fit there (the shorter side's, if they fit in
    -- either: that copies fewer cells), or are packed into nodes and handed
    -- down between the two middles.
    inner :: SList a -> SList a -> Int -> Int -> Rope a
inner SList a
isf SList a
ipr !Int
ipc !Int
d
      | Mid a -> Bool
forall {a}. Mid a -> Bool
flat Mid a
m1,
        Int
pc1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD,
        Bool -> Bool
not (Mid a -> Bool
forall {a}. Mid a -> Bool
flat Mid a
m2 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sc2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD Bool -> Bool -> Bool
&& Int
sc2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ipc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pc1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sc1) =
          Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n (Int
pc1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int
sc2) (Int -> Int
tsize Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ps2) (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
isf SList a
ipr)) Mid a
m2 SList a
sf2
      | Mid a -> Bool
forall {a}. Mid a -> Bool
flat Mid a
m2,
        Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sc2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxD =
          Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc1 (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sc2)) Int
ps1 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
ipr SList a
isf))
      | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 =
          let !sns :: Int
sns = (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 a -> Int
forall a. Mid a -> Int
sizeM Mid a
m1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ps2
           in Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int -> Int -> Int -> Int
mk Int
n Int
pc1 Int
sc2) Int
ps1 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
sns (Int -> SList a -> SList (Node a)
forall a. Sized a => Int -> SList a -> SList (Node a)
packChunks Int
c (SList a -> SList a -> SList a
forall a. SList a -> SList a -> SList a
revOnto SList a
isf SList a
ipr)) Mid a
m2) SList a
sf2
      | Bool
otherwise =
          -- a single chunk between two sides that can't take it: the right
          -- side gets a prefix again, from its middle or its suffix
          Rope a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Rope a -> Rope a
append
            (Int -> Int -> SList a -> Mid a -> SList a -> Rope a
forall a. Int -> Int -> SList a -> Mid a -> SList a -> Rope a
Deep (Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
d Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)) Int
ps1 SList a
pr1 Mid a
m1 SList a
isf)
            (Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
forall a.
Sized a =>
Int -> Int -> Int -> SList a -> Mid a -> Int -> SList a -> Rope a
build (Int -> Int
tsize Int
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d) Int
0 Int
0 SList a
forall a. SList a
SNil Mid a
m2 Int
sc2 SList a
sf2)
      where
        !c :: Int
c = Int
sc1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ipc
{-# INLINEABLE append #-}

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)

-- c chunks, 2 to 2 * maxD of them, as nodes of eight while that leaves none
-- or at least two for the next (nine make a five and a four)
packChunks :: (Sized a) => Int -> SList a -> SList (Node a)
packChunks :: forall a. Sized a => Int -> SList a -> SList (Node a)
packChunks !Int
c SList a
l
  | 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 -> SList a -> Node a
forall a. Sized a => Int -> SList a -> Node a
chunkNode Int
c SList a
l) SList (Node a)
forall a. SList a
SNil
  | Int
c 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. Sized a => Int -> SList a -> Node a
chunkNode 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. Sized a => Int -> SList a -> Node a
chunkNode 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. Sized a => Int -> SList a -> Node a
chunkNode Int
8 SList a
l) (Int -> SList a -> SList (Node a)
forall a. Sized a => Int -> SList a -> SList (Node a)
packChunks (Int
c 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))
{-# INLINEABLE packChunks #-}

-- a node of the first k chunks of a list
chunkNode :: (Sized a) => Int -> SList a -> Node a
chunkNode :: forall a. Sized a => Int -> SList a -> Node a
chunkNode Int
k SList a
l = Int -> Arr a -> Node a
forall a. Int -> Arr a -> Node a
NA (Int -> Int -> SList a -> Int
forall {a}. Sized a => Int -> Int -> SList a -> Int
go Int
0 Int
k SList a
l) (Int -> SList a -> Arr a
forall a. Int -> SList a -> Arr a
fromSListA Int
k SList a
l)
  where
    go :: Int -> Int -> SList a -> Int
go !Int
n Int
0 SList a
_ = Int
n
    go !Int
n Int
j (SCons a
x SList a
r) = Int -> Int -> SList a -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
x) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int) SList a
r
    go !Int
n Int
_ SList a
SNil = Int
n
{-# INLINE chunkNode #-}

------------------------------------------------------------------------
-- Folds over the chunks

-- A right fold, inlined where it is used so that a known function is applied
-- directly to the chunks of the first-level nodes, where nearly all of them
-- are.
foldrChunks :: (a -> r -> r) -> r -> Rope a -> r
foldrChunks :: forall a r. (a -> r -> r) -> r -> Rope a -> r
foldrChunks a -> r -> r
f r
z = \case
  Rope a
Empty -> r
z
  One a
a -> a -> r -> r
f a
a r
z
  Deep Int
_ 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
foldrKids 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 foldrChunks #-}

foldrKids :: (a -> r -> r) -> Node a -> r -> r
foldrKids :: forall a r. (a -> r -> r) -> Node a -> r -> r
foldrKids a -> r -> r
f Node a
nd r
z = case Node a
nd of
  NA Int
_ Arr a
kids ->
    let !n :: Int
n = Arr a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray Arr a
kids
        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. SmallArray a -> Int -> a
indexSmallArray Arr a
kids Int
i) (Int -> r
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
     in Int -> r
go Int
0
  Node a
_ -> (a -> r -> r) -> Node a -> r -> r
forall a r. (a -> r -> r) -> Node a -> r -> r
foldrNode a -> r -> r
f Node a
nd r
z
{-# INLINE foldrKids #-}

instance Foldable Rope where
  foldr :: forall a r. (a -> r -> r) -> r -> Rope a -> r
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> Rope a -> b
forall a r. (a -> r -> r) -> r -> Rope a -> r
foldrChunks a -> b -> b
f b
z
  {-# INLINE foldr #-}
  foldl' :: forall b a. (b -> a -> b) -> b -> Rope a -> b
foldl' b -> a -> b
f !b
z = \case
    Rope a
Empty -> b
z
    One a
a -> b -> a -> b
f b
z a
a
    Deep Int
_ Int
_ SList a
pr Mid a
m SList a
sf -> (b -> a -> b) -> b -> SList a -> b
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlRev b -> a -> b
f ((b -> Node a -> b) -> b -> Mid a -> b
forall r a. (r -> Node a -> r) -> r -> Mid a -> r
foldlM ((b -> a -> b) -> b -> Node a -> b
forall r a. (r -> a -> r) -> r -> Node a -> r
foldlNode b -> a -> b
f) ((b -> a -> b) -> b -> SList a -> b
forall r a. (r -> a -> r) -> r -> SList a -> r
foldlS b -> a -> b
f b
z SList a
pr) Mid a
m) SList a
sf
  null :: forall a. Rope a -> Bool
null = Rope a -> Bool
forall a. Rope a -> Bool
null

chunks :: Rope a -> [a]
chunks :: forall a. Rope a -> [a]
chunks = (a -> [a] -> [a]) -> [a] -> Rope a -> [a]
forall a r. (a -> r -> r) -> r -> Rope a -> r
foldrChunks (:) []

flatten :: (Monoid a) => Rope a -> a
flatten :: forall m. Monoid m => Rope m -> m
flatten = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> (Rope a -> [a]) -> Rope a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope a -> [a]
forall a. Rope a -> [a]
chunks

-- | The result is rebuilt from the chunks the function returns, so it is a
-- rope whatever their sizes are.
map :: (Sized b, Semigroup b) => (a -> b) -> Rope a -> Rope b
map :: forall b a. (Sized b, Semigroup b) => (a -> b) -> Rope a -> Rope b
map a -> b
f = \case
  Rope a
Empty -> Rope b
forall a. Rope a
Empty
  One a
a -> b -> Rope b
forall a. Sized a => a -> Rope a
one (a -> b
f a
a)
  Rope a
r -> (Rope b -> a -> Rope b) -> Rope b -> Rope a -> Rope b
forall b a. (b -> a -> b) -> b -> Rope a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\Rope b
acc a
c -> Rope b -> b -> Rope b
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc Rope b
acc (a -> b
f a
c)) Rope b
forall a. Rope a
Empty Rope a
r
{-# INLINEABLE map #-}

traverse :: (Applicative f, Sized b, Semigroup b) => (a -> f b) -> Rope a -> f (Rope b)
traverse :: forall (f :: * -> *) b a.
(Applicative f, Sized b, Semigroup b) =>
(a -> f b) -> Rope a -> f (Rope b)
traverse a -> f b
f = \case
  Rope a
Empty -> Rope b -> f (Rope b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope b
forall a. Rope a
Empty
  One a
a -> b -> Rope b
forall a. Sized a => a -> Rope a
one (b -> Rope b) -> f b -> f (Rope b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  Rope a
r -> [b] -> Rope b
forall a. (Sized a, Semigroup a) => [a] -> Rope a
fromChunks ([b] -> Rope b) -> f [b] -> f (Rope 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]
P.traverse a -> f b
f (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
r)
{-# INLINEABLE traverse #-}

-- Traverses the chunks of a rope with the position of each chunk.
traverseWithPos_ :: (Applicative f, Sized a) => (Int -> a -> f ()) -> (Rope a -> f ())
traverseWithPos_ :: forall (f :: * -> *) a.
(Applicative f, Sized a) =>
(Int -> a -> f ()) -> Rope a -> f ()
traverseWithPos_ Int -> a -> f ()
f = \case
  Rope a
Empty -> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  One a
a -> Int -> a -> f ()
f Int
0 a
a
  Rope a
r -> (a -> (Int -> f ()) -> Int -> f ())
-> (Int -> f ()) -> Rope a -> Int -> f ()
forall a r. (a -> r -> r) -> r -> Rope a -> r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
c Int -> f ()
k !Int
o -> Int -> a -> f ()
f Int
o a
c f () -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> f ()
k (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c)) (\Int
_ -> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Rope a
r Int
0
{-# INLINE traverseWithPos_ #-}

instance (Sized a, Semigroup a, Reverse a) => Reverse (Rope a) where
  reverse :: Rope a -> Rope a
reverse = \case
    Rope a
Empty -> Rope a
forall a. Rope a
Empty
    One a
a -> a -> Rope a
forall a. a -> Rope a
One (a -> a
forall a. Reverse a => a -> a
reverse a
a)
    Rope a
r -> (Rope a -> a -> Rope a) -> Rope a -> Rope a -> Rope a
forall b a. (b -> a -> b) -> b -> Rope a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\Rope a
acc a
c -> a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons (a -> a
forall a. Reverse a => a -> a
reverse a
c) Rope a
acc) Rope a
forall a. Rope a
Empty Rope a
r

------------------------------------------------------------------------
-- Comparison

-- Produces two lists of chunks where the chunks have the same length
alignChunks :: (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks :: forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks [a]
bs1 [a]
bs2 = ([a]
cs1, [a]
cs2)
  where
    cs1 :: [a]
cs1 = [a] -> [a] -> [a]
forall {a} {b}.
(Sized a, Sized b, Take b, Drop a, Drop b) =>
[b] -> [a] -> [b]
alignTo [a]
bs1 [a]
bs2
    cs2 :: [a]
cs2 = [a] -> [a] -> [a]
forall {a} {b}.
(Sized a, Sized b, Take b, Drop a, Drop b) =>
[b] -> [a] -> [b]
alignTo [a]
bs2 [a]
cs1
    alignTo :: [b] -> [a] -> [b]
alignTo [b]
bs1 [] = [b]
bs1
    alignTo [] [a]
_ = []
    alignTo (b
hd1 : [b]
tl1) (a
hd2 : [a]
tl2)
      | Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len2 = b
hd1 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo [b]
tl1 [a]
tl2
      | Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len2 = b
hd1 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo [b]
tl1 (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop Int
len1 a
hd2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl2)
      | Bool
otherwise -- len1 > len2
        =
          let (b
hd1', b
hd1rem) = (Int -> b -> b
forall a. Take a => Int -> a -> a
take Int
len2 b
hd1, Int -> b -> b
forall a. Drop a => Int -> a -> a
drop Int
len2 b
hd1)
           in b
hd1' b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo (b
hd1rem b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
tl1) [a]
tl2
      where
        len1 :: Int
len1 = b -> Int
forall a. Sized a => a -> Int
size b
hd1
        len2 :: Int
len2 = a -> Int
forall a. Sized a => a -> Int
size a
hd2

instance (Sized a, Take a, Drop a, Eq a) => Eq (Rope a) where
  One a
l == :: Rope a -> Rope a -> Bool
== One a
r = a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r
  Rope a
b1 == Rope a
b2
    | Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
b2 =
        ([a] -> [a] -> Bool) -> ([a], [a]) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> ([a], [a])
forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b1) (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b2))
  Rope a
_ == Rope a
_ = Bool
False
  {-# INLINE (==) #-}

-- Lexicographical ordering
instance (Sized a, Take a, Drop a, Ord a) => Ord (Rope a) where
  One a
l compare :: Rope a -> Rope a -> Ordering
`compare` One a
r = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l a
r
  Rope a
b1 `compare` Rope a
b2 = ([a] -> [a] -> Ordering) -> ([a], [a]) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> ([a], [a])
forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b1) (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b2))
  {-# INLINE compare #-}

instance (NFData a) => NFData (Rope a) where
  rnf :: Rope a -> ()
rnf = (() -> a -> ()) -> () -> Rope a -> ()
forall b a. (b -> a -> b) -> b -> Rope a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\() a
c -> a -> ()
forall a. NFData a => a -> ()
rnf a
c) ()

------------------------------------------------------------------------
-- For tests

-- | The number of levels below the top one.
debugDepth :: Rope a -> Int
debugDepth :: forall a. Rope a -> Int
debugDepth = \case
  Deep Int
_ Int
_ SList a
_ Mid a
m SList a
_ -> Mid a -> Int
forall a. Mid a -> Int
go Mid a
m
  Rope a
_ -> Int
0
  where
    go :: Mid b -> Int
    go :: forall a. Mid a -> Int
go Mid b
MNil = Int
0
    go (MDeep Int
_ Int
_ SList (Node b)
_ Mid (Node b)
m SList (Node b)
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Mid (Node b) -> Int
forall a. Mid a -> Int
go Mid (Node b)
m

-- | Checks the invariants.
valid :: (Sized a) => Rope a -> Either String ()
valid :: forall a. Sized a => Rope a -> Either [Char] ()
valid = \case
  Rope a
Empty -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
  One a
a -> Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Int
forall a. Sized a => a -> Int
size a
a 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]
"an empty chunk"
  r :: Rope a
r@(Deep Int
t Int
ps SList a
pr Mid a
m SList a
sf) -> do
    let n :: Int
n = Int -> Int
tsize Int
t
        chunk :: a -> Either a Int
chunk a
c = if a -> Int
forall a. Sized a => a -> Int
size a
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then a -> Either a Int
forall a b. a -> Either a b
Left a
"an empty chunk" else Int -> Either a Int
forall a b. b -> Either a b
Right (a -> Int
forall a. Sized a => a -> Int
size a
c)
    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]
"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]
"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]
"digit too long"
    Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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]
"an empty digit"
    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
<$> (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]
P.traverse a -> Either [Char] Int
forall {a} {a}. (Sized a, IsString a) => a -> Either a Int
chunk (SList a -> [a]
forall a. SList a -> [a]
listS SList 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]
"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
<$> (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]
P.traverse a -> Either [Char] Int
forall {a} {a}. (Sized a, IsString a) => a -> Either a Int
chunk (SList a -> [a]
forall a. SList a -> [a]
listS SList a
sf)
    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 a -> Either [Char] Int
forall {a} {a}. (Sized a, IsString a) => a -> Either a Int
chunk Mid a
m
    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]
"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))
    let sizes :: [Int]
sizes = (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a. Sized a => a -> Int
size (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
r)
    Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
a Int
b -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
threshold) [Int]
sizes (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
P.drop Int
1 [Int]
sizes))) (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]
"two small chunks next to each other"