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
open Printf
type t =
| Null of Loc.t
| Bool of Loc.t * bool
| Number of Loc.t * Number.t
| String of Loc.t * string
| Array of Loc.t * t list
| Object of Loc.t * (Loc.t * string * t) list
let get_loc = function
| Null loc
| Bool (loc, _)
| Number (loc, _)
| String (loc, _)
| Array (loc, _)
| Object (loc, _) -> loc
let rec equal a b =
match a, b with
| Null _, Null _ -> true
| Bool (_, x), Bool (_, y) -> x = y
| Number (_, x), Number (_, y) ->
(match x.Number.literal, y.Number.literal with
| Some s1, Some s2 -> s1 = s2
| _ ->
match x.Number.int, y.Number.int with
| Some i1, Some i2 -> i1 = i2
| _ ->
match x.Number.float, y.Number.float with
| Some f1, Some f2 -> f1 = f2
| _ -> false)
| String (_, x), String (_, y) -> x = y
| Array (_, xs), Array (_, ys) -> List.equal equal xs ys
| Object (_, xs), Object (_, ys) ->
List.equal (fun (_, k1, v1) (_, k2, v2) -> k1 = k2 && equal v1 v2) xs ys
| _ -> false
let rec compare a b =
match a, b with
| Null _, Null _ -> 0
| Null _, _ -> -1 | _, Null _ -> 1
| Bool (_, x), Bool (_, y) -> Bool.compare x y
| Bool _, _ -> -1 | _, Bool _ -> 1
| Number (_, x), Number (_, y) ->
(match x.Number.literal, y.Number.literal with
| Some s1, Some s2 -> String.compare s1 s2
| _ ->
match x.Number.float, y.Number.float with
| Some f1, Some f2 -> Float.compare f1 f2
| _ -> 0)
| Number _, _ -> -1 | _, Number _ -> 1
| String (_, x), String (_, y) -> String.compare x y
| String _, _ -> -1 | _, String _ -> 1
| Array (_, xs), Array (_, ys) -> List.compare compare xs ys
| Array _, _ -> -1 | _, Array _ -> 1
| Object (_, xs), Object (_, ys) ->
List.compare
(fun (_, k1, v1) (_, k2, v2) ->
let c = String.compare k1 k2 in
if c <> 0 then c else compare v1 v2)
xs ys
let show (x : t) : string =
let buf = Buffer.create 100 in
let line prefix ?(suffix = "") str =
bprintf buf "%s%s%s\n" prefix str suffix
in
let rec show prefix = function
| Null _ -> line prefix "null"
| Bool (_, b) -> line prefix (string_of_bool b)
| Number (_, n) ->
(match n.Number.literal with
| Some s -> s
| None ->
match n.Number.int with
| Some i -> string_of_int i
| None ->
match n.Number.float with
| Some f -> string_of_float f
| None -> "<number>")
|> line prefix
| String (_, s) -> line prefix (sprintf "%S" s)
| Array (_, []) ->
line prefix "[]"
| Array (_, items) ->
line prefix "[";
List.iter (show (" " ^ prefix)) items;
line prefix "]"
| Object (_, []) ->
line prefix "{}"
| Object (_, fields) ->
line prefix "{";
List.iter (show_field (" " ^ prefix)) fields;
line prefix "}"
and show_field prefix (_, k, v) =
line prefix ~suffix:":" (sprintf "%S" k);
show (" " ^ prefix) v
in
show "" x;
Buffer.contents buf
let loc_msg node =
let loc = get_loc node in
let { Loc.start; end_; file } = loc in
let path_prefix =
match file with
| None -> ""
| Some f -> Printf.sprintf "File %S, " f
in
if start.Pos.row = end_.Pos.row then
Printf.sprintf "%sline %d, characters %d-%d:\n"
path_prefix (start.Pos.row + 1) start.Pos.column end_.Pos.column
else
Printf.sprintf "%slines %d-%d, characters %d-%d:\n"
path_prefix (start.Pos.row + 1) (end_.Pos.row + 1)
start.Pos.column end_.Pos.column