Source file `cst.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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
open! Import

type t =
  | Atom of
      { loc : Positions.range
      ; atom : string
      ; unescaped : string option
      }
  | List of
      { loc : Positions.range
      ; elements : t_or_comment list
      }

and t_or_comment =
  | Sexp of t
  | Comment of comment

and comment =
  | Plain_comment of
      { loc : Positions.range
      ; comment : string
      }
  | Sexp_comment of
      { hash_semi_pos : Positions.pos
      ; comments : comment list
      ; sexp : t
      }
[@@deriving_inline sexp_of]

let rec sexp_of_t =
  (function
    | Atom { loc = v_loc; atom = v_atom; unescaped = v_unescaped } ->
      let bnds = [] in
      let bnds =
        let arg = sexp_of_option sexp_of_string v_unescaped in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "unescaped"; arg ]
        :: bnds
      in
      let bnds =
        let arg = sexp_of_string v_atom in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "atom"; arg ] :: bnds
      in
      let bnds =
        let arg = Positions.sexp_of_range v_loc in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "loc"; arg ] :: bnds
      in
      Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom "Atom" :: bnds)
    | List { loc = v_loc; elements = v_elements } ->
      let bnds = [] in
      let bnds =
        let arg = sexp_of_list sexp_of_t_or_comment v_elements in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "elements"; arg ]
        :: bnds
      in
      let bnds =
        let arg = Positions.sexp_of_range v_loc in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "loc"; arg ] :: bnds
      in
      Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom "List" :: bnds)
      : t -> Ppx_sexp_conv_lib.Sexp.t)

and sexp_of_t_or_comment =
  (function
    | Sexp v0 ->
      let v0 = sexp_of_t v0 in
      Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "Sexp"; v0 ]
    | Comment v0 ->
      let v0 = sexp_of_comment v0 in
      Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "Comment"; v0 ]
      : t_or_comment -> Ppx_sexp_conv_lib.Sexp.t)

and sexp_of_comment =
  (function
    | Plain_comment { loc = v_loc; comment = v_comment } ->
      let bnds = [] in
      let bnds =
        let arg = sexp_of_string v_comment in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "comment"; arg ] :: bnds
      in
      let bnds =
        let arg = Positions.sexp_of_range v_loc in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "loc"; arg ] :: bnds
      in
      Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom "Plain_comment" :: bnds)
    | Sexp_comment
        { hash_semi_pos = v_hash_semi_pos; comments = v_comments; sexp = v_sexp } ->
      let bnds = [] in
      let bnds =
        let arg = sexp_of_t v_sexp in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "sexp"; arg ] :: bnds
      in
      let bnds =
        let arg = sexp_of_list sexp_of_comment v_comments in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "comments"; arg ]
        :: bnds
      in
      let bnds =
        let arg = Positions.sexp_of_pos v_hash_semi_pos in
        Ppx_sexp_conv_lib.Sexp.List [ Ppx_sexp_conv_lib.Sexp.Atom "hash_semi_pos"; arg ]
        :: bnds
      in
      Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom "Sexp_comment" :: bnds)
      : comment -> Ppx_sexp_conv_lib.Sexp.t)
;;

[@@@end]

let compare = Caml.compare
let compare_t_or_comment = Caml.compare
let compare_comment = Caml.compare

module Forget = struct
  (* In cps to prevent non-tail recursion.
     The polymorphism in the signature ensures that each function returns
     only through the continuation. *)
  module Cps : sig
    val forget_t : t -> (Sexp.t -> 'r) -> 'r
    val forget_toc : t_or_comment -> (Sexp.t option -> 'r) -> 'r
    val forget_tocs : t_or_comment list -> (Sexp.t list -> 'r) -> 'r
  end = struct
    let rec forget_t t k =
      match t with
      | Atom { atom; _ } -> k (Sexp.Atom atom)
      | List { elements; _ } -> forget_tocs elements (fun xs -> k (Sexp.List xs))

    and forget_tocs tocs k =
      match tocs with
      | [] -> k []
      | toc :: tocs ->
        forget_toc toc (function
          | None -> forget_tocs tocs k
          | Some x -> forget_tocs tocs (fun xs -> k (x :: xs)))

    and forget_toc toc k =
      match toc with
      | Comment _ -> k None
      | Sexp t -> forget_t t (fun x -> k (Some x))
    ;;
  end

  let t x = Cps.forget_t x (fun y -> y)
  let t_or_comment x = Cps.forget_toc x (fun y -> y)
  let t_or_comments x = Cps.forget_tocs x (fun y -> y)
end