Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
kstream.ml
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
(* This file is part of Markup.ml, released under the BSD 2-clause license. See doc/LICENSE for details, or visit https://github.com/aantron/markup.ml. *) open Common type 'a t = {mutable f : exn cont -> unit cont -> 'a cont -> unit} let make f = {f} let construct c = let s = ref None in (fun throw e k -> match !s with | None -> c throw (fun s' -> s := Some s'; s'.f throw e k) | Some s' -> s'.f throw e k) |> make let empty () = (fun _ e _ -> e ()) |> make let next {f} throw e k = f throw e k let next_option {f} throw k = f throw (fun () -> k None) (fun v -> k (Some v)) let next_expected {f} throw k = f throw (fun () -> throw (Failure "stream empty")) k let next_n n s throw k = if n < 0 then throw (Invalid_argument "n is negative") else let rec iterate acc = function | 0 -> k (List.rev acc) | n -> next s throw (fun () -> iterate acc 0) (fun v -> iterate (v::acc) (n - 1)) in iterate [] n let push ({f} as s) v = s.f <- fun _ _ k -> s.f <- f; k v let push_option s = function | None -> () | Some v -> push s v let push_list ({f} as s) = function | [] -> () | vs -> let remainder = ref vs in s.f <- fun throw e k -> match !remainder with | [] -> s.f <- f; f throw e k | v::vs -> remainder := vs; k v let peek s throw e k = next s throw e (fun v -> push s v; k v) let peek_option s throw k = peek s throw (fun () -> k None) (fun v -> k (Some v)) let peek_expected s throw k = peek s throw (fun () -> throw (Failure "stream empty")) k let peek_n n s throw k = next_n n s throw (fun vs -> push_list s vs; k vs) let tap g ({f} as s) = (s.f <- fun throw e k -> f throw e (fun v -> g v; k v)); fun () -> s.f <- f let checkpoint s = let buffer = ref [] in let s' = (fun throw e k -> s.f throw e (fun v -> buffer := v::!buffer; k v)) |> make in let restore () = push_list s (List.rev !buffer) in s', restore let transform f init s = let current_acc = ref (Some init) in let to_emit = ref [] in let rec operate throw e k = match !to_emit with | v::more -> to_emit := more; k v | [] -> match !current_acc with | None -> e () | Some acc -> next s throw e (fun v -> f acc v throw (fun (vs, acc') -> to_emit := vs; current_acc := acc'; operate throw e k)) in make operate let map f s = (fun throw e k -> next s throw e (fun v -> f v throw k)) |> make let rec fold f v s throw k = next s throw (fun () -> k v) (fun v' -> f v v' throw (fun v'' -> fold f v'' s throw k)) let iter f s throw k = fold (fun () v throw k -> f v throw k) () s throw k let filter_map f s = let rec emit throw e k = next s throw e (fun v -> f v throw (function | None -> emit throw e k | Some v -> k v)) in make emit let filter f s = s |> filter_map (fun v throw k -> f v throw (function | true -> k (Some v) | false -> k None)) let of_list l = let l = ref l in (fun _ e k -> match !l with | [] -> e () | v::l' -> l := l'; k v) |> make let to_list s throw k = fold (fun l v _ k -> k (v::l)) [] s throw (fun l -> k (List.rev l)) let enumerate s = let index = ref 0 in s |> map (fun v _ k -> index := !index + 1; k ((!index - 1), v))