Source file printer.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
module Target = struct
  type t =
    | Stdout
    | Stderr
    | File of string
end

type config = {target : Target.t}

module type T = sig
  val config : config
  val print : string -> unit
end

module Builtin = struct
  module Stdout_Printer : T = struct
    let config = {target = Stdout}
    let print = print_endline
  end

  module Stderr_Printer : T = struct
    let config = {target = Stderr}
    let (print [@inline always]) = Format.fprintf Format.err_formatter "%s\n"
  end

  module Stdout_Mutex_Printer : T = struct
    let mutex = Mutex.create ()
    let config = {target = Stdout}

    let[@inline always] print msg =
      Mutex.lock mutex;
      print_endline msg;
      Mutex.unlock mutex
  end

  module Stderr_Mutex_Printer : T = struct
    let mutex = Mutex.create ()
    let config = {target = Stdout}

    let[@inline always] print msg =
      Mutex.lock mutex;
      Format.fprintf Format.err_formatter "%s\n" msg;
      Mutex.unlock mutex
  end

  module File_Printer (T : sig
    val path : string
  end) : T = struct
    let config = {target = File T.path}
    let file = open_out T.path

    let[@inline always] print (str : string) =
      output_string file (str ^ "\n")
  end

  module File_Mutex_Printer (T : sig
    val path : string
  end) : T = struct
    let config = {target = File T.path}
    let mutex = Mutex.create ()
    let file = open_out T.path

    let[@inline always] print (str : string) =
      Mutex.lock mutex;
      output_string file (str ^ "\n");
      Mutex.unlock mutex
  end
end