/
protocol.ml
54 lines (46 loc) · 1.72 KB
/
protocol.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
type io = Json.json Stream.t * (Json.json -> unit)
let make ~input ~output =
let input = Json.stream_from_channel input in
let output' = Json.to_channel output in
let output json =
output' json;
print_newline ()
in
input, output
let log ~dest (input,output) =
let log_input json = Printf.fprintf dest "> %s\n%!" (Json.to_string json); json in
let log_output json = Printf.fprintf dest "< %s\n%!" (Json.to_string json); json in
let input' =
Stream.from
begin fun _ ->
try Some (log_input (Stream.next input))
with Stream.Failure -> None
end
in
let output' json = output (log_output json) in
input', output'
let return l = `List [`String "return" ; l]
let error_catcher = ref (fun _ -> None)
let fail = function
| Failure s -> `List [`String "failure"; `String s]
| exn -> match !error_catcher exn with
| Some error -> `List [`String "error"; error]
| None -> `List [`String "exception"; `String (Printexc.to_string exn)]
let make_pos (pos_lnum, pos_cnum) =
Lexing.({ pos_fname = "" ; pos_lnum ; pos_cnum ; pos_bol = 0 })
let pos_to_json pos =
Lexing.(`Assoc ["line", `Int pos.pos_lnum;
"col", `Int (pos.pos_cnum - pos.pos_bol)])
(*"offset", `Int pos.pos_cnum])*)
let pos_of_json = function
| `Assoc props ->
begin try match List.assoc "line" props, List.assoc "col" props with
| `Int line, `Int col -> make_pos (line,col)
| _ -> failwith "Incorrect position"
with Not_found -> failwith "Incorrect position"
end
| _ -> failwith "Incorrect position"
let with_location loc assoc =
`Assoc (("start", pos_to_json loc.Location.loc_start) ::
("end", pos_to_json loc.Location.loc_end) ::
assoc)