Pure OCaml Yaml 1.2 reader and writer using Bytesrw
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** YAML parser - converts tokens to semantic events via state machine *)
7
8(** Parser states *)
9type state =
10 | Stream_start
11 | Implicit_document_start
12 | Document_start
13 | Document_content
14 | Document_content_done (* After parsing a node, check for unexpected content *)
15 | Document_end
16 | Block_node
17 | Block_node_or_indentless_sequence
18 | Flow_node
19 | Block_sequence_first_entry
20 | Block_sequence_entry
21 | Indentless_sequence_entry
22 | Block_mapping_first_key
23 | Block_mapping_key
24 | Block_mapping_value
25 | Flow_sequence_first_entry
26 | Flow_sequence_entry
27 | Flow_sequence_entry_mapping_key
28 | Flow_sequence_entry_mapping_value
29 | Flow_sequence_entry_mapping_end
30 | Flow_mapping_first_key
31 | Flow_mapping_key
32 | Flow_mapping_value
33 | Flow_mapping_empty_value
34 | End
35
36type t = {
37 scanner : Scanner.t;
38 mutable state : state;
39 mutable states : state list; (** State stack *)
40 mutable marks : Span.t list; (** Mark stack for span tracking *)
41 mutable version : (int * int) option;
42 mutable tag_directives : (string * string) list;
43 mutable current_token : Token.spanned option;
44 mutable finished : bool;
45 mutable explicit_doc_end : bool; (** True if last doc ended with explicit ... *)
46 mutable stream_start : bool; (** True if we haven't emitted any documents yet *)
47}
48
49let create scanner = {
50 scanner;
51 state = Stream_start;
52 states = [];
53 marks = [];
54 version = None;
55 tag_directives = [
56 ("!", "!");
57 ("!!", "tag:yaml.org,2002:");
58 ];
59 current_token = None;
60 finished = false;
61 explicit_doc_end = false;
62 stream_start = true;
63}
64
65let of_string s = create (Scanner.of_string s)
66let of_scanner = create
67let of_input i = create (Scanner.of_input i)
68let of_reader r = create (Scanner.of_reader r)
69
70(** Get current token, fetching if needed *)
71let current_token t =
72 match t.current_token with
73 | Some tok -> tok
74 | None ->
75 let tok = Scanner.next t.scanner in
76 t.current_token <- tok;
77 match tok with
78 | Some tok -> tok
79 | None -> Error.raise Unexpected_eof
80
81(** Peek at current token *)
82let peek_token t =
83 match t.current_token with
84 | Some _ -> t.current_token
85 | None ->
86 t.current_token <- Scanner.next t.scanner;
87 t.current_token
88
89(** Skip current token *)
90let skip_token t =
91 t.current_token <- None
92
93(** Check if current token matches *)
94let check t pred =
95 match peek_token t with
96 | Some tok -> pred tok.token
97 | None -> false
98
99(** Check for specific token *)
100let check_token t token_match =
101 check t token_match
102
103(** Push state onto stack *)
104let push_state t s =
105 t.states <- s :: t.states
106
107(** Pop state from stack *)
108let pop_state t =
109 match t.states with
110 | s :: rest ->
111 t.states <- rest;
112 s
113 | [] -> End
114
115(** Resolve a tag *)
116let resolve_tag t ~handle ~suffix =
117 if handle = "" then
118 (* Verbatim tag - suffix is already the full URI *)
119 suffix
120 else
121 match List.assoc_opt handle t.tag_directives with
122 | Some prefix -> prefix ^ suffix
123 | None when handle = "!" -> "!" ^ suffix
124 | None -> Error.raise (Invalid_tag (handle ^ suffix))
125
126(** Process directives at document start *)
127let process_directives t =
128 t.version <- None;
129 t.tag_directives <- [("!", "!"); ("!!", "tag:yaml.org,2002:")];
130
131 while check t (function
132 | Token.Version_directive _ | Token.Tag_directive _ -> true
133 | _ -> false)
134 do
135 let tok = current_token t in
136 skip_token t;
137 match tok.token with
138 | Token.Version_directive { major; minor } ->
139 if t.version <> None then
140 Error.raise_span tok.span (Invalid_yaml_version "duplicate YAML directive");
141 t.version <- Some (major, minor)
142 | Token.Tag_directive { handle; prefix } ->
143 (* Skip empty tag directives (these are reserved/unknown directives that were ignored) *)
144 if handle = "" && prefix = "" then
145 () (* Ignore reserved directives *)
146 else begin
147 if List.mem_assoc handle t.tag_directives &&
148 handle <> "!" && handle <> "!!" then
149 Error.raise_span tok.span (Invalid_tag_directive ("duplicate tag handle: " ^ handle));
150 t.tag_directives <- (handle, prefix) :: t.tag_directives
151 end
152 | _ -> ()
153 done
154
155(** Parse anchor and/or tag properties *)
156let parse_properties t =
157 let anchor = ref None in
158 let tag = ref None in
159
160 while check t (function
161 | Token.Anchor _ | Token.Tag _ -> true
162 | _ -> false)
163 do
164 let tok = current_token t in
165 skip_token t;
166 match tok.token with
167 | Token.Anchor name ->
168 if Option.is_some !anchor then
169 Error.raise_span tok.span (Duplicate_anchor name);
170 anchor := Some name
171 | Token.Tag { handle; suffix } ->
172 if Option.is_some !tag then
173 Error.raise_span tok.span (Invalid_tag "duplicate tag");
174 let resolved =
175 if handle = "" && suffix = "" then None
176 else if handle = "!" && suffix = "" then Some "!"
177 else Some (resolve_tag t ~handle ~suffix)
178 in
179 tag := resolved
180 | _ -> ()
181 done;
182 (!anchor, !tag)
183
184(** Empty scalar event *)
185let empty_scalar_event ~anchor ~tag span =
186 Event.Scalar {
187 anchor;
188 tag;
189 value = "";
190 plain_implicit = tag = None;
191 quoted_implicit = false;
192 style = `Plain;
193 }, span
194
195(** Parse stream start *)
196let parse_stream_start t =
197 let tok = current_token t in
198 skip_token t;
199 match tok.token with
200 | Token.Stream_start encoding ->
201 t.state <- Implicit_document_start;
202 Event.Stream_start { encoding }, tok.span
203 | _ ->
204 Error.raise_span tok.span (Unexpected_token "expected stream start")
205
206(** Parse document start (implicit or explicit) *)
207let parse_document_start t ~implicit =
208 process_directives t;
209
210 if not implicit then begin
211 let tok = current_token t in
212 match tok.token with
213 | Token.Document_start ->
214 skip_token t
215 | _ ->
216 Error.raise_span tok.span Expected_document_start
217 end;
218
219 let span = match peek_token t with
220 | Some tok -> tok.span
221 | None -> Span.point Position.initial
222 in
223
224 (* After first document, stream_start is false *)
225 t.stream_start <- false;
226 push_state t Document_end;
227 t.state <- Document_content;
228 Event.Document_start { version = t.version; implicit }, span
229
230(** Parse document end *)
231let parse_document_end t =
232 let implicit = not (check t (function Token.Document_end -> true | _ -> false)) in
233 let span = match peek_token t with
234 | Some tok -> tok.span
235 | None -> Span.point Position.initial
236 in
237
238 if not implicit then skip_token t;
239
240 (* Track if this document ended explicitly with ... *)
241 t.explicit_doc_end <- not implicit;
242 t.state <- Implicit_document_start;
243 Event.Document_end { implicit }, span
244
245(** Parse node in various contexts *)
246let parse_node t ~block ~indentless =
247 let tok = current_token t in
248 match tok.token with
249 | Token.Alias name ->
250 skip_token t;
251 t.state <- pop_state t;
252 Event.Alias { anchor = name }, tok.span
253
254 | Token.Anchor _ | Token.Tag _ ->
255 let anchor, tag = parse_properties t in
256 let tok = current_token t in
257 (match tok.token with
258 | Token.Block_entry when indentless ->
259 t.state <- Indentless_sequence_entry;
260 Event.Sequence_start {
261 anchor; tag;
262 implicit = tag = None;
263 style = `Block;
264 }, tok.span
265
266 | Token.Block_sequence_start when block ->
267 t.state <- Block_sequence_first_entry;
268 skip_token t;
269 Event.Sequence_start {
270 anchor; tag;
271 implicit = tag = None;
272 style = `Block;
273 }, tok.span
274
275 | Token.Block_mapping_start when block ->
276 t.state <- Block_mapping_first_key;
277 skip_token t;
278 Event.Mapping_start {
279 anchor; tag;
280 implicit = tag = None;
281 style = `Block;
282 }, tok.span
283
284 | Token.Flow_sequence_start ->
285 t.state <- Flow_sequence_first_entry;
286 skip_token t;
287 Event.Sequence_start {
288 anchor; tag;
289 implicit = tag = None;
290 style = `Flow;
291 }, tok.span
292
293 | Token.Flow_mapping_start ->
294 t.state <- Flow_mapping_first_key;
295 skip_token t;
296 Event.Mapping_start {
297 anchor; tag;
298 implicit = tag = None;
299 style = `Flow;
300 }, tok.span
301
302 | Token.Scalar { style; value } ->
303 skip_token t;
304 t.state <- pop_state t;
305 let plain_implicit = tag = None && style = `Plain in
306 let quoted_implicit = tag = None && style <> `Plain in
307 Event.Scalar {
308 anchor; tag; value;
309 plain_implicit; quoted_implicit; style;
310 }, tok.span
311
312 | _ ->
313 (* Empty node *)
314 t.state <- pop_state t;
315 empty_scalar_event ~anchor ~tag tok.span)
316
317 | Token.Block_sequence_start when block ->
318 t.state <- Block_sequence_first_entry;
319 skip_token t;
320 Event.Sequence_start {
321 anchor = None; tag = None;
322 implicit = true;
323 style = `Block;
324 }, tok.span
325
326 | Token.Block_mapping_start when block ->
327 t.state <- Block_mapping_first_key;
328 skip_token t;
329 Event.Mapping_start {
330 anchor = None; tag = None;
331 implicit = true;
332 style = `Block;
333 }, tok.span
334
335 | Token.Flow_sequence_start ->
336 t.state <- Flow_sequence_first_entry;
337 skip_token t;
338 Event.Sequence_start {
339 anchor = None; tag = None;
340 implicit = true;
341 style = `Flow;
342 }, tok.span
343
344 | Token.Flow_mapping_start ->
345 t.state <- Flow_mapping_first_key;
346 skip_token t;
347 Event.Mapping_start {
348 anchor = None; tag = None;
349 implicit = true;
350 style = `Flow;
351 }, tok.span
352
353 | Token.Block_entry when indentless ->
354 t.state <- Indentless_sequence_entry;
355 Event.Sequence_start {
356 anchor = None; tag = None;
357 implicit = true;
358 style = `Block;
359 }, tok.span
360
361 | Token.Scalar { style; value } ->
362 skip_token t;
363 t.state <- pop_state t;
364 let plain_implicit = style = `Plain in
365 let quoted_implicit = style <> `Plain in
366 Event.Scalar {
367 anchor = None; tag = None; value;
368 plain_implicit; quoted_implicit; style;
369 }, tok.span
370
371 | _ ->
372 (* Empty node *)
373 t.state <- pop_state t;
374 empty_scalar_event ~anchor:None ~tag:None tok.span
375
376(** Parse block sequence entry *)
377let parse_block_sequence_entry t =
378 let tok = current_token t in
379 match tok.token with
380 | Token.Block_entry ->
381 skip_token t;
382 if check t (function
383 | Token.Block_entry | Token.Block_end -> true
384 | _ -> false)
385 then begin
386 t.state <- Block_sequence_entry;
387 empty_scalar_event ~anchor:None ~tag:None tok.span
388 end else begin
389 push_state t Block_sequence_entry;
390 parse_node t ~block:true ~indentless:false
391 end
392 | Token.Block_end ->
393 skip_token t;
394 t.state <- pop_state t;
395 Event.Sequence_end, tok.span
396 | _ ->
397 Error.raise_span tok.span Expected_block_entry
398
399(** Parse block mapping key *)
400let parse_block_mapping_key t =
401 let tok = current_token t in
402 match tok.token with
403 | Token.Key ->
404 skip_token t;
405 if check t (function
406 | Token.Key | Token.Value | Token.Block_end -> true
407 | _ -> false)
408 then begin
409 t.state <- Block_mapping_value;
410 empty_scalar_event ~anchor:None ~tag:None tok.span
411 end else begin
412 push_state t Block_mapping_value;
413 parse_node t ~block:true ~indentless:true
414 end
415 (* Handle value without explicit key - key is empty/null *)
416 | Token.Value ->
417 t.state <- Block_mapping_value;
418 empty_scalar_event ~anchor:None ~tag:None tok.span
419 | Token.Block_end ->
420 skip_token t;
421 t.state <- pop_state t;
422 Event.Mapping_end, tok.span
423 | _ ->
424 Error.raise_span tok.span Expected_key
425
426(** Parse block mapping value *)
427let parse_block_mapping_value t =
428 let tok = current_token t in
429 match tok.token with
430 | Token.Value ->
431 skip_token t;
432 if check t (function
433 | Token.Key | Token.Value | Token.Block_end -> true
434 | _ -> false)
435 then begin
436 t.state <- Block_mapping_key;
437 empty_scalar_event ~anchor:None ~tag:None tok.span
438 end else begin
439 push_state t Block_mapping_key;
440 parse_node t ~block:true ~indentless:true
441 end
442 | _ ->
443 (* Implicit empty value *)
444 t.state <- Block_mapping_key;
445 empty_scalar_event ~anchor:None ~tag:None tok.span
446
447(** Parse indentless sequence entry *)
448let parse_indentless_sequence_entry t =
449 let tok = current_token t in
450 match tok.token with
451 | Token.Block_entry ->
452 skip_token t;
453 if check t (function
454 | Token.Block_entry | Token.Key | Token.Value | Token.Block_end -> true
455 | _ -> false)
456 then begin
457 t.state <- Indentless_sequence_entry;
458 empty_scalar_event ~anchor:None ~tag:None tok.span
459 end else begin
460 push_state t Indentless_sequence_entry;
461 parse_node t ~block:true ~indentless:false
462 end
463 | _ ->
464 t.state <- pop_state t;
465 Event.Sequence_end, tok.span
466
467(** Parse flow sequence *)
468let rec parse_flow_sequence_entry t ~first =
469 let tok = current_token t in
470 match tok.token with
471 | Token.Flow_sequence_end ->
472 skip_token t;
473 t.state <- pop_state t;
474 Event.Sequence_end, tok.span
475 | Token.Flow_entry when not first ->
476 skip_token t;
477 parse_flow_sequence_entry_internal t
478 | _ when first ->
479 parse_flow_sequence_entry_internal t
480 | _ ->
481 Error.raise_span tok.span Expected_sequence_end
482
483and parse_flow_sequence_entry_internal t =
484 let tok = current_token t in
485 match tok.token with
486 | Token.Flow_sequence_end ->
487 (* Trailing comma case - don't emit empty scalar, just go back to sequence entry state *)
488 skip_token t;
489 t.state <- pop_state t;
490 Event.Sequence_end, tok.span
491 | Token.Flow_entry ->
492 (* Double comma or comma after comma - invalid *)
493 Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow sequence")
494 | Token.Key ->
495 skip_token t;
496 t.state <- Flow_sequence_entry_mapping_key;
497 Event.Mapping_start {
498 anchor = None; tag = None;
499 implicit = true;
500 style = `Flow;
501 }, tok.span
502 | Token.Value ->
503 (* Implicit empty key mapping: [ : value ] *)
504 t.state <- Flow_sequence_entry_mapping_key;
505 Event.Mapping_start {
506 anchor = None; tag = None;
507 implicit = true;
508 style = `Flow;
509 }, tok.span
510 | _ ->
511 push_state t Flow_sequence_entry;
512 parse_node t ~block:false ~indentless:false
513
514(** Parse flow sequence entry mapping *)
515let parse_flow_sequence_entry_mapping_key t =
516 let tok = current_token t in
517 if check t (function
518 | Token.Value | Token.Flow_entry | Token.Flow_sequence_end -> true
519 | _ -> false)
520 then begin
521 t.state <- Flow_sequence_entry_mapping_value;
522 empty_scalar_event ~anchor:None ~tag:None tok.span
523 end else begin
524 push_state t Flow_sequence_entry_mapping_value;
525 parse_node t ~block:false ~indentless:false
526 end
527
528let parse_flow_sequence_entry_mapping_value t =
529 let tok = current_token t in
530 match tok.token with
531 | Token.Value ->
532 skip_token t;
533 if check t (function
534 | Token.Flow_entry | Token.Flow_sequence_end -> true
535 | _ -> false)
536 then begin
537 t.state <- Flow_sequence_entry_mapping_end;
538 empty_scalar_event ~anchor:None ~tag:None tok.span
539 end else begin
540 push_state t Flow_sequence_entry_mapping_end;
541 parse_node t ~block:false ~indentless:false
542 end
543 | _ ->
544 t.state <- Flow_sequence_entry_mapping_end;
545 empty_scalar_event ~anchor:None ~tag:None tok.span
546
547let parse_flow_sequence_entry_mapping_end t =
548 let tok = current_token t in
549 t.state <- Flow_sequence_entry;
550 Event.Mapping_end, tok.span
551
552(** Parse flow mapping *)
553let rec parse_flow_mapping_key t ~first =
554 let tok = current_token t in
555 match tok.token with
556 | Token.Flow_mapping_end ->
557 skip_token t;
558 t.state <- pop_state t;
559 Event.Mapping_end, tok.span
560 | Token.Flow_entry when not first ->
561 skip_token t;
562 parse_flow_mapping_key_internal t
563 | _ when first ->
564 parse_flow_mapping_key_internal t
565 | _ ->
566 Error.raise_span tok.span Expected_mapping_end
567
568and parse_flow_mapping_key_internal t =
569 let tok = current_token t in
570 match tok.token with
571 | Token.Flow_mapping_end ->
572 (* Trailing comma case - don't emit empty scalar, just return to key state *)
573 skip_token t;
574 t.state <- pop_state t;
575 Event.Mapping_end, tok.span
576 | Token.Flow_entry ->
577 (* Double comma or comma after comma - invalid *)
578 Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow mapping")
579 | Token.Key ->
580 skip_token t;
581 if check t (function
582 | Token.Value | Token.Flow_entry | Token.Flow_mapping_end -> true
583 | _ -> false)
584 then begin
585 t.state <- Flow_mapping_value;
586 empty_scalar_event ~anchor:None ~tag:None tok.span
587 end else begin
588 push_state t Flow_mapping_value;
589 parse_node t ~block:false ~indentless:false
590 end
591 | _ ->
592 push_state t Flow_mapping_value;
593 parse_node t ~block:false ~indentless:false
594
595let parse_flow_mapping_value t ~empty =
596 let tok = current_token t in
597 if empty then begin
598 t.state <- Flow_mapping_key;
599 empty_scalar_event ~anchor:None ~tag:None tok.span
600 end else
601 match tok.token with
602 | Token.Value ->
603 skip_token t;
604 if check t (function
605 | Token.Flow_entry | Token.Flow_mapping_end -> true
606 | _ -> false)
607 then begin
608 t.state <- Flow_mapping_key;
609 empty_scalar_event ~anchor:None ~tag:None tok.span
610 end else begin
611 push_state t Flow_mapping_key;
612 parse_node t ~block:false ~indentless:false
613 end
614 | _ ->
615 t.state <- Flow_mapping_key;
616 empty_scalar_event ~anchor:None ~tag:None tok.span
617
618(** Main state machine dispatcher *)
619let rec parse t =
620 match t.state with
621 | Stream_start ->
622 parse_stream_start t
623
624 | Implicit_document_start ->
625 (* Skip any document end markers before checking what's next *)
626 while check t (function Token.Document_end -> true | _ -> false) do
627 t.explicit_doc_end <- true; (* Seeing ... counts as explicit end *)
628 skip_token t
629 done;
630
631 let tok = current_token t in
632 (match tok.token with
633 | Token.Stream_end ->
634 skip_token t;
635 t.state <- End;
636 t.finished <- true;
637 Event.Stream_end, tok.span
638 | Token.Version_directive _ | Token.Tag_directive _ ->
639 (* Directives are only allowed at stream start or after explicit ... (MUS6/01) *)
640 if not t.stream_start && not t.explicit_doc_end then
641 Error.raise_span tok.span (Invalid_directive "directives require explicit document end '...' before them");
642 parse_document_start t ~implicit:false
643 | Token.Document_start ->
644 parse_document_start t ~implicit:false
645 (* These tokens are invalid at document start - they indicate leftover junk *)
646 | Token.Flow_sequence_end | Token.Flow_mapping_end | Token.Flow_entry
647 | Token.Block_end | Token.Value ->
648 Error.raise_span tok.span (Unexpected_token "unexpected token at document start")
649 | _ ->
650 parse_document_start t ~implicit:true)
651
652 | Document_start ->
653 parse_document_start t ~implicit:false
654
655 | Document_content ->
656 if check t (function
657 | Token.Version_directive _ | Token.Tag_directive _
658 | Token.Document_start | Token.Document_end | Token.Stream_end -> true
659 | _ -> false)
660 then begin
661 let tok = current_token t in
662 t.state <- pop_state t;
663 empty_scalar_event ~anchor:None ~tag:None tok.span
664 end else begin
665 (* Push Document_content_done so we return there after parsing the node.
666 This allows us to check for unexpected content after the node. *)
667 push_state t Document_content_done;
668 parse_node t ~block:true ~indentless:false
669 end
670
671 | Document_content_done ->
672 (* After parsing a node in document content, check for unexpected content *)
673 if check t (function
674 | Token.Version_directive _ | Token.Tag_directive _
675 | Token.Document_start | Token.Document_end | Token.Stream_end -> true
676 | _ -> false)
677 then begin
678 (* Valid document boundary - continue to Document_end *)
679 t.state <- pop_state t;
680 parse t (* Continue to emit the next event *)
681 end else begin
682 (* Unexpected content after document value - this is an error (KS4U, BS4K) *)
683 let tok = current_token t in
684 Error.raise_span tok.span
685 (Unexpected_token "content not allowed after document value")
686 end
687
688 | Document_end ->
689 parse_document_end t
690
691 | Block_node ->
692 parse_node t ~block:true ~indentless:false
693
694 | Block_node_or_indentless_sequence ->
695 parse_node t ~block:true ~indentless:true
696
697 | Flow_node ->
698 parse_node t ~block:false ~indentless:false
699
700 | Block_sequence_first_entry ->
701 t.state <- Block_sequence_entry;
702 parse_block_sequence_entry t
703
704 | Block_sequence_entry ->
705 parse_block_sequence_entry t
706
707 | Indentless_sequence_entry ->
708 parse_indentless_sequence_entry t
709
710 | Block_mapping_first_key ->
711 t.state <- Block_mapping_key;
712 parse_block_mapping_key t
713
714 | Block_mapping_key ->
715 parse_block_mapping_key t
716
717 | Block_mapping_value ->
718 parse_block_mapping_value t
719
720 | Flow_sequence_first_entry ->
721 parse_flow_sequence_entry t ~first:true
722
723 | Flow_sequence_entry ->
724 parse_flow_sequence_entry t ~first:false
725
726 | Flow_sequence_entry_mapping_key ->
727 parse_flow_sequence_entry_mapping_key t
728
729 | Flow_sequence_entry_mapping_value ->
730 parse_flow_sequence_entry_mapping_value t
731
732 | Flow_sequence_entry_mapping_end ->
733 parse_flow_sequence_entry_mapping_end t
734
735 | Flow_mapping_first_key ->
736 parse_flow_mapping_key t ~first:true
737
738 | Flow_mapping_key ->
739 parse_flow_mapping_key t ~first:false
740
741 | Flow_mapping_value ->
742 parse_flow_mapping_value t ~empty:false
743
744 | Flow_mapping_empty_value ->
745 parse_flow_mapping_value t ~empty:true
746
747 | End ->
748 let span = Span.point Position.initial in
749 t.finished <- true;
750 Event.Stream_end, span
751
752(** Get next event *)
753let next t =
754 if t.finished then None
755 else begin
756 let event, span = parse t in
757 Some { Event.event; span }
758 end
759
760(** Peek at next event *)
761let peek t =
762 (* Parser is not easily peekable without full state save/restore *)
763 (* For now, we don't support peek - could add caching if needed *)
764 if t.finished then None
765 else
766 (* Just call next and the caller will have to deal with it *)
767 next t
768
769(** Iterate over all events *)
770let iter f t =
771 let rec loop () =
772 match next t with
773 | None -> ()
774 | Some ev -> f ev; loop ()
775 in
776 loop ()
777
778(** Fold over all events *)
779let fold f init t =
780 let rec loop acc =
781 match next t with
782 | None -> acc
783 | Some ev -> loop (f acc ev)
784 in
785 loop init
786
787(** Convert to list *)
788let to_list t =
789 fold (fun acc ev -> ev :: acc) [] t |> List.rev