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
open! Import
module Stable = struct
module V1 = struct
include struct
type t = Base.Sexp.t
[@@deriving compare ~localize, equal ~localize, globalize, hash]
end
type t = Base.Sexp.t =
| Atom of string
| List of t list
[@@deriving bin_io, stable_witness]
let t_sexp_grammar = Sexplib.Sexp.t_sexp_grammar
let t_of_sexp = Sexplib.Sexp.t_of_sexp
let sexp_of_t = Sexplib.Sexp.sexp_of_t
end
end
include Stable.V1
include (
Base.Sexp :
module type of struct
include Base.Sexp
end
with type t := t)
include (
Sexplib.Sexp :
module type of struct
include Sexplib.Sexp
end
with type t := t)
module O = struct
type sexp = Base.Sexp.t =
| Atom of string
| List of t list
end
module Sexp_maybe = struct
type nonrec 'a t = ('a, t * Error.t) Result.t [@@deriving bin_io, compare, hash]
let sexp_of_t sexp_of_a t =
match t with
| Result.Ok a -> sexp_of_a a
| Result.Error (sexp, err) ->
List [ Atom "sexp_parse_error"; sexp; Error.sexp_of_t err ]
;;
let t_of_sexp a_of_sexp sexp =
match sexp with
| List [ Atom "sexp_parse_error"; sexp; _ ] | sexp ->
(try Result.Ok (a_of_sexp sexp) with
| exn -> Result.Error (sexp, Error.of_exn exn))
;;
let t_sexp_grammar (grammar : _ Sexplib.Sexp_grammar.t) : _ t Sexplib.Sexp_grammar.t =
{ untyped = Union [ grammar.untyped; Base.Sexp.t_sexp_grammar.untyped ] }
;;
end
module With_text = struct
open Result.Export
type 'a t =
{ value : 'a
; text : string
}
[@@deriving bin_io]
let sexp_of_t _ t = Atom t.text
let of_text value_of_sexp ?(filename = "") text =
match Or_error.try_with (fun () -> of_string_conv text value_of_sexp) with
| Ok (`Result value) -> Ok { value; text }
| Error _ as err -> err
| Ok (`Error (exn, annotated)) ->
Error (Error.of_exn (Annotated.get_conv_exn annotated ~file:filename ~exc:exn))
;;
let t_of_sexp a_of_sexp sexp =
match sexp with
| List _ ->
of_sexp_error
"With_text.t should be stored as an atom, but instead a list was found."
sexp
| Atom text -> of_text a_of_sexp text |> Or_error.ok_exn
;;
let t_sexp_grammar _ = Sexplib.Sexp_grammar.coerce Base.String.t_sexp_grammar
let text t = t.text
let value t = t.value
let of_value sexp_of_value value =
let text = sexp_of_value value |> to_string_hum in
{ value; text }
;;
end
type 'a no_raise = 'a [@@deriving bin_io, sexp]
let sexp_of_no_raise sexp_of_a a =
try sexp_of_a a with
| exn ->
(try List [ Atom "failure building sexp"; sexp_of_exn exn ] with
| _ -> Atom "could not build sexp for exn raised when building sexp for value")
;;
include Comparable.Extend (Base.Sexp) (Base.Sexp)
let of_sexp sexp =
let r = Sexplib.Conv.record_check_extra_fields in
let prev = !r in
Exn.protect
~finally:(fun () -> r := prev)
~f:(fun () ->
r := false;
of_sexp sexp)
;;
let quickcheck_generator = Base_quickcheck.Generator.sexp
let quickcheck_observer = Base_quickcheck.Observer.sexp
let quickcheck_shrinker = Base_quickcheck.Shrinker.sexp