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
module Array = ArrayLabels
module List = ListLabels
module String = StringLabels
type t =
| Atom of string
| List of t list
let rec to_string = function
| Atom s -> Escape.quote_if_needed s
| List l ->
Printf.sprintf "(%s)" (List.map ~f:to_string l |> String.concat ~sep:" ")
let rec pp ppf = function
| Atom s -> Format.pp_print_string ppf (Escape.quote_if_needed s)
| List [] -> Format.pp_print_string ppf "()"
| List (first :: rest) ->
Format.pp_open_box ppf 1;
Format.pp_print_string ppf "(";
Format.pp_open_hvbox ppf 0;
pp ppf first;
List.iter rest ~f:(fun sexp ->
Format.pp_print_space ppf ();
pp ppf sexp);
Format.pp_close_box ppf ();
Format.pp_print_string ppf ")";
Format.pp_close_box ppf ()
let hash = Stdlib.Hashtbl.hash
let string_equal (x : string) (y : string) = x = y
let rec equal x y =
match (x, y) with
| Atom x, Atom y -> string_equal x y
| List x, List y -> equal_list x y
| _, _ -> false
and equal_list xs ys =
match (xs, ys) with
| [], [] -> true
| x :: xs, y :: ys -> equal x y && equal_list xs ys
| _, _ -> false
let compare x y = Ordering.of_int (compare x y)
let rec of_dyn : Dyn.t -> t = function
| Opaque -> Atom "<opaque>"
| Unit -> List []
| Int i -> Atom (string_of_int i)
| Bool b -> Atom (string_of_bool b)
| String s -> Atom s
| Bytes s -> Atom (Bytes.to_string s)
| Char c -> Atom (String.make 1 c)
| Float f -> Atom (string_of_float f)
| Option o ->
List
( match o with
| None -> []
| Some x -> [ of_dyn x ] )
| List l -> List (List.map l ~f:of_dyn)
| Array a -> List (Array.to_list a |> List.map ~f:of_dyn)
| Map xs -> List (List.map xs ~f:(fun (k, v) -> List [ of_dyn k; of_dyn v ]))
| Set xs -> List (List.map xs ~f:of_dyn)
| Tuple t -> List (List.map t ~f:of_dyn)
| Record fields ->
List (List.map fields ~f:(fun (field, f) -> List [ Atom field; of_dyn f ]))
| Variant (s, []) -> Atom s
| Variant (s, xs) -> List (Atom s :: List.map xs ~f:of_dyn)