1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
open! Import
external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
= "caml_blit_string"
[@@noalloc]
(** Polyfill for pre-4.09.0 *)
type t =
{ mutable buffer : bytes
; mutable position : int
; mutable length : int
; mutable last : string
(** Cache latest delivered contents to avoid unnecessary re-rendering *)
; mutable last_len : int (** Avoids some string comparisons on [last] *)
; ppf : Format.formatter Lazy.t
}
(** Invariants:
- [0 <= position <= length]
- [length = Bytes.length buffer] *)
let resize t more =
let old_pos = t.position and old_len = t.length in
let new_len =
let res = ref old_len in
while old_pos + more > !res do
res := 2 * !res
done;
!res
in
let new_buffer = Bytes.create new_len in
Bytes.blit ~src:t.buffer ~src_pos:0 ~dst:new_buffer ~dst_pos:0 ~len:t.position;
t.buffer <- new_buffer;
t.length <- new_len
let advance t len =
let new_position = t.position + len in
if new_position > t.length then resize t len;
t.position <- new_position
let lift_write ~len ~write =
Staged.inj (fun t x ->
let position = t.position in
advance t len;
write x ~into:t.buffer ~pos:position)
let add_char b c =
let pos = b.position in
if pos >= b.length then resize b 1;
Bytes.unsafe_set b.buffer pos c;
b.position <- pos + 1
let add_substring t s ~off ~len =
if off < 0 || len < 0 || off > String.length s - len then
invalid_arg "Line_buffer.add_substring";
let position = t.position in
advance t len;
unsafe_blit_string s off t.buffer position len
let add_string b s =
let len = String.length s in
let new_position = b.position + len in
if new_position > b.length then resize b len;
unsafe_blit_string s 0 b.buffer b.position len;
b.position <- new_position
let add_line_buffer ~dst ~src =
let position = dst.position in
let len = src.position in
advance dst len;
Bytes.unsafe_blit ~src:src.buffer ~src_pos:0 ~dst:dst.buffer ~dst_pos:position
~len
let create ~size =
let buffer = Bytes.create size in
let rec ppf =
lazy
(let ppf =
Format.make_formatter
(fun s off len -> add_substring t s ~off ~len)
(fun () -> ())
in
Fmt.set_style_renderer ppf `Ansi_tty;
ppf)
and t =
{ buffer; position = 0; length = size; ppf; last = ""; last_len = 0 }
in
t
let with_ppf t f =
let ppf = Lazy.force t.ppf in
let a = f ppf in
Format.pp_print_flush ppf ();
a
let reset t = t.position <- 0
let contents t =
let last = t.last in
let last_len = t.last_len in
let current_len = t.position in
let current = Bytes.sub_string t.buffer ~pos:0 ~len:current_len in
reset t;
match Int.equal last_len current_len && String.equal last current with
| true -> `Clean t.last
| false ->
t.last <- current;
t.last_len <- current_len;
`Dirty current
type mark = int
let current_position t = t.position
module Span = struct
type t = { pos : int; len : int }
let pp ppf t = Fmt.pf ppf "{ pos = %d; len = %d }" t.pos t.len
let empty = { pos = 0; len = 0 }
let between_marks a b = { pos = a; len = b - a }
end
let skip t (span : Span.t) =
advance t span.len