|
| 1 | +(* Originally from https://github.com/robur-coop/utcp, written by |
| 2 | + Calascibetta Romain <[email protected]> *) |
| 3 | + |
| 4 | +(* A rope data structure where each node is a line *) |
| 5 | + |
| 6 | +type t = |
| 7 | + | Str of string array * bool * int * int |
| 8 | + | App of t * t * int * int |
| 9 | + |
| 10 | +let length = function |
| 11 | + | Str (_, _, len, _) -> len |
| 12 | + | App (_, _, len, _) -> len |
| 13 | + |
| 14 | +let height = function |
| 15 | + | Str _ -> 0 |
| 16 | + | App (_, _, _, h) -> h |
| 17 | + |
| 18 | +(* keep compatibility with 4.08 *) |
| 19 | +let max_int (a : int) (b : int) = max a b |
| 20 | +let min_int (a : int) (b : int) = min a b |
| 21 | +external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit |
| 22 | + = "caml_blit_string" [@@noalloc] |
| 23 | + |
| 24 | +let append t1 t2 = |
| 25 | + App (t1, t2, length t1 + length t2, 1 + max_int (height t1) (height t2)) |
| 26 | + |
| 27 | +let empty = Str (Array.make 0 "", true, 0, 0) |
| 28 | + |
| 29 | +let rec unsafe_sub t start stop = |
| 30 | + if start == 0 && stop = length t then |
| 31 | + t |
| 32 | + else if start == stop then |
| 33 | + empty |
| 34 | + else match t with |
| 35 | + | Str (data, nl, len, off) -> |
| 36 | + assert (stop <= len); |
| 37 | + Str (data, nl, stop - start, off + start) |
| 38 | + | App (l, r, _, _) -> |
| 39 | + let len = length l in |
| 40 | + if stop <= len then unsafe_sub l start stop |
| 41 | + else if start >= len then unsafe_sub r (start - len) (stop - len) |
| 42 | + else append (unsafe_sub l start len) (unsafe_sub r 0 (stop - len)) |
| 43 | + |
| 44 | +let chop t ?(off = 0) len = |
| 45 | + if len < 0 || len > length t - off |
| 46 | + then invalid_arg "Rope.chop"; |
| 47 | + if len == 0 then empty else unsafe_sub t off (off + len) |
| 48 | + |
| 49 | +let shift t len = |
| 50 | + if len < 0 then t |
| 51 | + else if len == 0 then t |
| 52 | + else |
| 53 | + let max = length t in |
| 54 | + let len = min_int max len in |
| 55 | + let l = len + (max - len) in |
| 56 | + unsafe_sub t len l |
| 57 | + |
| 58 | +let rec last_is_nl = function |
| 59 | + | Str (a, nl, len, off) -> if Array.length a - off = len then nl else true |
| 60 | + | App (_, r, _, _) -> last_is_nl r |
| 61 | + |
| 62 | +let rec byte_length = function |
| 63 | + | Str (s, _, len, off) as a -> |
| 64 | + let sum = ref 0 in |
| 65 | + for idx = off to len + off - 1 do |
| 66 | + let data = Array.unsafe_get s idx in |
| 67 | + sum := !sum + String.length data + 1 |
| 68 | + done; |
| 69 | + !sum - if last_is_nl a then 0 else 1 |
| 70 | + | App (l, r, _, _) -> byte_length l + byte_length r |
| 71 | + |
| 72 | +let rec into_bytes buf dst_off = function |
| 73 | + | Str (s, _, len, off) as a -> |
| 74 | + let off' = ref dst_off in |
| 75 | + for idx = off to len + off - 1 do |
| 76 | + let data = Array.unsafe_get s idx in |
| 77 | + Bytes.unsafe_blit_string data 0 buf !off' (String.length data); |
| 78 | + off' := !off' + String.length data + 1; |
| 79 | + if idx - off < len - 1 || (idx - off = len - 1 && last_is_nl a) then |
| 80 | + Bytes.unsafe_set buf (!off' - 1) '\n' |
| 81 | + done |
| 82 | + | App (l, r, _, _) -> |
| 83 | + into_bytes buf dst_off l; |
| 84 | + into_bytes buf (dst_off + byte_length l) r |
| 85 | + |
| 86 | +let to_strings t = |
| 87 | + let rec go acc = function |
| 88 | + | Str (s, _nl, len, off) -> |
| 89 | + let r = ref [] in |
| 90 | + for idx = off to len + off - 1 do |
| 91 | + let data = Array.unsafe_get s idx in |
| 92 | + r := data :: !r |
| 93 | + done; |
| 94 | + List.rev !r @ acc |
| 95 | + | App (l, r, _, _) -> go (go acc r) l in |
| 96 | + go [] t |
| 97 | + |
| 98 | +let to_string t = |
| 99 | + let len = byte_length t in |
| 100 | + let buf = Bytes.create len in |
| 101 | + into_bytes buf 0 t; |
| 102 | + Bytes.unsafe_to_string buf |
| 103 | + |
| 104 | +let concat a b = append a b |
| 105 | +let prepend (str, nl) t = append (Str (Array.make 1 str, nl, 1, 0)) t |
| 106 | + |
| 107 | +let append t (str, nl) = append t (Str (Array.make 1 str, nl, 1, 0)) |
| 108 | + |
| 109 | +let of_strings xs last_is_nl = |
| 110 | + let d = Array.of_list xs in |
| 111 | + Str (d, last_is_nl, Array.length d, 0) |
| 112 | + |
| 113 | +let of_string str = |
| 114 | + let splitted = String.split_on_char '\n' str in |
| 115 | + let last_is_nl = String.unsafe_get str (String.length str - 1) = '\n' in |
| 116 | + let splitted = if last_is_nl then List.rev (List.tl (List.rev splitted)) else splitted in |
| 117 | + let d = Array.of_list splitted in |
| 118 | + Str (d, last_is_nl, Array.length d, 0) |
| 119 | + |
| 120 | +let equal a b = String.equal (to_string a) (to_string b) |
0 commit comments