Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
stream_io.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
(* 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 open Kstream let state_fold f initial = let state = ref initial in (fun throw e k -> f !state throw e (fun (c, new_state) -> state := new_state; k c)) |> make let string s = state_fold (fun i _ e k -> if i >= String.length s then e () else k (s.[i], i + 1)) 0 let buffer b = state_fold (fun i _ e k -> if i >= Buffer.length b then e () else k (Buffer.nth b i, i + 1)) 0 (* Optimized away by Flambda. *) type result = Count of int | Exn of exn let channel c = let ended = ref false in let buffer_length = 4096 in let buffer = Bytes.create buffer_length in let position = ref 0 in let buffered = ref 0 in (fun throw e k -> let position' = !position in if position' < !buffered then begin position := position' + 1; k (Bytes.get buffer position') end else let result = try Count (input c buffer 0 buffer_length) with exn -> Exn exn in match result with | Count 0 -> ended := true; e () | Count n -> position := 1; buffered := n; k (Bytes.get buffer 0) | Exn exn -> if !ended then e () else throw exn) |> make let file f = let c = open_in f in let s = channel c in let s' = (fun throw e k -> next s (fun exn -> close_in_noerr c; throw exn) (fun () -> close_in_noerr c; e ()) k) |> make in s', fun () -> close_in_noerr c let to_buffer s throw k = let buffer = Buffer.create 4096 in iter (fun b _ k -> Buffer.add_char buffer b; k ()) s throw (fun () -> k buffer) let to_string s throw k = to_buffer s throw (fun buffer -> k (Buffer.contents buffer)) let to_channel c s throw k = let write b throw k = let exn = try output_char c b; None with exn -> Some exn in match exn with | None -> k () | Some exn -> throw exn in iter write s throw k let to_file f s throw k = let c = open_out f in to_channel c s (fun exn -> close_out_noerr c; throw exn) (fun () -> close_out_noerr c; k ())