File: interface_tools.ml

package info (click to toggle)
ocaml-stdcompat 14-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 5,152 kB
  • sloc: ml: 22,329; makefile: 211; sh: 120
file content (180 lines) | stat: -rw-r--r-- 4,000 bytes parent folder | download | duplicates (2)
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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
module Option = struct
  type 'a t = 'a option

  let map f o =
    match o with
    | None -> None
    | Some x -> Some (f x)

  let equal p o o' =
    match o, o' with
    | None, None -> true
    | Some x, Some y -> p x y
    | Some _, None
    | None, Some _ -> false

  let exists p o =
    match o with
    | None -> false
    | Some x -> p x

  let some x = Some x

  let iter f o =
    match o with
    | None -> ()
    | Some x -> f x

  let filter p o =
    match o with
    | Some x when p x -> o
    | None | Some _ -> None
end

let try_close f ~close =
  match f () with
  | result ->
      close ();
      result
  | exception e ->
      begin
        try
          close ()
        with _ ->
          ()
      end;
      e |> raise

module Version = struct
  type t = {
      major : int;
      minor : int;
      patch : int;
    }

  let compare (v : t) (v' : t) =
    compare v v'

  let equal (v : t) (v' : t) =
    v = v'

  let hash (v : t) =
    Hashtbl.hash v

  let of_string version_line =
    let index =
      match String.rindex version_line ' ' with
      | space_index -> space_index + 1
      | exception Not_found -> 0 in
    { major = String.sub version_line index 1 |> int_of_string;
      minor = String.sub version_line (index + 2) 2 |> int_of_string;
      patch = 0; }

(*
  let of_command_line command_line =
    let version_command_line = Printf.sprintf "%s -version" command_line in
    let in_channel = Unix.open_process_in version_command_line in
    let version_line =
      try_close
        ~close:(fun () ->
          assert (in_channel |> Unix.close_process_in = Unix.WEXITED 0))
      @@ fun () -> input_line in_channel in
    of_version_line version_line
*)

  let to_string ?(sep = ".") ?(include_patch = true) { major; minor; patch } =
    if include_patch then
      Printf.sprintf "%d%s%.2d%s%d" major sep minor sep patch
    else
      Printf.sprintf "%d%s%.2d" major sep minor
end

module Lexing = struct
  include Lexing

  let set_filename lexbuf filename =
    lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename }
end

let signature_of_in_channel ?filename in_channel =
  let lexbuf = in_channel |> Lexing.from_channel in
  filename |> Option.iter (Lexing.set_filename lexbuf);
  lexbuf |> Parse.interface

(*
module Interpreter = struct
  type t = {
      command_line : string;
      version : Version.t;
    }

  let of_command_line command_line =
    let version = Version.of_command_line command_line in
    { command_line; version }
end
*)

module Buffer = struct
  include Buffer

  let add_channel_no_wait buffer in_channel size =
    let bytes = Bytes.create size in
    let read = input in_channel bytes 0 size in
    Buffer.add_subbytes buffer bytes 0 read;
    read

  let add_channel_to_the_end ?(chunk_size = 4096) ?(continue = fun () -> true)
      buffer in_channel =
    while
      add_channel_no_wait buffer in_channel chunk_size <> 0 && continue () do
      ()
    done

  let suffix_of_length buffer len =
    sub buffer (length buffer - len) len

  let has_suffix buffer suffix =
    length buffer >= String.length suffix &&
    suffix_of_length buffer (String.length suffix) = suffix
end

module String = struct
  include String

  let suffix_of_length s len =
    sub s (length s - len) len

  let has_suffix s ~suffix =
    length s >= length suffix &&
    suffix_of_length s (length suffix) = suffix

  let prefix_of_length s len =
    sub s 0 len

  let has_prefix s ~prefix =
    length s >= length prefix &&
    prefix_of_length s (length prefix) = prefix

  let suffix_from s pos =
    sub s pos (length s - pos)
end

module List = struct
  include List

  let rec find_map p l =
    match l with
    | [] -> raise Not_found
    | hd :: tl ->
        match p hd with
        | None -> find_map p tl
        | Some x -> x

  let rec find_map_opt p l =
    match l with
    | [] -> None
    | hd :: tl ->
        match p hd with
        | None -> find_map_opt p tl
        | result -> result
end