Source file `blocking_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
open Common_

type 'a t = 'a
type env = unit
type nonrec in_channel = in_channel
type nonrec out_channel = out_channel

let ( let+ ) x f = f x
let ( let* ) x f = f x
let ( and+ ) a b = a, b
let return x = x
let failwith = failwith
let fail = raise
let stdin = fun () -> stdin
let stdout = fun () -> stdout

let default_spawn f =
  let run () =
    let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "linol.spawn" in
    try f ()
    with e ->
      Log.err (fun k ->
          k "uncaught exception in `spawn`:\n%s\n%!" (Printexc.to_string e));
      raise e
  in
  ignore (Thread.create run ())

let catch f g = try f () with e -> g e
let n_bytes_written = Atomic.make 0
let n_bytes_read = Atomic.make 0

let rec read ic buf i len =
  if len > 0 then (
    let n = input ic buf i len in
    ignore (Atomic.fetch_and_add n_bytes_read n : int);
    read ic buf (i + n) (len - n)
  )

let read_line ic =
  let l = input_line ic in
  ignore (Atomic.fetch_and_add n_bytes_read (String.length l) : int);
  l

let write oc b i len =
  output oc b i len;
  ignore (Atomic.fetch_and_add n_bytes_written len : int);
  flush oc

let write_string oc s =
  output_string oc s;
  ignore (Atomic.fetch_and_add n_bytes_written (String.length s) : int);
  flush oc