Source file `sexp.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
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
open! Import

module Stable = struct
  module V1 = struct
    module T = struct
      include Base.Sexp

      type t = Base.Sexp.t =
        | Atom of string
        | List of t list
      [@@deriving bin_io ~localize, stable_witness]
    end

    include T

    include%template Comparable.Stable.V1.With_stable_witness.Make [@modality portable] (T)

    let t_sexp_grammar = Sexplib.Sexp.t_sexp_grammar
    let t_of_sexp = Sexplib.Sexp.t_of_sexp
    let%template[@alloc a = (heap, stack)] sexp_of_t = (Sexplib.Sexp.sexp_of_t [@alloc a])
  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 ~localize, 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%template
  Comparable.Extend [@mode local] [@modality portable] (Base.Sexp) (Base.Sexp)

let of_sexp_allow_extra_fields_recursively of_sexp sexp =
  Dynamic.with_temporarily Sexplib.Conv.record_check_extra_fields false ~f:(fun () ->
    of_sexp sexp)
;;

let quickcheck_generator = Base_quickcheck.Generator.sexp
let quickcheck_observer = Base_quickcheck.Observer.sexp
let quickcheck_shrinker = Base_quickcheck.Shrinker.sexp
let compare = Sexplib.Sexp.compare
let equal = Sexplib.Sexp.equal
Source file sexp.ml

Source file `sexp.ml`
