My working unpac space for OCaml projects in development
Merge opam/patches/ppxlib_jane
+4936
+1
vendor/opam/ppxlib_jane/.ocamlformat
+1
vendor/opam/ppxlib_jane/.ocamlformat
···
1
+
profile=janestreet
+67
vendor/opam/ppxlib_jane/CONTRIBUTING.md
+67
vendor/opam/ppxlib_jane/CONTRIBUTING.md
···
1
+
This repository contains open source software that is developed and
2
+
maintained by [Jane Street][js].
3
+
4
+
Contributions to this project are welcome and should be submitted via
5
+
GitHub pull requests.
6
+
7
+
Signing contributions
8
+
---------------------
9
+
10
+
We require that you sign your contributions. Your signature certifies
11
+
that you wrote the patch or otherwise have the right to pass it on as
12
+
an open-source patch. The rules are pretty simple: if you can certify
13
+
the below (from [developercertificate.org][dco]):
14
+
15
+
```
16
+
Developer Certificate of Origin
17
+
Version 1.1
18
+
19
+
Copyright (C) 2004, 2006 The Linux Foundation and its contributors.
20
+
1 Letterman Drive
21
+
Suite D4700
22
+
San Francisco, CA, 94129
23
+
24
+
Everyone is permitted to copy and distribute verbatim copies of this
25
+
license document, but changing it is not allowed.
26
+
27
+
28
+
Developer's Certificate of Origin 1.1
29
+
30
+
By making a contribution to this project, I certify that:
31
+
32
+
(a) The contribution was created in whole or in part by me and I
33
+
have the right to submit it under the open source license
34
+
indicated in the file; or
35
+
36
+
(b) The contribution is based upon previous work that, to the best
37
+
of my knowledge, is covered under an appropriate open source
38
+
license and I have the right under that license to submit that
39
+
work with modifications, whether created in whole or in part
40
+
by me, under the same open source license (unless I am
41
+
permitted to submit under a different license), as indicated
42
+
in the file; or
43
+
44
+
(c) The contribution was provided directly to me by some other
45
+
person who certified (a), (b) or (c) and I have not modified
46
+
it.
47
+
48
+
(d) I understand and agree that this project and the contribution
49
+
are public and that a record of the contribution (including all
50
+
personal information I submit with it, including my sign-off) is
51
+
maintained indefinitely and may be redistributed consistent with
52
+
this project or the open source license(s) involved.
53
+
```
54
+
55
+
Then you just add a line to every git commit message:
56
+
57
+
```
58
+
Signed-off-by: Joe Smith <joe.smith@email.com>
59
+
```
60
+
61
+
Use your real name (sorry, no pseudonyms or anonymous contributions.)
62
+
63
+
If you set your `user.name` and `user.email` git configs, you can sign
64
+
your commit automatically with git commit -s.
65
+
66
+
[dco]: http://developercertificate.org/
67
+
[js]: https://opensource.janestreet.com/
+21
vendor/opam/ppxlib_jane/LICENSE.md
+21
vendor/opam/ppxlib_jane/LICENSE.md
···
1
+
The MIT License
2
+
3
+
Copyright (c) 2023--2025 Jane Street Group, LLC <opensource-contacts@janestreet.com>
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+17
vendor/opam/ppxlib_jane/Makefile
+17
vendor/opam/ppxlib_jane/Makefile
···
1
+
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
2
+
3
+
default:
4
+
dune build
5
+
6
+
install:
7
+
dune install $(INSTALL_ARGS)
8
+
9
+
uninstall:
10
+
dune uninstall $(INSTALL_ARGS)
11
+
12
+
reinstall: uninstall install
13
+
14
+
clean:
15
+
dune clean
16
+
17
+
.PHONY: default install uninstall reinstall clean
+38
vendor/opam/ppxlib_jane/README.md
+38
vendor/opam/ppxlib_jane/README.md
···
1
+
'`ppxlib_jane`'
2
+
===============
3
+
4
+
A library for use in ppxes for constructing and matching on ASTs corresponding to the
5
+
augmented parsetree that is recognized by the [Jane Street OCaml compiler][JaneStreetOCaml].
6
+
7
+
ASTs constructed using this library are compatible with the standard OCaml compiler. Any
8
+
syntax change known to this library is encoded as attributes, and the standard OCaml
9
+
compiler's interpretation of the ASTs constructed by these library (which amounts to
10
+
ignoring the attributes) is reasonable. That is, we only expose "unsurprising" things in
11
+
this library. For example, if you construct an *n*-ary function using this library, the
12
+
standard OCaml compiler will interpret it as *n* nested unary functions in the normal way.
13
+
14
+
Likewise, ppxes that use this library to match on Jane Street ASTs can also be used with
15
+
the standard OCaml compiler. (The Jane Street AST cases of the match will just never be
16
+
triggered when using the standard OCaml compiler.)
17
+
18
+
This is how we intend this library to fit into the broader ppx ecosystem:
19
+
20
+
```
21
+
+-------------+ +--------------+ +------------------+
22
+
| | | | | |
23
+
| ppxes +------>| ppxlib +----->+ compiler libs, |
24
+
| | | | | ppxlib_ast, etc. |
25
+
+------+------+ +--------------+ | |
26
+
| +---------+--------+
27
+
| +---------------+ ^
28
+
| | | |
29
+
+------------->+ ppxlib_jane +---------------+
30
+
| |
31
+
+---------------+
32
+
```
33
+
34
+
That is, there is no dependency between `ppxlib` and `ppxlib_jane`, and ppx authors
35
+
are free to use `ppxlib_jane` if they want to construct AST nodes recognized by the
36
+
Jane Street OCaml compiler.
37
+
38
+
[JaneStreetOCaml]: https://github.com/ocaml-flambda/flambda-backend
vendor/opam/ppxlib_jane/dune
vendor/opam/ppxlib_jane/dune
This is a binary file and will not be displayed.
+1
vendor/opam/ppxlib_jane/dune-project
+1
vendor/opam/ppxlib_jane/dune-project
···
1
+
(lang dune 3.17)
+21
vendor/opam/ppxlib_jane/ppxlib_jane.opam
+21
vendor/opam/ppxlib_jane/ppxlib_jane.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "Jane Street developers"
3
+
authors: ["Jane Street Group, LLC"]
4
+
homepage: "https://github.com/janestreet/ppxlib_jane"
5
+
bug-reports: "https://github.com/janestreet/ppxlib_jane/issues"
6
+
dev-repo: "git+https://github.com/janestreet/ppxlib_jane.git"
7
+
doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppxlib_jane/index.html"
8
+
license: "MIT"
9
+
build: [
10
+
["dune" "build" "-p" name "-j" jobs]
11
+
]
12
+
depends: [
13
+
"ocaml" {>= "5.1.0"}
14
+
"dune" {>= "3.17.0"}
15
+
"ppxlib" {>= "0.33.0" & < "0.36.0"}
16
+
]
17
+
available: arch != "arm32" & arch != "x86_32"
18
+
synopsis: "Utilities for working with Jane Street AST constructs"
19
+
description: "
20
+
Part of the Jane Street's PPX rewriters collection.
21
+
"
+585
vendor/opam/ppxlib_jane/src/ast_builder.ml
+585
vendor/opam/ppxlib_jane/src/ast_builder.ml
···
1
+
open Astlib
2
+
open Ppxlib_ast.Asttypes
3
+
open Ppxlib_ast.Parsetree
4
+
open Stdppx
5
+
include Ast_builder_intf
6
+
include Shim
7
+
8
+
module Default = struct
9
+
include Shim
10
+
11
+
type function_param = Shim.Pexp_function.function_param
12
+
type function_constraint = Shim.Pexp_function.Function_constraint.t
13
+
type function_body = Shim.Pexp_function.function_body
14
+
15
+
let mktyp ~loc ?(attrs = []) ptyp_desc =
16
+
{ ptyp_loc_stack = []; ptyp_attributes = attrs; ptyp_loc = loc; ptyp_desc }
17
+
;;
18
+
19
+
let mkexp ~loc ?(attrs = []) pexp_desc =
20
+
{ pexp_loc_stack = []; pexp_attributes = attrs; pexp_loc = loc; pexp_desc }
21
+
;;
22
+
23
+
let mkpat ~loc ?(attrs = []) ppat_desc =
24
+
{ ppat_loc_stack = []; ppat_attributes = attrs; ppat_loc = loc; ppat_desc }
25
+
;;
26
+
27
+
let ptyp_arrow ~loc { arg_label; arg_modes; arg_type } { result_modes; result_type } =
28
+
let ptyp_desc =
29
+
Ptyp_arrow (arg_label, arg_type, result_type, arg_modes, result_modes)
30
+
|> Shim.Core_type_desc.to_parsetree
31
+
in
32
+
mktyp ~loc ptyp_desc
33
+
;;
34
+
35
+
let tarrow ~loc args result =
36
+
match args with
37
+
| [] ->
38
+
raise
39
+
(Invalid_argument
40
+
"tarrow: Can't construct a 0-ary arrow, argument list must be nonempty")
41
+
| _ :: _ ->
42
+
let { result_type; _ } =
43
+
List.fold_right args ~init:result ~f:(fun arg result ->
44
+
{ result_type = ptyp_arrow ~loc arg result; result_modes = [] })
45
+
in
46
+
result_type
47
+
;;
48
+
49
+
let tarrow_maybe ~loc args result_type =
50
+
match args with
51
+
| [] -> result_type
52
+
| _ :: _ -> tarrow ~loc args { result_modes = []; result_type }
53
+
;;
54
+
55
+
let pexp_let ~loc a b c d =
56
+
let pexp_desc = Pexp_let (a, b, c, d) |> Shim.Expression_desc.to_parsetree ~loc in
57
+
mkexp ~loc pexp_desc
58
+
;;
59
+
60
+
let pexp_constraint ~loc a b c =
61
+
let pexp_desc = Pexp_constraint (a, b, c) |> Shim.Expression_desc.to_parsetree ~loc in
62
+
mkexp ~loc pexp_desc
63
+
;;
64
+
65
+
let ppat_constraint ~loc a b c =
66
+
let ppat_desc = Ppat_constraint (a, b, c) |> Shim.Pattern_desc.to_parsetree ~loc in
67
+
mkpat ~loc ppat_desc
68
+
;;
69
+
70
+
let type_declaration
71
+
~loc
72
+
?attrs
73
+
?jkind_annotation
74
+
~name
75
+
~params
76
+
~cstrs
77
+
~kind
78
+
~private_
79
+
~manifest
80
+
()
81
+
: type_declaration
82
+
=
83
+
{ ptype_loc = loc
84
+
; ptype_name = name
85
+
; ptype_params = params
86
+
; ptype_cstrs = cstrs
87
+
; ptype_kind = kind
88
+
; ptype_private = private_
89
+
; ptype_manifest = manifest
90
+
; ptype_jkind_annotation = jkind_annotation
91
+
; ptype_attributes = Option.value attrs ~default:[]
92
+
}
93
+
|> Shim.Type_declaration.to_parsetree
94
+
;;
95
+
96
+
let value_binding = Shim.Value_binding.create
97
+
98
+
let pcstr_tuple ~loc modalities_tys =
99
+
Pcstr_tuple
100
+
(List.map modalities_tys ~f:(fun (modalities, type_) ->
101
+
Shim.Pcstr_tuple_arg.create ~loc ~modalities ~type_))
102
+
;;
103
+
104
+
let psig_include ~loc ~modalities a =
105
+
let psig_desc =
106
+
Psig_include (a, modalities) |> Shim.Signature_item_desc.to_parsetree
107
+
in
108
+
{ psig_loc = loc; psig_desc }
109
+
;;
110
+
111
+
let signature ~loc ?(modalities = []) psg_items =
112
+
Shim.Signature.to_parsetree { psg_items; psg_modalities = modalities; psg_loc = loc }
113
+
;;
114
+
115
+
let module_declaration ~loc ?(attrs = []) ?(modalities = []) name type_ =
116
+
Shim.Module_declaration.to_parsetree
117
+
{ pmd_name = name
118
+
; pmd_type = type_
119
+
; pmd_modalities = modalities
120
+
; pmd_attributes = attrs
121
+
; pmd_loc = loc
122
+
}
123
+
;;
124
+
125
+
let pmty_functor ~loc ?(attrs = []) ?(modes = []) param mty =
126
+
let pmty_desc =
127
+
Pmty_functor (param, mty, modes) |> Shim.Module_type_desc.to_parsetree ~loc
128
+
in
129
+
{ pmty_desc; pmty_attributes = attrs; pmty_loc = loc }
130
+
;;
131
+
132
+
let pmod_constraint ~loc ?(attrs = []) expr mty modes =
133
+
let pmod_desc =
134
+
Pmod_constraint (expr, mty, modes) |> Shim.Module_expr_desc.to_parsetree ~loc
135
+
in
136
+
{ pmod_desc; pmod_attributes = attrs; pmod_loc = loc }
137
+
;;
138
+
139
+
let pmty_signature ~loc signature =
140
+
{ pmty_desc = Pmty_signature signature; pmty_loc = loc; pmty_attributes = [] }
141
+
;;
142
+
143
+
let get_tuple_field_modalities = Shim.Pcstr_tuple_arg.extract_modalities
144
+
let get_label_declaration_modalities = Shim.Label_declaration.extract_modalities
145
+
let label_declaration = Shim.Label_declaration.create
146
+
let get_value_description_modalities = Shim.Value_description.extract_modalities
147
+
let value_description = Shim.Value_description.create
148
+
let pcstr_tuple_arg = Shim.Pcstr_tuple_arg.create
149
+
150
+
let include_infos ~loc ?(attrs = []) ~kind x =
151
+
Include_infos.to_parsetree
152
+
{ pincl_kind = kind; pincl_mod = x; pincl_loc = loc; pincl_attributes = attrs }
153
+
;;
154
+
155
+
let pexp_function ~loc ~attrs ~params ~constraint_ ~body =
156
+
{ pexp_desc = Shim.Pexp_function.to_parsetree ~params ~constraint_ ~body
157
+
; pexp_loc = loc
158
+
; pexp_attributes = attrs
159
+
; pexp_loc_stack = []
160
+
}
161
+
;;
162
+
163
+
let unary_function ~loc ?(attrs = []) cases =
164
+
pexp_function
165
+
~attrs
166
+
~params:[]
167
+
~constraint_:Shim.Pexp_function.Function_constraint.none
168
+
~body:(Pfunction_cases (cases, loc, []))
169
+
~loc
170
+
;;
171
+
172
+
let fun_param ~loc arg_label pattern : function_param =
173
+
{ pparam_desc = Pparam_val (arg_label, None, pattern); pparam_loc = loc }
174
+
;;
175
+
176
+
let function_constraint type_constraint : function_constraint =
177
+
{ Shim.Pexp_function.Function_constraint.none with
178
+
ret_type_constraint =
179
+
Option.map ~f:(fun x -> Pexp_function.Pconstraint x) type_constraint
180
+
}
181
+
;;
182
+
183
+
let maybe_constrain body return_constraint ~loc =
184
+
match return_constraint with
185
+
| None -> body
186
+
| Some return_constraint ->
187
+
Ppxlib_ast.Ast_helper.Exp.constraint_ ~loc body return_constraint
188
+
;;
189
+
190
+
let add_fun_params ~loc ?(attrs = []) ?return_constraint new_params body =
191
+
match new_params with
192
+
| [] -> maybe_constrain body return_constraint ~loc
193
+
| _ :: _ ->
194
+
(* If the body is already a function, extend its arity rather than creating a new
195
+
function.
196
+
*)
197
+
(match Shim.Pexp_function.of_parsetree body.pexp_desc ~loc:body.pexp_loc with
198
+
| Some (params, constraint_, function_body) ->
199
+
let existing_attrs =
200
+
List.filter body.pexp_attributes ~f:(fun attr ->
201
+
(* We drop "merlin.loc" attributes inserted by merlin's parser.
202
+
203
+
These attributes are always fine to drop -- they're a best-effort attempt
204
+
to encode extra location information -- and usually not fine to move.
205
+
That's because merlin expects certain invariants to hold between
206
+
the location encoded by the "merlin.loc" and locations of sub-ASTs.
207
+
*)
208
+
String.( <> ) attr.attr_name.txt "merlin.loc")
209
+
in
210
+
let fun_ =
211
+
pexp_function
212
+
~params:(new_params @ params)
213
+
~constraint_
214
+
~body:function_body
215
+
~loc
216
+
~attrs:(existing_attrs @ attrs)
217
+
in
218
+
maybe_constrain fun_ return_constraint ~loc
219
+
| None ->
220
+
pexp_function
221
+
~params:new_params
222
+
~constraint_:(function_constraint return_constraint)
223
+
~body:(Pfunction_body body)
224
+
~loc
225
+
~attrs)
226
+
;;
227
+
228
+
let add_fun_param ~loc ?attrs ?return_constraint lbl def pat body =
229
+
add_fun_params
230
+
?attrs
231
+
?return_constraint
232
+
~loc
233
+
[ { pparam_desc = Pparam_val (lbl, def, pat); pparam_loc = pat.ppat_loc } ]
234
+
body
235
+
;;
236
+
237
+
let coalesce_fun_arity ast =
238
+
match Shim.Pexp_function.of_parsetree ast.pexp_desc ~loc:ast.pexp_loc with
239
+
| None | Some (_, _, Pfunction_cases _) -> ast
240
+
| Some (params, constraint_, body)
241
+
when not (Shim.Pexp_function.Function_constraint.is_none constraint_) ->
242
+
pexp_function
243
+
~params
244
+
~constraint_
245
+
~body
246
+
~loc:ast.pexp_loc
247
+
~attrs:ast.pexp_attributes
248
+
| Some (params1, _, Pfunction_body ({ pexp_attributes = []; _ } as outer_body)) ->
249
+
(match
250
+
Shim.Pexp_function.of_parsetree outer_body.pexp_desc ~loc:outer_body.pexp_loc
251
+
with
252
+
| Some (params2, constraint_, inner_body) ->
253
+
pexp_function
254
+
~params:(params1 @ params2)
255
+
~constraint_
256
+
~body:inner_body
257
+
~loc:ast.pexp_loc
258
+
~attrs:ast.pexp_attributes
259
+
| None -> ast)
260
+
| Some _ -> ast
261
+
;;
262
+
263
+
let eabstract ~loc ?(coalesce_fun_arity = true) ?return_constraint pats body =
264
+
let params = List.map pats ~f:(fun pat -> fun_param ~loc:pat.ppat_loc Nolabel pat) in
265
+
if coalesce_fun_arity
266
+
then add_fun_params ~loc ?return_constraint params body
267
+
else
268
+
pexp_function
269
+
~loc
270
+
~params
271
+
~constraint_:(return_constraint |> function_constraint)
272
+
~body:(Pfunction_body body)
273
+
~attrs:[]
274
+
;;
275
+
276
+
module Latest = struct
277
+
let ptyp_any ~loc a =
278
+
let ptyp_desc = Shim.Core_type_desc.to_parsetree (Ptyp_any a) in
279
+
{ ptyp_loc_stack = []; ptyp_attributes = []; ptyp_loc = loc; ptyp_desc }
280
+
;;
281
+
282
+
let ptyp_var ~loc a b =
283
+
let ptyp_desc = Shim.Core_type_desc.to_parsetree (Ptyp_var (a, b)) in
284
+
{ ptyp_loc_stack = []; ptyp_attributes = []; ptyp_loc = loc; ptyp_desc }
285
+
;;
286
+
287
+
let pexp_function ~loc ?(attrs = []) params constraint_ body =
288
+
pexp_function ~loc ~attrs ~params ~constraint_ ~body
289
+
;;
290
+
end
291
+
292
+
let ptyp_unboxed_tuple ~loc a =
293
+
let ptyp_desc = Shim.Core_type_desc.to_parsetree (Ptyp_unboxed_tuple a) in
294
+
{ ptyp_loc_stack = []; ptyp_attributes = []; ptyp_loc = loc; ptyp_desc }
295
+
;;
296
+
297
+
let pexp_unboxed_tuple ~loc ?attrs a =
298
+
let pexp_desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_unboxed_tuple a) in
299
+
mkexp ?attrs ~loc pexp_desc
300
+
;;
301
+
302
+
let ppat_unboxed_tuple ~loc ?attrs a closed =
303
+
let ppat_desc =
304
+
Shim.Pattern_desc.to_parsetree ~loc (Ppat_unboxed_tuple (a, closed))
305
+
in
306
+
mkpat ?attrs ~loc ppat_desc
307
+
;;
308
+
309
+
let exp_constant ~loc c =
310
+
let c = Shim.Constant.to_parsetree c in
311
+
let pexp_desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_constant c) in
312
+
mkexp ~loc pexp_desc
313
+
;;
314
+
315
+
let pat_constant ~loc c =
316
+
let c = Shim.Constant.to_parsetree c in
317
+
let ppat_desc = Shim.Pattern_desc.to_parsetree ~loc (Ppat_constant c) in
318
+
mkpat ~loc ppat_desc
319
+
;;
320
+
321
+
let exp_unboxed_int_constant ~loc str suffix =
322
+
exp_constant ~loc (Pconst_unboxed_integer (str, suffix))
323
+
;;
324
+
325
+
let pat_unboxed_int_constant ~loc str suffix =
326
+
pat_constant ~loc (Pconst_unboxed_integer (str, suffix))
327
+
;;
328
+
329
+
let eint64_u ~loc i = exp_unboxed_int_constant ~loc (Int64.to_string i) 'L'
330
+
let eint32_u ~loc i = exp_unboxed_int_constant ~loc (Int32.to_string i) 'l'
331
+
let enativeint_u ~loc i = exp_unboxed_int_constant ~loc (Nativeint.to_string i) 'n'
332
+
let efloat_u ~loc f = exp_constant ~loc (Pconst_unboxed_float (f, None))
333
+
let pint64_u ~loc i = pat_unboxed_int_constant ~loc (Int64.to_string i) 'L'
334
+
let pint32_u ~loc i = pat_unboxed_int_constant ~loc (Int32.to_string i) 'l'
335
+
let pnativeint_u ~loc i = pat_unboxed_int_constant ~loc (Nativeint.to_string i) 'n'
336
+
let pfloat_u ~loc f = pat_constant ~loc (Pconst_unboxed_float (f, None))
337
+
338
+
let ptyp_tuple ~loc ?attrs a =
339
+
match a with
340
+
| [] -> raise (Invalid_argument "ptyp_tuple: cannot construct a 0-ary tuple")
341
+
| _ :: _ :: _ ->
342
+
let ptyp_desc = Shim.Core_type_desc.to_parsetree (Ptyp_tuple a) in
343
+
mktyp ?attrs ~loc ptyp_desc
344
+
| [ (name, x) ] ->
345
+
(match name with
346
+
| Some _ ->
347
+
raise (Invalid_argument "ptyp_tuple: cannot construct a 1-ary named tuple")
348
+
| None ->
349
+
(match attrs with
350
+
| None -> x
351
+
| Some attrs ->
352
+
{ x with ptyp_loc = loc; ptyp_attributes = x.ptyp_attributes @ attrs }))
353
+
;;
354
+
355
+
let pexp_tuple ~loc ?attrs a =
356
+
match a with
357
+
| [] -> raise (Invalid_argument "pexp_tuple: cannot construct a 0-ary tuple")
358
+
| _ :: _ :: _ ->
359
+
let pexp_desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_tuple a) in
360
+
mkexp ?attrs ~loc pexp_desc
361
+
| [ (name, x) ] ->
362
+
(match name with
363
+
| Some _ ->
364
+
raise (Invalid_argument "pexp_tuple: cannot construct a 1-ary named tuple")
365
+
| None ->
366
+
(match attrs with
367
+
| None -> x
368
+
| Some attrs ->
369
+
{ x with pexp_loc = loc; pexp_attributes = x.pexp_attributes @ attrs }))
370
+
;;
371
+
372
+
let ppat_tuple ~loc ?attrs a closed =
373
+
match a, closed with
374
+
| [], _ -> raise (Invalid_argument "ppat_tuple: cannot construct a 0-ary tuple")
375
+
| _ :: _ :: _, _ | [ _ ], Open ->
376
+
let ppat_desc = Shim.Pattern_desc.to_parsetree ~loc (Ppat_tuple (a, closed)) in
377
+
mkpat ?attrs ~loc ppat_desc
378
+
| [ (name, x) ], Closed ->
379
+
(match name with
380
+
| Some _ ->
381
+
raise (Invalid_argument "ppat_tuple: cannot construct a 1-ary named tuple")
382
+
| None ->
383
+
(match attrs with
384
+
| None -> x
385
+
| Some attrs ->
386
+
{ x with ppat_loc = loc; ppat_attributes = x.ppat_attributes @ attrs }))
387
+
;;
388
+
389
+
let pexp_record_unboxed_product ~loc ?attrs a b =
390
+
let pexp_desc =
391
+
Shim.Expression_desc.to_parsetree ~loc (Pexp_record_unboxed_product (a, b))
392
+
in
393
+
mkexp ?attrs ~loc pexp_desc
394
+
;;
395
+
396
+
let ppat_record_unboxed_product ~loc ?attrs a b =
397
+
let ppat_desc =
398
+
Shim.Pattern_desc.to_parsetree ~loc (Ppat_record_unboxed_product (a, b))
399
+
in
400
+
mkpat ?attrs ~loc ppat_desc
401
+
;;
402
+
403
+
let pexp_unboxed_field ~loc ?attrs a b =
404
+
let pexp_desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_unboxed_field (a, b)) in
405
+
mkexp ?attrs ~loc pexp_desc
406
+
;;
407
+
408
+
let pexp_idx ~loc ?attrs a b =
409
+
let pexp_desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_idx (a, b)) in
410
+
mkexp ?attrs ~loc pexp_desc
411
+
;;
412
+
413
+
let ptyp_alias ~loc ?(attrs = []) a b c =
414
+
let ptyp_desc = Shim.Core_type_desc.to_parsetree (Ptyp_alias (a, b, c)) in
415
+
{ ptyp_loc_stack = []; ptyp_attributes = attrs; ptyp_loc = loc; ptyp_desc }
416
+
;;
417
+
418
+
let ptyp_poly ~loc ?(attrs = []) vars body =
419
+
match vars, attrs with
420
+
| [], [] -> body
421
+
| [], _ ->
422
+
{ body with
423
+
ptyp_loc = loc
424
+
; ptyp_loc_stack = body.ptyp_loc :: body.ptyp_loc_stack
425
+
; ptyp_attributes = body.ptyp_attributes @ attrs
426
+
}
427
+
| _ ->
428
+
let desc = Shim.Core_type_desc.to_parsetree (Ptyp_poly (vars, body)) in
429
+
mktyp ~attrs ~loc desc
430
+
;;
431
+
432
+
let ptyp_quote ~loc ?attrs core_type =
433
+
let desc = Shim.Core_type_desc.to_parsetree (Ptyp_quote core_type) in
434
+
mktyp ?attrs ~loc desc
435
+
;;
436
+
437
+
let ptyp_splice ~loc ?attrs core_type =
438
+
let desc = Shim.Core_type_desc.to_parsetree (Ptyp_splice core_type) in
439
+
mktyp ?attrs ~loc desc
440
+
;;
441
+
442
+
let pexp_newtype ~loc ?attrs a b c =
443
+
let desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_newtype (a, b, c)) in
444
+
mkexp ?attrs ~loc desc
445
+
;;
446
+
447
+
let ppat_array ~loc ?attrs a b =
448
+
let desc = Shim.Pattern_desc.to_parsetree ~loc (Ppat_array (a, b)) in
449
+
mkpat ?attrs ~loc desc
450
+
;;
451
+
452
+
let pexp_array ~loc ?attrs a b =
453
+
let desc = Shim.Expression_desc.to_parsetree ~loc (Pexp_array (a, b)) in
454
+
mkexp ?attrs ~loc desc
455
+
;;
456
+
end
457
+
458
+
module Make (Loc : sig
459
+
val loc : Location.t
460
+
end) =
461
+
struct
462
+
include Default
463
+
464
+
let loc = Loc.loc
465
+
let ptyp_arrow arg res : core_type = ptyp_arrow ~loc arg res
466
+
let tarrow args res : core_type = tarrow ~loc args res
467
+
let tarrow_maybe args res : core_type = tarrow_maybe ~loc args res
468
+
let pexp_let a b c d : expression = pexp_let ~loc a b c d
469
+
let pexp_constraint a b c : expression = pexp_constraint ~loc a b c
470
+
let ppat_constraint a b c : pattern = ppat_constraint ~loc a b c
471
+
472
+
let type_declaration
473
+
?attrs
474
+
?jkind_annotation
475
+
~name
476
+
~params
477
+
~cstrs
478
+
~kind
479
+
~private_
480
+
~manifest
481
+
()
482
+
=
483
+
type_declaration
484
+
~loc
485
+
?attrs
486
+
?jkind_annotation
487
+
~name
488
+
~params
489
+
~cstrs
490
+
~kind
491
+
~private_
492
+
~manifest
493
+
()
494
+
;;
495
+
496
+
let value_binding ~pat ~expr ~modes : value_binding =
497
+
value_binding ~loc ~pat ~expr ~modes
498
+
;;
499
+
500
+
let pcstr_tuple fields : constructor_arguments = pcstr_tuple ~loc fields
501
+
502
+
let label_declaration ~name ~mutable_ ~modalities ~type_ : label_declaration =
503
+
label_declaration ~loc ~name ~mutable_ ~modalities ~type_
504
+
;;
505
+
506
+
let value_description ~name ~type_ ~modalities ~prim : value_description =
507
+
value_description ~loc ~name ~type_ ~modalities ~prim
508
+
;;
509
+
510
+
let pcstr_tuple_arg ~modalities ~type_ : Pcstr_tuple_arg.t =
511
+
pcstr_tuple_arg ~loc ~modalities ~type_
512
+
;;
513
+
514
+
let include_infos ?attrs ~kind x = include_infos ~loc ?attrs ~kind x
515
+
let psig_include ~modalities a : signature_item = psig_include ~loc ~modalities a
516
+
let signature ?modalities a : signature = signature ~loc ?modalities a
517
+
518
+
let module_declaration ?attrs ?modalities name type_ =
519
+
module_declaration ~loc ?attrs ?modalities name type_
520
+
;;
521
+
522
+
let pmty_functor ?attrs ?modes param mty = pmty_functor ~loc ?attrs ?modes param mty
523
+
let pmod_constraint ?attrs expr mty modes = pmod_constraint ~loc ?attrs expr mty modes
524
+
525
+
module Latest = struct
526
+
let ptyp_any a : core_type = Latest.ptyp_any ~loc a
527
+
let ptyp_var a b : core_type = Latest.ptyp_var ~loc a b
528
+
let pexp_function ?attrs a b c : expression = Latest.pexp_function ~loc ?attrs a b c
529
+
end
530
+
531
+
let eabstract ?coalesce_fun_arity ?return_constraint a b : expression =
532
+
eabstract ~loc ?coalesce_fun_arity ?return_constraint a b
533
+
;;
534
+
535
+
let fun_param a b : function_param = fun_param ~loc a b
536
+
let unary_function ?attrs a : expression = unary_function ~loc ?attrs a
537
+
538
+
let add_fun_param ?attrs ?return_constraint a b c d : expression =
539
+
add_fun_param ~loc ?attrs ?return_constraint a b c d
540
+
;;
541
+
542
+
let add_fun_params ?attrs ?return_constraint a b : expression =
543
+
add_fun_params ~loc ?attrs ?return_constraint a b
544
+
;;
545
+
546
+
let ptyp_unboxed_tuple a : core_type = ptyp_unboxed_tuple ~loc a
547
+
let pexp_unboxed_tuple ?attrs a : expression = pexp_unboxed_tuple ~loc ?attrs a
548
+
549
+
let pexp_record_unboxed_product ?attrs a b : expression =
550
+
pexp_record_unboxed_product ~loc ?attrs a b
551
+
;;
552
+
553
+
let ppat_record_unboxed_product ?attrs a b : pattern =
554
+
ppat_record_unboxed_product ~loc ?attrs a b
555
+
;;
556
+
557
+
let pexp_unboxed_field ?attrs a b : expression = pexp_unboxed_field ~loc ?attrs a b
558
+
let pexp_idx ?attrs a b : expression = pexp_idx ~loc ?attrs a b
559
+
let ppat_unboxed_tuple ?attrs a b : pattern = ppat_unboxed_tuple ~loc ?attrs a b
560
+
let eint64_u c : expression = eint64_u ~loc c
561
+
let eint32_u c : expression = eint32_u ~loc c
562
+
let enativeint_u c : expression = enativeint_u ~loc c
563
+
let efloat_u c : expression = efloat_u ~loc c
564
+
let pint64_u c : pattern = pint64_u ~loc c
565
+
let pint32_u c : pattern = pint32_u ~loc c
566
+
let pnativeint_u c : pattern = pnativeint_u ~loc c
567
+
let pfloat_u c : pattern = pfloat_u ~loc c
568
+
let ptyp_tuple ?attrs a : core_type = ptyp_tuple ~loc ?attrs a
569
+
let ptyp_quote ?attrs a : core_type = ptyp_quote ~loc ?attrs a
570
+
let ptyp_splice ?attrs a : core_type = ptyp_splice ~loc ?attrs a
571
+
let pexp_tuple ?attrs a : expression = pexp_tuple ~loc ?attrs a
572
+
let ppat_tuple ?attrs a b : pattern = ppat_tuple ~loc ?attrs a b
573
+
let pmty_signature a : module_type = pmty_signature ~loc a
574
+
let ptyp_poly ?attrs a b : core_type = ptyp_poly ~loc ?attrs a b
575
+
let ptyp_alias ?attrs a b c : core_type = ptyp_alias ~loc ?attrs a b c
576
+
let pexp_newtype ?attrs a b c : expression = pexp_newtype ~loc ?attrs a b c
577
+
let pexp_array ?attrs a b : expression = pexp_array ~loc ?attrs a b
578
+
let ppat_array ?attrs a b : pattern = ppat_array ~loc ?attrs a b
579
+
end
580
+
581
+
let make loc : (module S_with_implicit_loc) =
582
+
(module Make (struct
583
+
let loc = loc
584
+
end))
585
+
;;
+1
vendor/opam/ppxlib_jane/src/ast_builder.mli
+1
vendor/opam/ppxlib_jane/src/ast_builder.mli
···
1
+
include Ast_builder_intf.Ast_builder (** @inline *)
+392
vendor/opam/ppxlib_jane/src/ast_builder_intf.ml
+392
vendor/opam/ppxlib_jane/src/ast_builder_intf.ml
···
1
+
open Astlib
2
+
open Ppxlib_ast.Asttypes
3
+
open Ppxlib_ast.Parsetree
4
+
5
+
module type S = sig
6
+
type 'a with_loc
7
+
type arrow_argument := Shim.arrow_argument
8
+
type arrow_result := Shim.arrow_result
9
+
type block_access := Shim.block_access
10
+
type modalities := Shim.Modalities.t
11
+
type modes := Shim.Modes.t
12
+
type include_kind := Shim.Include_kind.t
13
+
type index_kind = Shim.index_kind
14
+
type jkind_annotation := Shim.jkind_annotation
15
+
type unboxed_access := Shim.unboxed_access
16
+
17
+
module Pcstr_tuple_arg := Shim.Pcstr_tuple_arg
18
+
19
+
(** {2 Modes} *)
20
+
21
+
(** Construct a [Ptyp_arrow] *)
22
+
val ptyp_arrow : (arrow_argument -> arrow_result -> core_type) with_loc
23
+
24
+
(** Construct a multi-argument arrow type with the provided arguments and result.
25
+
26
+
@raise [Invalid_argument] if the input list is empty. *)
27
+
val tarrow : (arrow_argument list -> arrow_result -> core_type) with_loc
28
+
29
+
(** As [tarrow], but will return the result if the input list is empty rather than
30
+
erroring; this means the result type cannot have a mode annotation. *)
31
+
val tarrow_maybe : (arrow_argument list -> core_type -> core_type) with_loc
32
+
33
+
(** [Pexp_let] with [let mutable] support *)
34
+
val pexp_let
35
+
: (mutable_flag -> rec_flag -> value_binding list -> expression -> expression)
36
+
with_loc
37
+
38
+
(** Construct a [Pexp_constraint] with modes *)
39
+
val pexp_constraint : (expression -> core_type option -> modes -> expression) with_loc
40
+
41
+
(** Construct a [Ppat_constraint] with modes *)
42
+
val ppat_constraint : (pattern -> core_type option -> modes -> pattern) with_loc
43
+
44
+
(** Contruct a [value_binding] with modes *)
45
+
val value_binding
46
+
: (pat:pattern -> expr:expression -> modes:modes -> value_binding) with_loc
47
+
48
+
(** Construct a [Pcstr_tuple], a representation for the contents of a tupled variant
49
+
constructor, that attaches the provided modalities to each field. *)
50
+
val pcstr_tuple : ((modalities * core_type) list -> constructor_arguments) with_loc
51
+
52
+
(** Construct a [Psig_include] with modalities *)
53
+
val psig_include
54
+
: (modalities:modalities -> include_description -> signature_item) with_loc
55
+
56
+
(** Construct a [signature] *)
57
+
val signature : (?modalities:modalities -> signature_item list -> signature) with_loc
58
+
59
+
val pmty_signature : (signature -> module_type) with_loc
60
+
61
+
(** Splits a possibly-modality-annotated field of a tupled variant constructor into a
62
+
pair of its modality and the unannotated field. If the resulting mode is [None],
63
+
then the field is returned unchanged. *)
64
+
val get_tuple_field_modalities : Pcstr_tuple_arg.t -> modalities * core_type
65
+
66
+
(** Splits a possibly-modality-annotated label declaration into a pair of its modality
67
+
and the unannotated label declaration. If the resulting modality is [None], then the
68
+
label declaration is returned unchanged. *)
69
+
val get_label_declaration_modalities
70
+
: label_declaration
71
+
-> modalities * label_declaration
72
+
73
+
val label_declaration
74
+
: (name:string Location.loc
75
+
-> mutable_:mutable_flag
76
+
-> modalities:modalities
77
+
-> type_:core_type
78
+
-> label_declaration)
79
+
with_loc
80
+
81
+
val get_value_description_modalities
82
+
: value_description
83
+
-> modalities * value_description
84
+
85
+
val value_description
86
+
: (name:string Location.loc
87
+
-> type_:core_type
88
+
-> modalities:modalities
89
+
-> prim:string list
90
+
-> value_description)
91
+
with_loc
92
+
93
+
val pcstr_tuple_arg
94
+
: (modalities:modalities -> type_:core_type -> Pcstr_tuple_arg.t) with_loc
95
+
96
+
val include_infos
97
+
: (?attrs:attributes -> kind:include_kind -> 'a -> 'a include_infos) with_loc
98
+
99
+
val module_declaration
100
+
: (?attrs:attributes
101
+
-> ?modalities:modalities
102
+
-> string option Location.loc
103
+
-> module_type
104
+
-> module_declaration)
105
+
with_loc
106
+
107
+
val pmty_functor
108
+
: (?attrs:attributes
109
+
-> ?modes:modes
110
+
-> functor_parameter
111
+
-> module_type
112
+
-> module_type)
113
+
with_loc
114
+
115
+
val pmod_constraint
116
+
: (?attrs:attributes -> module_expr -> module_type option -> modes -> module_expr)
117
+
with_loc
118
+
119
+
(** {2 N-ary functions} *)
120
+
121
+
(** Many comments below make reference to the Jane Street compiler's treatment of
122
+
function arity. These comments refer to a parsetree change made to upstream OCaml in
123
+
https://github.com/ocaml/ocaml/pull/12236, but that Jane Street has mirrored
124
+
internally already.
125
+
126
+
The treatment of arity can be summarized as follows:
127
+
- In a previous version of OCaml, a function's runtime arity was inferred at a late
128
+
stage of the compiler, after typechecking, where it fuses together nested lambdas.
129
+
- In the new version of OCaml (both upstream OCaml after #12236 and the internal
130
+
Jane Street compiler), a function's runtime arity is purely a syntactic notion:
131
+
it's the number of parameters in a [fun x1 ... xn -> body] construct, with some
132
+
special allowances for function cases.
133
+
134
+
Why is arity important? In native code, application sites of a function to [n]
135
+
syntactic arguments will trigger a fast path (where arguments are passed in
136
+
registers) only if the function's runtime arity is [n].
137
+
138
+
As a result, ppxes must take more care than before to generate functions of the
139
+
correct arity. Now, a nested function like [fun x -> fun y -> e] has arity 1
140
+
(returning still another function of arity 1) instead of arity 2. All bindings below
141
+
that construct functions are documented as to the arity of the returned function.
142
+
143
+
Some examples of arity:
144
+
- 2-ary function: [fun x y -> e]
145
+
- 1-ary function returning 1-ary function: [fun x -> fun y -> e]
146
+
- 3-ary function: [fun x y -> function P1 -> e1 | P2 -> e2]
147
+
- 2-ary function returning 1-ary function:
148
+
[fun x y -> (function P1 -> e1 | P2 -> e2)]
149
+
- 2-ary function returning 1-ary function:
150
+
[fun x -> function P1 -> function P2 -> e]
151
+
152
+
Notably, unparenthesized [function] has a special meaning when used as a direct body
153
+
of [fun]: the [function] becomes part of the arity of the outer [fun]. The same does
154
+
not apply for multiple nested [function]s, even if they each have a single case; the
155
+
nested [function]s are treated as unary. (See the last example.) *)
156
+
157
+
type function_param = Shim.Pexp_function.function_param
158
+
type function_constraint = Shim.Pexp_function.Function_constraint.t
159
+
type function_body = Shim.Pexp_function.function_body
160
+
161
+
module Latest : sig
162
+
(** Avoid shadowing Ppxlib's AST builder. *)
163
+
164
+
val ptyp_any : (jkind_annotation option -> core_type) with_loc
165
+
val ptyp_var : (string -> jkind_annotation option -> core_type) with_loc
166
+
167
+
val pexp_function
168
+
: (?attrs:attributes
169
+
-> function_param list
170
+
-> function_constraint
171
+
-> function_body
172
+
-> expression)
173
+
with_loc
174
+
end
175
+
176
+
(** Create a function with unlabeled parameters and an expression body. Like
177
+
{!Ppxlib.Ast_builder.eapply}, but for constructing functions.
178
+
179
+
[coalesce_fun_arity] is relevant for the Jane Street compiler. By default,
180
+
[coalesce_fun_arity] is [true].
181
+
182
+
Suppose there is a call [eabstract pats body ~coalesce_fun_arity]
183
+
- If [colaesce_fun_arity] is [true], the arity of the returned function is the same
184
+
as the arity of: [add_fun_params (List.map params ~f:(Fun.param Nolabel)) body]
185
+
- If [coalesce_fun_arity] is [false], then the arity of the returned function is the
186
+
length of [pats].
187
+
188
+
In other words, [coalesce_fun_arity = true] allows you to build up the arity of an
189
+
already-constructed function rather than necessarily creating a new function. *)
190
+
val eabstract
191
+
: (?coalesce_fun_arity:bool
192
+
-> ?return_constraint:core_type
193
+
-> pattern list
194
+
-> expression
195
+
-> expression)
196
+
with_loc
197
+
198
+
(** [unary_function cases] is [function <cases>]. When used with the Jane Street
199
+
compiler, the function's runtime arity is 1, so the fast path for function
200
+
application happens only when application sites of the resulting function receive 1
201
+
argument. To create a function with multiple argument that pattern-matches on the
202
+
last one, use [add_param] or [add_params] to add more parameters. Alternatively, use
203
+
[pexp_function] to provide all parameters at once.
204
+
205
+
The attributes of the resulting expression will be the [attrs] argument together
206
+
with any attributes added by the Jane Street compiler. *)
207
+
val unary_function : (?attrs:attributes -> case list -> expression) with_loc
208
+
209
+
(** [fun_param lbl pat] is [Pparam_val (lbl, None, pat)]. This gives a more
210
+
self-documenting way of constructing the usual case: value parameters without
211
+
optional argument defaults. *)
212
+
val fun_param : (arg_label -> pattern -> function_param) with_loc
213
+
214
+
(** Say an expression is a "function" if it is a [Pexp_fun] or a [Pexp_function]. All
215
+
functions have parameters and arity.
216
+
217
+
Suppose [add_param lbl def pat e ==> e']. Then, letting
218
+
[param = Pparam_val (lbl, def, pat)],
219
+
- If [e] is a function with arity [n], then [e'] is a function with arity [n+1].
220
+
[param] is added at the outermost layer. For example, if
221
+
[e = fun <params> -> <body>], then [e' = fun <param :: params> -> body]. The
222
+
attributes on the resulting expression will be the [attrs] argument together with
223
+
any attributes already present on [e].
224
+
- If [e] is not a function, then [e'] is a function with arity [1], namely:
225
+
[fun <param> -> <e>]. The attributes of the resulting expression will be the
226
+
[attrs] argument together with any attributes added by the Jane Street compiler. *)
227
+
val add_fun_param
228
+
: (?attrs:attributes
229
+
-> ?return_constraint:core_type
230
+
-> arg_label
231
+
-> expression option
232
+
-> pattern
233
+
-> expression
234
+
-> expression)
235
+
with_loc
236
+
237
+
(** [add_params params e] is [List.fold_right params ~init:e ~f:add_param]. Note the
238
+
[fold_right]: if [e] is [fun <params'> -> <body>], then [add_params params e] is
239
+
[fun <params @ params'> -> <body>]. *)
240
+
val add_fun_params
241
+
: (?attrs:attributes
242
+
-> ?return_constraint:core_type
243
+
-> function_param list
244
+
-> expression
245
+
-> expression)
246
+
with_loc
247
+
248
+
(** This operation is a no-op, except as interpreted by the Jane Street compiler. If [e]
249
+
is a function with arity [n] with an expression body that itself is a function with
250
+
arity [m], then [coalesce_fun_arity e] is a function of arity [n + m].
251
+
252
+
You should usually call [coalesce_fun_arity] on metaquot fun expressions whose body
253
+
may be a function, e.g.:
254
+
255
+
[coalesce_fun_arity [%expr fun x y -> [%e possibly_function]]] *)
256
+
val coalesce_fun_arity : expression -> expression
257
+
258
+
(** {2 Unboxed types} *)
259
+
260
+
val ptyp_unboxed_tuple : ((string option * core_type) list -> core_type) with_loc
261
+
262
+
val pexp_unboxed_tuple
263
+
: (?attrs:attributes -> (string option * expression) list -> expression) with_loc
264
+
265
+
val pexp_record_unboxed_product
266
+
: (?attrs:attributes
267
+
-> (Longident.t loc * expression) list
268
+
-> expression option
269
+
-> expression)
270
+
with_loc
271
+
272
+
val ppat_record_unboxed_product
273
+
: (?attrs:attributes -> (Longident.t loc * pattern) list -> closed_flag -> pattern)
274
+
with_loc
275
+
276
+
val pexp_unboxed_field
277
+
: (?attrs:attributes -> expression -> Longident.t loc -> expression) with_loc
278
+
279
+
val ppat_unboxed_tuple
280
+
: (?attrs:attributes -> (string option * pattern) list -> closed_flag -> pattern)
281
+
with_loc
282
+
283
+
val pexp_idx
284
+
: (?attrs:attributes -> block_access -> unboxed_access list -> expression) with_loc
285
+
286
+
(** {3 Expression literals} *)
287
+
288
+
(** e.g. [#42L] *)
289
+
val eint64_u : (int64 -> expression) with_loc
290
+
291
+
(** e.g. [#42l] *)
292
+
val eint32_u : (int32 -> expression) with_loc
293
+
294
+
(** e.g. [#42n] *)
295
+
val enativeint_u : (nativeint -> expression) with_loc
296
+
297
+
(** e.g. [#42.] *)
298
+
val efloat_u : (string -> expression) with_loc
299
+
300
+
(** {3 Pattern literals} *)
301
+
302
+
(** e.g. [#42L] *)
303
+
val pint64_u : (int64 -> pattern) with_loc
304
+
305
+
(** e.g. [#42l] *)
306
+
val pint32_u : (int32 -> pattern) with_loc
307
+
308
+
(** e.g. [#42n] *)
309
+
val pnativeint_u : (nativeint -> pattern) with_loc
310
+
311
+
(** e.g. [#42.] *)
312
+
val pfloat_u : (string -> pattern) with_loc
313
+
314
+
(** {3 Layouts} *)
315
+
316
+
val ptyp_alias
317
+
: (?attrs:attributes
318
+
-> core_type
319
+
-> label loc option
320
+
-> jkind_annotation option
321
+
-> core_type)
322
+
with_loc
323
+
324
+
val ptyp_poly
325
+
: (?attrs:attributes
326
+
-> (string loc * jkind_annotation option) list
327
+
-> core_type
328
+
-> core_type)
329
+
with_loc
330
+
331
+
val ptyp_quote : (?attrs:attributes -> core_type -> core_type) with_loc
332
+
val ptyp_splice : (?attrs:attributes -> core_type -> core_type) with_loc
333
+
334
+
val pexp_newtype
335
+
: (?attrs:attributes
336
+
-> string loc
337
+
-> jkind_annotation option
338
+
-> expression
339
+
-> expression)
340
+
with_loc
341
+
342
+
val type_declaration
343
+
: (?attrs:attributes
344
+
-> ?jkind_annotation:jkind_annotation
345
+
-> name:string Location.loc
346
+
-> params:(core_type * (variance * injectivity)) list
347
+
-> cstrs:(core_type * core_type * Location.t) list
348
+
-> kind:type_kind
349
+
-> private_:private_flag
350
+
-> manifest:core_type option
351
+
-> unit
352
+
-> type_declaration)
353
+
with_loc
354
+
355
+
(** {2 Labeled tuples} *)
356
+
357
+
val ptyp_tuple
358
+
: (?attrs:attributes -> (string option * core_type) list -> core_type) with_loc
359
+
360
+
val pexp_tuple
361
+
: (?attrs:attributes -> (string option * expression) list -> expression) with_loc
362
+
363
+
val ppat_tuple
364
+
: (?attrs:attributes -> (string option * pattern) list -> closed_flag -> pattern)
365
+
with_loc
366
+
367
+
(** {2 Immutable arrays} *)
368
+
369
+
val ppat_array : (?attrs:attributes -> mutable_flag -> pattern list -> pattern) with_loc
370
+
371
+
val pexp_array
372
+
: (?attrs:attributes -> mutable_flag -> expression list -> expression) with_loc
373
+
end
374
+
375
+
module type S_with_implicit_loc = S with type 'a with_loc := 'a
376
+
module type S_with_explicit_loc = S with type 'a with_loc := loc:Location.t -> 'a
377
+
378
+
module type Ast_builder = sig
379
+
(** Jane Street-internal extensions to {!Ppxlib.Ast_builder}. The bindings below
380
+
([Default], [Make], etc.) are parallel to bindings exported from
381
+
[Ppxlib.Ast_builder]. *)
382
+
383
+
module type S_with_implicit_loc = S_with_implicit_loc
384
+
385
+
module Default : S_with_explicit_loc
386
+
387
+
module Make (Loc : sig
388
+
val loc : Location.t
389
+
end) : S_with_implicit_loc
390
+
391
+
val make : Location.t -> (module S_with_implicit_loc)
392
+
end
+41
vendor/opam/ppxlib_jane/src/ast_traverse.ml
+41
vendor/opam/ppxlib_jane/src/ast_traverse.ml
···
1
+
class iter =
2
+
object
3
+
inherit Ppxlib_traverse_builtins.iter
4
+
inherit Shim.Ast_traverse.iter
5
+
end
6
+
7
+
class map =
8
+
object
9
+
inherit Ppxlib_traverse_builtins.map
10
+
inherit Shim.Ast_traverse.map
11
+
end
12
+
13
+
class ['acc] fold =
14
+
object
15
+
inherit ['acc] Ppxlib_traverse_builtins.fold
16
+
inherit ['acc] Shim.Ast_traverse.fold
17
+
end
18
+
19
+
class ['acc] fold_map =
20
+
object
21
+
inherit ['acc] Ppxlib_traverse_builtins.fold_map
22
+
inherit ['acc] Shim.Ast_traverse.fold_map
23
+
end
24
+
25
+
class ['ctx] map_with_context =
26
+
object
27
+
inherit ['ctx] Ppxlib_traverse_builtins.map_with_context
28
+
inherit ['ctx] Shim.Ast_traverse.map_with_context
29
+
end
30
+
31
+
class virtual ['res] lift =
32
+
object
33
+
inherit ['res] Ppxlib_traverse_builtins.lift
34
+
inherit ['res] Shim.Ast_traverse.lift
35
+
end
36
+
37
+
class virtual ['ctx, 'res] lift_map_with_context =
38
+
object
39
+
inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context
40
+
inherit ['ctx, 'res] Shim.Ast_traverse.lift_map_with_context
41
+
end
+34
vendor/opam/ppxlib_jane/src/ast_traverse.mli
+34
vendor/opam/ppxlib_jane/src/ast_traverse.mli
···
1
+
class iter : object
2
+
inherit Ppxlib_traverse_builtins.iter
3
+
inherit Shim.Ast_traverse.iter
4
+
end
5
+
6
+
class map : object
7
+
inherit Ppxlib_traverse_builtins.map
8
+
inherit Shim.Ast_traverse.map
9
+
end
10
+
11
+
class ['acc] fold : object
12
+
inherit ['acc] Ppxlib_traverse_builtins.fold
13
+
inherit ['acc] Shim.Ast_traverse.fold
14
+
end
15
+
16
+
class ['acc] fold_map : object
17
+
inherit ['acc] Ppxlib_traverse_builtins.fold_map
18
+
inherit ['acc] Shim.Ast_traverse.fold_map
19
+
end
20
+
21
+
class ['ctx] map_with_context : object
22
+
inherit ['ctx] Ppxlib_traverse_builtins.map_with_context
23
+
inherit ['ctx] Shim.Ast_traverse.map_with_context
24
+
end
25
+
26
+
class virtual ['res] lift : object
27
+
inherit ['res] Ppxlib_traverse_builtins.lift
28
+
inherit ['res] Shim.Ast_traverse.lift
29
+
end
30
+
31
+
class virtual ['ctx, 'res] lift_map_with_context : object
32
+
inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context
33
+
inherit ['ctx, 'res] Shim.Ast_traverse.lift_map_with_context
34
+
end
+57
vendor/opam/ppxlib_jane/src/common.ml
+57
vendor/opam/ppxlib_jane/src/common.ml
···
1
+
open Ppxlib_ast.Asttypes
2
+
open Ppxlib_ast.Parsetree
3
+
4
+
let not_a_type_parameter ~loc =
5
+
Astlib.Location.Error.make { loc; txt = "not a named type parameter" } ~sub:[]
6
+
;;
7
+
8
+
let get_type_param_name_and_jkind_res ty =
9
+
let loc = ty.ptyp_loc in
10
+
match Shim.Core_type_desc.of_parsetree ty.ptyp_desc with
11
+
| Ptyp_var (name, jkind) -> Ok ({ loc; txt = name }, jkind)
12
+
| _ -> Error (not_a_type_parameter ~loc)
13
+
;;
14
+
15
+
let get_type_param_name_and_jkind_of_core_type t =
16
+
match get_type_param_name_and_jkind_res t with
17
+
| Ok e -> e
18
+
| Error err -> Ppxlib_ast.Location_error.raise err
19
+
;;
20
+
21
+
let get_type_param_name_and_jkind (t, _) = get_type_param_name_and_jkind_of_core_type t
22
+
23
+
let as_unlabeled_tuple components =
24
+
if List.for_all (fun (label, _) -> Option.is_none label) components
25
+
then Some (List.map snd components)
26
+
else None
27
+
;;
28
+
29
+
let mangle_longident ~suffix : Longident.t -> Longident.t = function
30
+
| Lident name -> Lident (name ^ suffix)
31
+
| Ldot (path, name) -> Ldot (path, name ^ suffix)
32
+
| Lapply _ as longident -> longident
33
+
;;
34
+
35
+
let localize_longident = mangle_longident ~suffix:"__local"
36
+
let stackify_longident = mangle_longident ~suffix:"__stack"
37
+
38
+
let mangle_include_sig incl ~f =
39
+
{ incl with
40
+
pincl_mod =
41
+
{ incl.pincl_mod with
42
+
pmty_desc =
43
+
(match incl.pincl_mod.pmty_desc with
44
+
| Pmty_ident { txt; loc } -> Pmty_ident { txt = f txt; loc }
45
+
| Pmty_with (({ pmty_desc = Pmty_ident { txt; loc }; _ } as mty), cstrs) ->
46
+
Pmty_with ({ mty with pmty_desc = Pmty_ident { txt = f txt; loc } }, cstrs)
47
+
| _ -> failwith "expected [include S] or [include S with ...]")
48
+
}
49
+
}
50
+
;;
51
+
52
+
let localize_include_sig incl = mangle_include_sig incl ~f:localize_longident
53
+
let stackify_include_sig incl = mangle_include_sig incl ~f:stackify_longident
54
+
55
+
let append_arbitrary_suffix_to_include_signature incl ~suffix =
56
+
mangle_include_sig incl ~f:(mangle_longident ~suffix)
57
+
;;
+37
vendor/opam/ppxlib_jane/src/common.mli
+37
vendor/opam/ppxlib_jane/src/common.mli
···
1
+
open Ppxlib_ast
2
+
3
+
(** Similar to {!Ppxlib.get_type_param_name}, but also tells you the jkind of the
4
+
variable. Raises a located error in case of failure. The type parameter should not be
5
+
[_]. One way to ensure this is to get the type from {!Ppxlib.name_type_params_in_td}
6
+
(or one of the similarly-named functions). *)
7
+
val get_type_param_name_and_jkind
8
+
: Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)
9
+
-> string Location.loc * Shim.jkind_annotation option
10
+
11
+
val get_type_param_name_and_jkind_of_core_type
12
+
: Parsetree.core_type
13
+
-> string Location.loc * Shim.jkind_annotation option
14
+
15
+
(** Check if the parsetree is of an unlabeled tuple (i.e. all labels are [None]), and
16
+
return the components of the tuple dropping its [None] labels. *)
17
+
val as_unlabeled_tuple : (string option * 'a) list -> 'a list option
18
+
19
+
(** Modifies an [include_description] to append "__local" to the module type name. In
20
+
particular, this is useful for modifying the result of {!Ppxlib.mk_named_sig}. For
21
+
example, if the latter produces some [incl] representing
22
+
[include Bin_prot.Binable.S1 with type 'a t := 'a t], calling
23
+
[localize_include_sig incl] will turn this into
24
+
[include Bin_prot.Binable.S1__local with type 'a t := 'a t]. *)
25
+
val localize_include_sig : Ast.include_description -> Ast.include_description
26
+
27
+
(** Like [localize_include_sig], but appends "__stack" rather than "__local". *)
28
+
val stackify_include_sig : Ast.include_description -> Ast.include_description
29
+
30
+
(** Like [localize_include_sig], but appends an arbitrary suffix.
31
+
32
+
This is useful when the suffix for your signature is not a standard mangling suffix as
33
+
produced by [ppx_template]. *)
34
+
val append_arbitrary_suffix_to_include_signature
35
+
: Ast.include_description
36
+
-> suffix:string
37
+
-> Ast.include_description
+6
vendor/opam/ppxlib_jane/src/dune
+6
vendor/opam/ppxlib_jane/src/dune
+1
vendor/opam/ppxlib_jane/src/imported-commit.txt
+1
vendor/opam/ppxlib_jane/src/imported-commit.txt
···
1
+
https://github.com/ocaml-flambda/flambda-backend.git 175c6552ea5641caf961e50eb33e5a38f71c2fb3
+96
vendor/opam/ppxlib_jane/src/legacy_pexp_function.ml
+96
vendor/opam/ppxlib_jane/src/legacy_pexp_function.ml
···
1
+
open! Astlib
2
+
open! Ppxlib_ast.Asttypes
3
+
open! Ppxlib_ast.Parsetree
4
+
5
+
type legacy_pexp_fun = arg_label * expression option * pattern * expression
6
+
type legacy_pexp_function = case list
7
+
type legacy_pexp_newtype = string loc * expression
8
+
9
+
type t =
10
+
| Legacy_pexp_fun of legacy_pexp_fun
11
+
(** Match [Pexp_fun], as in the OCaml parsetree prior to 5.2. To construct, use
12
+
[Ppxlib.Ast_builder.Default.pexp_fun]. *)
13
+
| Legacy_pexp_function of legacy_pexp_function
14
+
(** Match [Pexp_function], as in the OCaml parsetree prior to 5.2. To construct, use
15
+
[Ppxlib.Ast_builder.Default.pexp_function]. *)
16
+
| Legacy_pexp_newtype of legacy_pexp_newtype
17
+
18
+
let of_pexp_function
19
+
~(params : Shim.Pexp_function.function_param list)
20
+
~(constraint_ : Shim.Pexp_function.Function_constraint.t)
21
+
~(body : Shim.Pexp_function.function_body)
22
+
=
23
+
match params, body with
24
+
| [], Pfunction_cases (cases, _, _) -> Legacy_pexp_function cases
25
+
| { pparam_desc = first_param; pparam_loc } :: params, _ ->
26
+
let body =
27
+
match params, body with
28
+
(* The remaining body is still a valid function: we either
29
+
have more parameters in the list, or the body is function
30
+
cases (which implies a parameter).
31
+
*)
32
+
| _ :: _, _ | [], Pfunction_cases _ ->
33
+
let body_loc =
34
+
match body with
35
+
| Pfunction_body body -> body.pexp_loc
36
+
| Pfunction_cases (_, body_loc, _) -> body_loc
37
+
in
38
+
let rest_loc : Location.t =
39
+
{ loc_start = pparam_loc.loc_end; loc_end = body_loc.loc_end; loc_ghost = true }
40
+
in
41
+
let rest_fun = Shim.Pexp_function.to_parsetree ~params ~constraint_ ~body in
42
+
Ppxlib_ast.Ast_helper.Exp.mk rest_fun ~loc:rest_loc
43
+
(* The remaining body is not a valid function, and we just return it directly. *)
44
+
| [], Pfunction_body expr ->
45
+
(match constraint_ with
46
+
| c when Shim.Pexp_function.Function_constraint.is_none c -> expr
47
+
| ({ ret_type_constraint; ret_mode_annotations; mode_annotations = _ } :
48
+
Shim.Pexp_function.Function_constraint.t) ->
49
+
let loc = { expr.pexp_loc with loc_ghost = true } in
50
+
let pexp_desc =
51
+
match ret_type_constraint with
52
+
| Some (Pcoerce (ty1, ty2)) -> Pexp_coerce (expr, ty1, ty2)
53
+
| Some (Pconstraint ty) ->
54
+
Pexp_constraint (expr, Some ty, ret_mode_annotations)
55
+
|> Shim.Expression_desc.to_parsetree ~loc
56
+
| None ->
57
+
Pexp_constraint (expr, None, ret_mode_annotations)
58
+
|> Shim.Expression_desc.to_parsetree ~loc
59
+
in
60
+
Ppxlib_ast.Ast_helper.Exp.mk pexp_desc ~loc)
61
+
in
62
+
(match first_param with
63
+
| Pparam_val (lbl, opt, pat) -> Legacy_pexp_fun (lbl, opt, pat, body)
64
+
| Pparam_newtype (newtype, _jkind) -> Legacy_pexp_newtype (newtype, body))
65
+
| _, Pfunction_body body ->
66
+
Location.raise_errorf "empty function body" ~loc:body.pexp_loc
67
+
;;
68
+
69
+
let of_parsetree expression =
70
+
Option.map
71
+
(fun (params, constraint_, body) -> of_pexp_function ~params ~constraint_ ~body)
72
+
(Shim.Pexp_function.of_parsetree
73
+
expression
74
+
(* This location is just filled in as the [Pfunction_cases] location,
75
+
and [of_pexp_function] drops that location.
76
+
*)
77
+
~loc:Location.none)
78
+
;;
79
+
80
+
let legacy_pexp_fun_of_parsetree expression =
81
+
match of_parsetree expression with
82
+
| Some (Legacy_pexp_fun x) -> Some x
83
+
| _ -> None
84
+
;;
85
+
86
+
let legacy_pexp_function_of_parsetree expression =
87
+
match of_parsetree expression with
88
+
| Some (Legacy_pexp_function x) -> Some x
89
+
| _ -> None
90
+
;;
91
+
92
+
let legacy_pexp_newtype_of_parsetree expression =
93
+
match of_parsetree expression with
94
+
| Some (Legacy_pexp_newtype x) -> Some x
95
+
| _ -> None
96
+
;;
+46
vendor/opam/ppxlib_jane/src/legacy_pexp_function.mli
+46
vendor/opam/ppxlib_jane/src/legacy_pexp_function.mli
···
1
+
open! Astlib
2
+
open! Ppxlib_ast.Asttypes
3
+
open! Ppxlib_ast.Parsetree
4
+
5
+
(** Use of this module is discouraged.
6
+
7
+
This module allows you to turn matches on [Pexp_function (params, constraint_, body)]
8
+
into matches on the old parsetree prior to OCaml 5.2:
9
+
- [Pexp_newtype (newtype, body)]
10
+
- [Pexp_fun (label, default, pat)]
11
+
- [Pexp_function cases]
12
+
13
+
These constructors are available below, but with [Legacy_] tacked onto the name.
14
+
15
+
Generally, ppx authors should prefer handling the new [Pexp_function] constructor
16
+
directly. This module was introduced to make it easier to update old ppxes, but it has
17
+
less obvious behavior and is kludgy. *)
18
+
19
+
type legacy_pexp_fun := arg_label * expression option * pattern * expression
20
+
type legacy_pexp_function := case list
21
+
type legacy_pexp_newtype := string loc * expression
22
+
23
+
type t =
24
+
| Legacy_pexp_fun of legacy_pexp_fun
25
+
(** Match [Pexp_fun], as in the OCaml parsetree prior to 5.2. To construct, use
26
+
[Ppxlib.Ast_builder.Default.pexp_fun]. *)
27
+
| Legacy_pexp_function of legacy_pexp_function
28
+
(** Match [Pexp_function], as in the OCaml parsetree prior to 5.2. To construct, use
29
+
[Ppxlib.Ast_builder.Default.pexp_function]. *)
30
+
| Legacy_pexp_newtype of legacy_pexp_newtype
31
+
32
+
(** Creation functions *)
33
+
34
+
val of_parsetree : expression_desc -> t option
35
+
36
+
val of_pexp_function
37
+
: params:Shim.Pexp_function.function_param list
38
+
-> constraint_:Shim.Pexp_function.Function_constraint.t
39
+
-> body:Shim.Pexp_function.function_body
40
+
-> t
41
+
42
+
(** Testing a particular constructor of [t]. *)
43
+
44
+
val legacy_pexp_fun_of_parsetree : expression_desc -> legacy_pexp_fun option
45
+
val legacy_pexp_function_of_parsetree : expression_desc -> legacy_pexp_function option
46
+
val legacy_pexp_newtype_of_parsetree : expression_desc -> legacy_pexp_newtype option
+334
vendor/opam/ppxlib_jane/src/names.ml
+334
vendor/opam/ppxlib_jane/src/names.ml
···
1
+
open! Stdppx
2
+
3
+
module Language_feature_name = struct
4
+
let of_core_type_desc : Shim.Core_type_desc.t -> string = function
5
+
| Ptyp_var _ -> "type variable"
6
+
| Ptyp_tuple _ -> "tuple type"
7
+
| Ptyp_constr _ -> "type constructor"
8
+
| Ptyp_alias _ -> "type alias"
9
+
| Ptyp_variant (_, Open, _) -> "open polymorphic variant type"
10
+
| Ptyp_variant (_, Closed, _) -> "closed polymorphic variant type"
11
+
| Ptyp_any _ -> "wildcard type"
12
+
| Ptyp_arrow _ -> "arrow type"
13
+
| Ptyp_unboxed_tuple _ -> "unboxed tuple type"
14
+
| Ptyp_object _ -> "object type"
15
+
| Ptyp_class _ -> "class as a type"
16
+
| Ptyp_poly _ -> "explicit polymorphic type"
17
+
| Ptyp_package _ -> "first-class module type"
18
+
| Ptyp_quote _ -> "quoted type"
19
+
| Ptyp_splice _ -> "spliced type"
20
+
| Ptyp_of_kind _ -> "type of a fixed kind"
21
+
| Ptyp_extension _ -> "extension point as a type"
22
+
;;
23
+
24
+
let of_expression_desc : Shim.Expression_desc.t -> string = function
25
+
| Pexp_ident _ -> "variable expression"
26
+
| Pexp_constant c ->
27
+
(match Shim.Constant.of_parsetree c with
28
+
| Pconst_char _ -> "character literal expression"
29
+
| Pconst_untagged_char _ -> "untagged character literal expression"
30
+
| Pconst_integer _ -> "integer literal expression"
31
+
| Pconst_string _ -> "string literal expression"
32
+
| Pconst_float _ -> "floating point literal expression"
33
+
| Pconst_unboxed_float _ -> "unboxed floating point literal expression"
34
+
| Pconst_unboxed_integer _ -> "unboxed integer literal expression")
35
+
| Pexp_let _ -> "let expression"
36
+
| Pexp_function _ -> "function expression"
37
+
| Pexp_apply _ -> "application expression"
38
+
| Pexp_match _ -> "match expression"
39
+
| Pexp_try _ -> "try-with expression"
40
+
| Pexp_tuple _ -> "tuple expression"
41
+
| Pexp_unboxed_tuple _ -> "unboxed tuple expression"
42
+
| Pexp_construct _ -> "variant constructor expression"
43
+
| Pexp_variant _ -> "polymorphic variant constructor expression"
44
+
| Pexp_record (_, None) -> "record expression"
45
+
| Pexp_record (_, Some _) -> "record 'with' expression"
46
+
| Pexp_record_unboxed_product (_, None) -> "unboxed record expression"
47
+
| Pexp_record_unboxed_product (_, Some _) -> "unboxed record 'with' expression"
48
+
| Pexp_field _ -> "field access expression"
49
+
| Pexp_unboxed_field _ -> "unboxed field access expression"
50
+
| Pexp_setfield _ -> "field set expression"
51
+
| Pexp_array (Mutable, _) -> "array expression"
52
+
| Pexp_array (Immutable, _) -> "immutable array expression"
53
+
| Pexp_idx _ -> "block index expression"
54
+
| Pexp_ifthenelse (_, _, None) -> "if-then expression"
55
+
| Pexp_ifthenelse (_, _, Some _) -> "if-then-else expression"
56
+
| Pexp_sequence _ -> "sequencing ';' expression"
57
+
| Pexp_while _ -> "while loop expression"
58
+
| Pexp_for _ -> "for loop expression"
59
+
| Pexp_constraint _ -> "type constraint ':' expression"
60
+
| Pexp_coerce _ -> "type coercion ':>' expression"
61
+
| Pexp_send _ -> "method send '#' expression"
62
+
| Pexp_new _ -> "new-object expression"
63
+
| Pexp_setvar _ -> "variable set '<-' expression"
64
+
| Pexp_override _ -> "instance variable override '<{' ... '}>' expression"
65
+
| Pexp_letmodule _ -> "let-module expression"
66
+
| Pexp_letexception _ -> "let-exception expression"
67
+
| Pexp_assert _ -> "assert expression"
68
+
| Pexp_lazy _ -> "lazy expression"
69
+
| Pexp_poly _ -> "polymorphic method body expression"
70
+
| Pexp_object _ -> "object expression"
71
+
| Pexp_newtype _ -> "type-parameterized expression"
72
+
| Pexp_pack _ -> "first-class module expression"
73
+
| Pexp_open _ -> "let-open '.' expression"
74
+
| Pexp_letop _ -> "let-op expression"
75
+
| Pexp_extension _ -> "extension point as an expression"
76
+
| Pexp_unreachable -> "unreachable '.' expression"
77
+
| Pexp_stack _ -> "stack expression"
78
+
| Pexp_comprehension (Pcomp_list_comprehension _) -> "list comprehension expression"
79
+
| Pexp_comprehension (Pcomp_array_comprehension _) -> "array comprehension expression"
80
+
| Pexp_overwrite _ -> "overwrite"
81
+
| Pexp_quote _ -> "quoted expression"
82
+
| Pexp_splice _ -> "spliced expression"
83
+
| Pexp_hole -> "hole"
84
+
;;
85
+
86
+
let of_pattern_desc : Shim.Pattern_desc.t -> string = function
87
+
| Ppat_any -> "wildcard '_' pattern"
88
+
| Ppat_var _ -> "variable pattern"
89
+
| Ppat_alias _ -> "alias 'as' pattern"
90
+
| Ppat_constant c ->
91
+
(match Shim.Constant.of_parsetree c with
92
+
| Pconst_char _ -> "character literal pattern"
93
+
| Pconst_untagged_char _ -> "untagged character literal pattern"
94
+
| Pconst_integer _ -> "integer literal pattern"
95
+
| Pconst_unboxed_integer _ -> "unboxed integer literal pattern"
96
+
| Pconst_string _ -> "string literal pattern"
97
+
| Pconst_float _ -> "floating point literal pattern"
98
+
| Pconst_unboxed_float _ -> "unboxed floating point literal pattern")
99
+
| Ppat_interval _ -> "character interval '..' pattern"
100
+
| Ppat_tuple _ -> "tuple pattern"
101
+
| Ppat_unboxed_tuple _ -> "unboxed tuple pattern"
102
+
| Ppat_construct _ -> "variant constructor pattern"
103
+
| Ppat_variant _ -> "polymorphic variant constructor pattern"
104
+
| Ppat_record (_, Closed) -> "closed record pattern"
105
+
| Ppat_record (_, Open) -> "open record pattern"
106
+
| Ppat_record_unboxed_product (_, Closed) -> "closed unboxed record pattern"
107
+
| Ppat_record_unboxed_product (_, Open) -> "open unboxed record pattern"
108
+
| Ppat_array (Mutable, _) -> "array pattern"
109
+
| Ppat_array (Immutable, _) -> "immutable array pattern"
110
+
| Ppat_or _ -> "or '|' pattern"
111
+
| Ppat_constraint _ -> "type constraint ':' pattern"
112
+
| Ppat_type _ -> "type '#' pattern"
113
+
| Ppat_lazy _ -> "lazy pattern"
114
+
| Ppat_unpack _ -> "first-class module pattern"
115
+
| Ppat_exception _ -> "exception pattern"
116
+
| Ppat_extension _ -> "extension point as a pattern"
117
+
| Ppat_open _ -> "let-open '.' pattern"
118
+
;;
119
+
120
+
let of_signature_item_desc : Shim.Signature_item_desc.t -> string = function
121
+
| Psig_value _ -> "val declaration"
122
+
| Psig_type _ -> "type declaration"
123
+
| Psig_typesubst _ -> "type alias ':='"
124
+
| Psig_typext _ -> "extensible variant constructor declaration"
125
+
| Psig_exception _ -> "exception declaration"
126
+
| Psig_module _ -> "module declaration"
127
+
| Psig_modsubst _ -> "module alias ':='"
128
+
| Psig_recmodule _ -> "recursive module declaration"
129
+
| Psig_modtype _ -> "module type declaration"
130
+
| Psig_modtypesubst _ -> "module type alias ':='"
131
+
| Psig_open _ -> "module open (in a sig)"
132
+
| Psig_include _ -> "module include (in a sig)"
133
+
| Psig_class _ -> "class declaration"
134
+
| Psig_class_type _ -> "class type declaration"
135
+
| Psig_attribute _ -> "module-level attribute (in a sig)"
136
+
| Psig_extension _ -> "extension point as a signature item"
137
+
| Psig_kind_abbrev _ -> "kind abbrevation declaration"
138
+
;;
139
+
140
+
let of_structure_item_desc : Shim.Structure_item_desc.t -> string = function
141
+
| Pstr_value _ -> "let definition"
142
+
| Pstr_type _ -> "type definition"
143
+
| Pstr_typext _ -> "extensible variant constructor definition"
144
+
| Pstr_exception _ -> "exception definition"
145
+
| Pstr_module _ -> "module definition"
146
+
| Pstr_recmodule _ -> "recursive module definition"
147
+
| Pstr_modtype _ -> "module type definition"
148
+
| Pstr_open _ -> "module open (in a struct)"
149
+
| Pstr_include _ -> "module include (in a struct)"
150
+
| Pstr_class _ -> "class definition"
151
+
| Pstr_class_type _ -> "class type definition"
152
+
| Pstr_attribute _ -> "module-level attribute (in a struct)"
153
+
| Pstr_extension _ -> "extension point as a structure item"
154
+
| Pstr_kind_abbrev _ -> "kind abbreviation definition"
155
+
| Pstr_eval _ -> "top-level expression"
156
+
| Pstr_primitive _ -> "primitive 'external' binding"
157
+
;;
158
+
159
+
let of_module_type_desc : Shim.Module_type_desc.t -> string = function
160
+
| Pmty_ident _ -> "module type identifier"
161
+
| Pmty_signature _ -> "module type expression"
162
+
| Pmty_functor _ -> "functor module type"
163
+
| Pmty_with _ -> "module type with constraints"
164
+
| Pmty_typeof _ -> "'module type of'"
165
+
| Pmty_extension _ -> "extension point as module type"
166
+
| Pmty_alias _ -> "module type alias"
167
+
| Pmty_strengthen _ -> "strengthened module type"
168
+
;;
169
+
170
+
let of_module_expr_desc : Shim.Module_expr_desc.t -> string = function
171
+
| Pmod_ident _ -> "module identifier"
172
+
| Pmod_structure _ -> "module expression"
173
+
| Pmod_functor _ -> "functor"
174
+
| Pmod_apply _ -> "functor application"
175
+
| Pmod_constraint _ -> "module with constraints"
176
+
| Pmod_unpack _ -> "'val' unpacking of expression as module"
177
+
| Pmod_extension _ -> "extension point as module"
178
+
| Pmod_instance _ -> "module instance"
179
+
;;
180
+
end
181
+
182
+
module Constructor_name = struct
183
+
let of_core_type_desc : Shim.Core_type_desc.t -> string = function
184
+
| Ptyp_var _ -> "Ptyp_var"
185
+
| Ptyp_tuple _ -> "Ptyp_tuple"
186
+
| Ptyp_constr _ -> "Ptyp_constr"
187
+
| Ptyp_alias _ -> "Ptyp_alias"
188
+
| Ptyp_variant _ -> "Ptyp_variant"
189
+
| Ptyp_any _ -> "Ptyp_any"
190
+
| Ptyp_arrow _ -> "Ptyp_arrow"
191
+
| Ptyp_unboxed_tuple _ -> "Ptyp_unboxed_tuple"
192
+
| Ptyp_object _ -> "Ptyp_object"
193
+
| Ptyp_class _ -> "Ptyp_class"
194
+
| Ptyp_poly _ -> "Ptyp_poly"
195
+
| Ptyp_package _ -> "Ptyp_package"
196
+
| Ptyp_quote _ -> "Ptyp_quote"
197
+
| Ptyp_splice _ -> "Ptyp_splice"
198
+
| Ptyp_of_kind _ -> "Ptyp_of_kind"
199
+
| Ptyp_extension _ -> "Ptyp_extension"
200
+
;;
201
+
202
+
let of_expression_desc : Shim.Expression_desc.t -> string = function
203
+
| Pexp_ident _ -> "Pexp_ident"
204
+
| Pexp_constant _ -> "Pexp_constant"
205
+
| Pexp_let _ -> "Pexp_let"
206
+
| Pexp_function _ -> "Pexp_function"
207
+
| Pexp_apply _ -> "Pexp_apply"
208
+
| Pexp_match _ -> "Pexp_match"
209
+
| Pexp_try _ -> "Pexp_try"
210
+
| Pexp_tuple _ -> "Pexp_tuple"
211
+
| Pexp_unboxed_tuple _ -> "Pexp_unboxed_tuple"
212
+
| Pexp_construct _ -> "Pexp_construct"
213
+
| Pexp_variant _ -> "Pexp_variant"
214
+
| Pexp_record _ -> "Pexp_record"
215
+
| Pexp_record_unboxed_product _ -> "Pexp_record_unboxed_product"
216
+
| Pexp_field _ -> "Pexp_field"
217
+
| Pexp_unboxed_field _ -> "Pexp_unboxed_field"
218
+
| Pexp_setfield _ -> "Pexp_setfield"
219
+
| Pexp_array _ -> "Pexp_array"
220
+
| Pexp_idx _ -> "Pexp_idx"
221
+
| Pexp_ifthenelse _ -> "Pexp_ifthenelse"
222
+
| Pexp_sequence _ -> "Pexp_sequence"
223
+
| Pexp_while _ -> "Pexp_while"
224
+
| Pexp_for _ -> "Pexp_for"
225
+
| Pexp_constraint _ -> "Pexp_constraint"
226
+
| Pexp_coerce _ -> "Pexp_coerce"
227
+
| Pexp_send _ -> "Pexp_send"
228
+
| Pexp_new _ -> "Pexp_new"
229
+
| Pexp_setvar _ -> "Pexp_setvar"
230
+
| Pexp_override _ -> "Pexp_override"
231
+
| Pexp_letmodule _ -> "Pexp_letmodule"
232
+
| Pexp_letexception _ -> "Pexp_letexception"
233
+
| Pexp_assert _ -> "Pexp_assert"
234
+
| Pexp_lazy _ -> "Pexp_lazy"
235
+
| Pexp_poly _ -> "Pexp_poly"
236
+
| Pexp_object _ -> "Pexp_object"
237
+
| Pexp_newtype _ -> "Pexp_newtype"
238
+
| Pexp_pack _ -> "Pexp_pack"
239
+
| Pexp_open _ -> "Pexp_open"
240
+
| Pexp_letop _ -> "Pexp_letop"
241
+
| Pexp_extension _ -> "Pexp_extension"
242
+
| Pexp_unreachable -> "Pexp_unreachable"
243
+
| Pexp_stack _ -> "Pexp_stack"
244
+
| Pexp_comprehension _ -> "Pexp_comprehension"
245
+
| Pexp_overwrite _ -> "Pexp_overwrite"
246
+
| Pexp_quote _ -> "Pexp_quote"
247
+
| Pexp_splice _ -> "Pexp_splice"
248
+
| Pexp_hole -> "Pexp_hole"
249
+
;;
250
+
251
+
let of_pattern_desc : Shim.Pattern_desc.t -> string = function
252
+
| Ppat_any -> "Ppat_any"
253
+
| Ppat_var _ -> "Ppat_var"
254
+
| Ppat_alias _ -> "Ppat_alias"
255
+
| Ppat_constant _ -> "Ppat_constant"
256
+
| Ppat_interval _ -> "Ppat_interval"
257
+
| Ppat_tuple _ -> "Ppat_tuple"
258
+
| Ppat_unboxed_tuple _ -> "Ppat_unboxed_tuple"
259
+
| Ppat_construct _ -> "Ppat_construct"
260
+
| Ppat_variant _ -> "Ppat_variant"
261
+
| Ppat_record _ -> "Ppat_record"
262
+
| Ppat_record_unboxed_product _ -> "Ppat_record_unboxed_product"
263
+
| Ppat_array _ -> "Ppat_array"
264
+
| Ppat_or _ -> "Ppat_or"
265
+
| Ppat_constraint _ -> "Ppat_constraint"
266
+
| Ppat_type _ -> "Ppat_type"
267
+
| Ppat_lazy _ -> "Ppat_lazy"
268
+
| Ppat_unpack _ -> "Ppat_unpack"
269
+
| Ppat_exception _ -> "Ppat_exception"
270
+
| Ppat_extension _ -> "Ppat_extension"
271
+
| Ppat_open _ -> "Ppat_open"
272
+
;;
273
+
274
+
let of_signature_item_desc : Shim.Signature_item_desc.t -> string = function
275
+
| Psig_value _ -> "Psig_value"
276
+
| Psig_type _ -> "Psig_type"
277
+
| Psig_typesubst _ -> "Psig_typesubst"
278
+
| Psig_typext _ -> "Psig_typext"
279
+
| Psig_exception _ -> "Psig_exception"
280
+
| Psig_module _ -> "Psig_module"
281
+
| Psig_modsubst _ -> "Psig_modsubst"
282
+
| Psig_recmodule _ -> "Psig_recmodule"
283
+
| Psig_modtype _ -> "Psig_modtype"
284
+
| Psig_modtypesubst _ -> "Psig_modtypesubst"
285
+
| Psig_open _ -> "Psig_open"
286
+
| Psig_include _ -> "Psig_include"
287
+
| Psig_class _ -> "Psig_class"
288
+
| Psig_class_type _ -> "Psig_class_type"
289
+
| Psig_attribute _ -> "Psig_attribute"
290
+
| Psig_extension _ -> "Psig_extension"
291
+
| Psig_kind_abbrev _ -> "Psig_kind_abbrev"
292
+
;;
293
+
294
+
let of_structure_item_desc : Shim.Structure_item_desc.t -> string = function
295
+
| Pstr_value _ -> "Pstr_value"
296
+
| Pstr_type _ -> "Pstr_type"
297
+
| Pstr_typext _ -> "Pstr_typext"
298
+
| Pstr_exception _ -> "Pstr_exception"
299
+
| Pstr_module _ -> "Pstr_module"
300
+
| Pstr_recmodule _ -> "Pstr_recmodule"
301
+
| Pstr_modtype _ -> "Pstr_modtype"
302
+
| Pstr_open _ -> "Pstr_open"
303
+
| Pstr_include _ -> "Pstr_include"
304
+
| Pstr_class _ -> "Pstr_class"
305
+
| Pstr_class_type _ -> "Pstr_class_type"
306
+
| Pstr_attribute _ -> "Pstr_attribute"
307
+
| Pstr_extension _ -> "Pstr_extension"
308
+
| Pstr_kind_abbrev _ -> "Pstr_kind_abbrev"
309
+
| Pstr_eval _ -> "Pstr_eval"
310
+
| Pstr_primitive _ -> "Pstr_primitive"
311
+
;;
312
+
313
+
let of_module_type_desc : Shim.Module_type_desc.t -> string = function
314
+
| Pmty_ident _ -> "Pmty_ident"
315
+
| Pmty_signature _ -> "Pmty_signature"
316
+
| Pmty_functor _ -> "Pmty_functor"
317
+
| Pmty_with _ -> "Pmty_with"
318
+
| Pmty_typeof _ -> "Pmty_typeof"
319
+
| Pmty_extension _ -> "Pmty_extension"
320
+
| Pmty_alias _ -> "Pmty_alias"
321
+
| Pmty_strengthen _ -> "Pmty_strengthen"
322
+
;;
323
+
324
+
let of_module_expr_desc : Shim.Module_expr_desc.t -> string = function
325
+
| Pmod_ident _ -> "Pmod_ident"
326
+
| Pmod_structure _ -> "Pmod_structure"
327
+
| Pmod_functor _ -> "Pmod_functor"
328
+
| Pmod_apply _ -> "Pmod_apply"
329
+
| Pmod_constraint _ -> "Pmod_constraint"
330
+
| Pmod_unpack _ -> "Pmod_unpack"
331
+
| Pmod_extension _ -> "Pmod_extension"
332
+
| Pmod_instance _ -> "Pmod_instance"
333
+
;;
334
+
end
+23
vendor/opam/ppxlib_jane/src/names.mli
+23
vendor/opam/ppxlib_jane/src/names.mli
···
1
+
open! Stdppx
2
+
3
+
(** A human-readable name for the language feature corresponding to the construct. *)
4
+
module Language_feature_name : sig
5
+
val of_core_type_desc : Shim.Core_type_desc.t -> string
6
+
val of_expression_desc : Shim.Expression_desc.t -> string
7
+
val of_pattern_desc : Shim.Pattern_desc.t -> string
8
+
val of_signature_item_desc : Shim.Signature_item_desc.t -> string
9
+
val of_structure_item_desc : Shim.Structure_item_desc.t -> string
10
+
val of_module_type_desc : Shim.Module_type_desc.t -> string
11
+
val of_module_expr_desc : Shim.Module_expr_desc.t -> string
12
+
end
13
+
14
+
(** The literal name of the constructor corresponding to the construct (e.g. Pexp_ident) *)
15
+
module Constructor_name : sig
16
+
val of_core_type_desc : Shim.Core_type_desc.t -> string
17
+
val of_expression_desc : Shim.Expression_desc.t -> string
18
+
val of_pattern_desc : Shim.Pattern_desc.t -> string
19
+
val of_signature_item_desc : Shim.Signature_item_desc.t -> string
20
+
val of_structure_item_desc : Shim.Structure_item_desc.t -> string
21
+
val of_module_type_desc : Shim.Module_type_desc.t -> string
22
+
val of_module_expr_desc : Shim.Module_expr_desc.t -> string
23
+
end
+40
vendor/opam/ppxlib_jane/src/ppxlib_jane.ml
+40
vendor/opam/ppxlib_jane/src/ppxlib_jane.ml
···
1
+
module Shim = Shim
2
+
module Ast_builder = Ast_builder
3
+
module Ast_traverse = Ast_traverse
4
+
module Legacy_pexp_function = Legacy_pexp_function
5
+
module Language_feature_name = Names.Language_feature_name
6
+
module Constructor_name = Names.Constructor_name
7
+
8
+
(** {2 Common helper functions} *)
9
+
include Common
10
+
11
+
(** {2 Common Jane Street helper types} *)
12
+
13
+
type modality = Shim.Modality.t = Modality of string [@@unboxed]
14
+
type modalities = Shim.Modalities.t
15
+
type mode = Shim.Mode.t = Mode of string [@@unboxed]
16
+
type modes = Shim.Modes.t
17
+
18
+
type arrow_result = Shim.arrow_result =
19
+
{ result_modes : modes
20
+
; result_type : Ppxlib_ast.Parsetree.core_type
21
+
}
22
+
23
+
type arrow_argument = Shim.arrow_argument =
24
+
{ arg_label : Ppxlib_ast.Asttypes.arg_label
25
+
; arg_modes : modes
26
+
; arg_type : Ppxlib_ast.Parsetree.core_type
27
+
}
28
+
29
+
type jkind_annotation_desc = Shim.jkind_annotation_desc =
30
+
| Pjk_default
31
+
| Pjk_abbreviation of string
32
+
| Pjk_mod of Shim.jkind_annotation * Shim.Modes.t
33
+
| Pjk_with of Shim.jkind_annotation * Ppxlib_ast.Parsetree.core_type * Shim.Modalities.t
34
+
| Pjk_kind_of of Ppxlib_ast.Parsetree.core_type
35
+
| Pjk_product of Shim.jkind_annotation list
36
+
37
+
type jkind_annotation = Shim.jkind_annotation =
38
+
{ pjkind_loc : Location.t
39
+
; pjkind_desc : Shim.jkind_annotation_desc
40
+
}
+2163
vendor/opam/ppxlib_jane/src/shim.ml
+2163
vendor/opam/ppxlib_jane/src/shim.ml
···
1
+
open Astlib
2
+
open Ppxlib_ast.Asttypes
3
+
open Ppxlib_ast.Parsetree
4
+
module Ast_helper = Ppxlib_ast.Ast_helper
5
+
6
+
module Modality = struct
7
+
type nonrec t = Modality of string [@@unboxed]
8
+
end
9
+
10
+
module Modalities = struct
11
+
type t = Modality.t loc list
12
+
13
+
let none = []
14
+
let portable ~loc = [ { txt = Modality.Modality "portable"; loc } ]
15
+
end
16
+
17
+
module Mode = struct
18
+
type t = Mode of string [@@unboxed]
19
+
end
20
+
21
+
module Modes = struct
22
+
type t = Mode.t loc list
23
+
24
+
let none = []
25
+
let local ~loc = [ { txt = Mode.Mode "local"; loc } ]
26
+
end
27
+
28
+
module Include_kind = struct
29
+
type t =
30
+
| Structure
31
+
| Functor
32
+
end
33
+
34
+
type arrow_argument =
35
+
{ arg_label : arg_label
36
+
; arg_modes : Modes.t
37
+
; arg_type : core_type
38
+
}
39
+
40
+
type arrow_result =
41
+
{ result_modes : Modes.t
42
+
; result_type : core_type
43
+
}
44
+
45
+
module Pcstr_tuple_arg = struct
46
+
type t = core_type
47
+
48
+
let extract_modalities t = [], t
49
+
let to_core_type t = t
50
+
let of_core_type core_type = core_type
51
+
let map_core_type t ~f = f t
52
+
let map_core_type_extra t ~f = f t
53
+
let create ~loc:_ ~modalities:_ ~type_ = type_
54
+
end
55
+
56
+
module Label_declaration = struct
57
+
let extract_modalities ld = [], ld
58
+
59
+
let create ~loc ~name ~mutable_ ~modalities:_ ~type_ =
60
+
{ pld_loc = loc
61
+
; pld_name = name
62
+
; pld_type = type_
63
+
; pld_mutable = mutable_
64
+
; pld_attributes = []
65
+
}
66
+
;;
67
+
end
68
+
69
+
module Value_description = struct
70
+
let extract_modalities vd = [], vd
71
+
72
+
let create ~loc ~name ~type_ ~modalities:_ ~prim =
73
+
{ pval_loc = loc
74
+
; pval_name = name
75
+
; pval_type = type_
76
+
; pval_prim = prim
77
+
; pval_attributes = []
78
+
}
79
+
;;
80
+
end
81
+
82
+
module Module_declaration = struct
83
+
type t =
84
+
{ pmd_name : string option loc
85
+
; pmd_type : module_type
86
+
; pmd_modalities : Modalities.t
87
+
; pmd_attributes : attributes (** [... [\@\@id1] [\@\@id2]] *)
88
+
; pmd_loc : Location.t
89
+
}
90
+
91
+
let to_parsetree
92
+
({ pmd_name; pmd_type; pmd_attributes; pmd_loc; pmd_modalities = _ } : t)
93
+
: module_declaration
94
+
=
95
+
{ pmd_name; pmd_type; pmd_attributes; pmd_loc }
96
+
;;
97
+
98
+
let of_parsetree ({ pmd_name; pmd_type; pmd_attributes; pmd_loc } : module_declaration)
99
+
: t
100
+
=
101
+
let pmd_modalities = [] in
102
+
{ pmd_name; pmd_type; pmd_attributes; pmd_loc; pmd_modalities }
103
+
;;
104
+
end
105
+
106
+
module Value_binding = struct
107
+
let extract_modes vb = [], vb
108
+
109
+
let create ~loc ~pat ~expr ~modes:_ =
110
+
{ pvb_pat = pat; pvb_expr = expr; pvb_attributes = []; pvb_loc = loc }
111
+
;;
112
+
end
113
+
114
+
module T = struct
115
+
type jkind_annotation_desc =
116
+
| Pjk_default
117
+
| Pjk_abbreviation of string
118
+
| Pjk_mod of jkind_annotation * Modes.t
119
+
| Pjk_with of jkind_annotation * core_type * Modalities.t
120
+
| Pjk_kind_of of core_type
121
+
| Pjk_product of jkind_annotation list
122
+
123
+
and jkind_annotation =
124
+
{ pjkind_loc : Location.t
125
+
; pjkind_desc : jkind_annotation_desc
126
+
}
127
+
end
128
+
129
+
include T
130
+
131
+
module Type_declaration = struct
132
+
type t =
133
+
{ ptype_name : string loc
134
+
; ptype_params : (core_type * (variance * injectivity)) list
135
+
; ptype_cstrs : (core_type * core_type * Location.t) list
136
+
; ptype_kind : type_kind
137
+
; ptype_private : private_flag
138
+
; ptype_manifest : core_type option
139
+
; ptype_attributes : attributes
140
+
; ptype_jkind_annotation : jkind_annotation option
141
+
; ptype_loc : Location.t
142
+
}
143
+
144
+
let to_parsetree : t -> type_declaration =
145
+
fun { ptype_name
146
+
; ptype_params
147
+
; ptype_cstrs
148
+
; ptype_kind
149
+
; ptype_private
150
+
; ptype_manifest
151
+
; ptype_attributes
152
+
; ptype_jkind_annotation = _
153
+
; ptype_loc
154
+
} ->
155
+
{ ptype_name
156
+
; ptype_params
157
+
; ptype_cstrs
158
+
; ptype_kind
159
+
; ptype_private
160
+
; ptype_manifest
161
+
; ptype_attributes
162
+
; ptype_loc
163
+
}
164
+
;;
165
+
166
+
let of_parsetree : type_declaration -> t =
167
+
fun { ptype_name
168
+
; ptype_params
169
+
; ptype_cstrs
170
+
; ptype_kind
171
+
; ptype_private
172
+
; ptype_manifest
173
+
; ptype_attributes
174
+
; ptype_loc
175
+
} ->
176
+
{ ptype_name
177
+
; ptype_params
178
+
; ptype_cstrs
179
+
; ptype_kind
180
+
; ptype_private
181
+
; ptype_manifest
182
+
; ptype_attributes
183
+
; ptype_jkind_annotation = None
184
+
; ptype_loc
185
+
}
186
+
;;
187
+
188
+
let extract_jkind_annotation _ = None
189
+
end
190
+
191
+
module Constant = struct
192
+
type t =
193
+
| Pconst_integer of string * char option
194
+
| Pconst_unboxed_integer of string * char
195
+
| Pconst_char of char
196
+
| Pconst_untagged_char of char
197
+
| Pconst_string of string * Location.t * string option
198
+
| Pconst_float of string * char option
199
+
| Pconst_unboxed_float of string * char option
200
+
201
+
let of_parsetree : constant -> t = function
202
+
| Pconst_integer (a, b) -> Pconst_integer (a, b)
203
+
| Pconst_char a -> Pconst_char a
204
+
| Pconst_string (a, b, c) -> Pconst_string (a, b, c)
205
+
| Pconst_float (a, b) -> Pconst_float (a, b)
206
+
;;
207
+
208
+
let to_parsetree : t -> constant = function
209
+
| Pconst_integer (a, b) -> Pconst_integer (a, b)
210
+
| Pconst_char a -> Pconst_char a
211
+
| Pconst_string (a, b, c) -> Pconst_string (a, b, c)
212
+
| Pconst_float (a, b) -> Pconst_float (a, b)
213
+
(* Unboxed literal constants erase to boxed literals. *)
214
+
| Pconst_unboxed_integer (a, b) -> Pconst_integer (a, Some b)
215
+
| Pconst_unboxed_float (a, b) -> Pconst_float (a, b)
216
+
| Pconst_untagged_char a -> Pconst_char a
217
+
;;
218
+
end
219
+
220
+
module Pexp_function = struct
221
+
type function_param_desc =
222
+
| Pparam_val of arg_label * expression option * pattern
223
+
| Pparam_newtype of string loc * jkind_annotation option
224
+
225
+
type function_param =
226
+
{ pparam_loc : Location.t
227
+
; pparam_desc : function_param_desc
228
+
}
229
+
230
+
type type_constraint =
231
+
| Pconstraint of core_type
232
+
| Pcoerce of core_type option * core_type
233
+
234
+
module Function_constraint = struct
235
+
type t =
236
+
{ mode_annotations : Modes.t
237
+
; ret_mode_annotations : Modes.t
238
+
; ret_type_constraint : type_constraint option
239
+
}
240
+
241
+
let none =
242
+
{ mode_annotations = []; ret_mode_annotations = []; ret_type_constraint = None }
243
+
;;
244
+
245
+
let is_none { ret_mode_annotations; ret_type_constraint; _ } =
246
+
match ret_mode_annotations, ret_type_constraint with
247
+
| [], None -> true
248
+
| _, _ -> false
249
+
;;
250
+
end
251
+
252
+
type function_body =
253
+
| Pfunction_body of expression
254
+
| Pfunction_cases of case list * Location.t * attributes
255
+
256
+
let to_parsetree
257
+
~params
258
+
~constraint_:
259
+
({ mode_annotations = _; ret_mode_annotations = _; ret_type_constraint } :
260
+
Function_constraint.t)
261
+
~body
262
+
=
263
+
let body =
264
+
match body with
265
+
| Pfunction_body body -> body
266
+
| Pfunction_cases (cases, loc, pexp_attributes) ->
267
+
Ast_helper.Exp.function_ cases ~loc ~attrs:pexp_attributes
268
+
in
269
+
let body =
270
+
match ret_type_constraint with
271
+
| None -> body
272
+
| Some (Pconstraint ty) ->
273
+
let body_loc = { body.pexp_loc with loc_ghost = true } in
274
+
Ast_helper.Exp.constraint_ body ty ~loc:body_loc
275
+
| Some (Pcoerce (ty1, ty2)) ->
276
+
let body_loc = { body.pexp_loc with loc_ghost = true } in
277
+
Ast_helper.Exp.coerce body ty1 ty2 ~loc:body_loc
278
+
in
279
+
let fun_ =
280
+
ListLabels.fold_right params ~init:body ~f:(fun param body ->
281
+
let loc : Location.t =
282
+
{ loc_start = param.pparam_loc.loc_start
283
+
; loc_end = body.pexp_loc.loc_end
284
+
; loc_ghost = true
285
+
}
286
+
in
287
+
match param.pparam_desc with
288
+
| Pparam_val (lbl, eo, pat) -> Ast_helper.Exp.fun_ lbl eo pat body ~loc
289
+
| Pparam_newtype (newtype, _) -> Ast_helper.Exp.newtype newtype body ~loc)
290
+
in
291
+
fun_.pexp_desc
292
+
;;
293
+
294
+
let of_parsetree =
295
+
let body_of_parsetree body =
296
+
match body.pexp_desc with
297
+
| Pexp_function cases -> Pfunction_cases (cases, body.pexp_loc, body.pexp_attributes)
298
+
| _ -> Pfunction_body body
299
+
in
300
+
let finish ~rev_params ~constraint_ ~body =
301
+
let body = body_of_parsetree body in
302
+
match rev_params, constraint_, body with
303
+
| [], _, Pfunction_body _ -> None
304
+
| [], Some _, Pfunction_cases _ -> None
305
+
| rev_params, constraint_, body ->
306
+
let constraint_ : Function_constraint.t =
307
+
{ Function_constraint.none with ret_type_constraint = constraint_ }
308
+
in
309
+
Some (List.rev rev_params, constraint_, body)
310
+
in
311
+
let rec loop_expr_desc expr_desc ~rev_params ~containing_expr =
312
+
match expr_desc with
313
+
| Pexp_newtype (ty, body) ->
314
+
loop_expr
315
+
body
316
+
~rev_params:
317
+
({ pparam_loc = ty.loc; pparam_desc = Pparam_newtype (ty, None) }
318
+
:: rev_params)
319
+
| Pexp_fun (lbl, eo, pat, body) ->
320
+
loop_expr
321
+
body
322
+
~rev_params:
323
+
({ pparam_loc = pat.ppat_loc; pparam_desc = Pparam_val (lbl, eo, pat) }
324
+
:: rev_params)
325
+
| Pexp_constraint (body, ty) ->
326
+
finish ~rev_params ~constraint_:(Some (Pconstraint ty)) ~body
327
+
| _ ->
328
+
(match containing_expr with
329
+
| None -> None
330
+
| Some body -> finish ~rev_params ~constraint_:None ~body)
331
+
and loop_expr expr ~rev_params =
332
+
match expr.pexp_attributes with
333
+
| _ :: _ -> finish ~rev_params ~constraint_:None ~body:expr
334
+
| [] -> loop_expr_desc expr.pexp_desc ~rev_params ~containing_expr:(Some expr)
335
+
in
336
+
fun expr_desc ~loc ->
337
+
match expr_desc with
338
+
| Pexp_function cases ->
339
+
Some ([], Function_constraint.none, Pfunction_cases (cases, loc, []))
340
+
| _ -> loop_expr_desc expr_desc ~rev_params:[] ~containing_expr:None
341
+
;;
342
+
end
343
+
344
+
let ptyp_any =
345
+
{ ptyp_desc = Ptyp_any
346
+
; ptyp_loc = Location.none
347
+
; ptyp_loc_stack = []
348
+
; ptyp_attributes = []
349
+
}
350
+
;;
351
+
352
+
let add_none_labels l = List.map (fun x -> None, x) l
353
+
354
+
(* Duplicated from [common.ml] to avoid dependency cycle *)
355
+
let as_unlabeled_tuple components =
356
+
if List.for_all (fun (label, _) -> Option.is_none label) components
357
+
then Some (List.map snd components)
358
+
else None
359
+
;;
360
+
361
+
let as_unlabeled_tuple_unconditionally components = List.map snd components
362
+
363
+
type index_kind =
364
+
| Index_int
365
+
| Index_unboxed_int64
366
+
| Index_unboxed_int32
367
+
| Index_unboxed_int16
368
+
| Index_unboxed_int8
369
+
| Index_unboxed_nativeint
370
+
371
+
type block_access =
372
+
| Baccess_field of Longident.t loc
373
+
| Baccess_array of mutable_flag * index_kind * expression
374
+
| Baccess_block of mutable_flag * expression
375
+
376
+
type unboxed_access = Uaccess_unboxed_field of Longident.t loc
377
+
378
+
module Core_type_desc = struct
379
+
type t =
380
+
| Ptyp_any of jkind_annotation option
381
+
| Ptyp_var of string * jkind_annotation option
382
+
| Ptyp_arrow of arg_label * core_type * core_type * Modes.t * Modes.t
383
+
| Ptyp_tuple of (string option * core_type) list
384
+
| Ptyp_unboxed_tuple of (string option * core_type) list
385
+
| Ptyp_constr of Longident.t loc * core_type list
386
+
| Ptyp_object of object_field list * closed_flag
387
+
| Ptyp_class of Longident.t loc * core_type list
388
+
| Ptyp_alias of core_type * string loc option * jkind_annotation option
389
+
| Ptyp_variant of row_field list * closed_flag * label list option
390
+
| Ptyp_poly of (string loc * jkind_annotation option) list * core_type
391
+
| Ptyp_package of package_type
392
+
| Ptyp_quote of core_type
393
+
| Ptyp_splice of core_type
394
+
| Ptyp_of_kind of jkind_annotation
395
+
| Ptyp_extension of extension
396
+
397
+
let of_parsetree : core_type_desc -> t = function
398
+
(* changed constructors *)
399
+
| Ptyp_arrow (a, b, c) -> Ptyp_arrow (a, b, c, [], [])
400
+
| Ptyp_tuple a -> Ptyp_tuple (add_none_labels a)
401
+
| Ptyp_any -> Ptyp_any None
402
+
| Ptyp_var s -> Ptyp_var (s, None)
403
+
| Ptyp_alias (a, b) ->
404
+
let ghost_alias_loc = { a.ptyp_loc with loc_ghost = true } in
405
+
Ptyp_alias (a, Some { txt = b; loc = ghost_alias_loc }, None)
406
+
| Ptyp_poly (a, b) -> Ptyp_poly (List.map (fun x -> x, None) a, b)
407
+
(* unchanged constructors *)
408
+
| Ptyp_constr (a, b) -> Ptyp_constr (a, b)
409
+
| Ptyp_object (a, b) -> Ptyp_object (a, b)
410
+
| Ptyp_class (a, b) -> Ptyp_class (a, b)
411
+
| Ptyp_variant (a, b, c) -> Ptyp_variant (a, b, c)
412
+
| Ptyp_package a -> Ptyp_package a
413
+
| Ptyp_extension a -> Ptyp_extension a
414
+
;;
415
+
416
+
let fresh_name =
417
+
let r = ref 0 in
418
+
fun name ->
419
+
let i = !r in
420
+
incr r;
421
+
name ^ string_of_int i
422
+
;;
423
+
424
+
let to_parsetree : t -> core_type_desc = function
425
+
(* changed constructors *)
426
+
| Ptyp_arrow (a, b, c, _, _) -> Ptyp_arrow (a, b, c)
427
+
| Ptyp_any (_ : jkind_annotation option) -> Ptyp_any
428
+
| Ptyp_var (s, _) -> Ptyp_var s
429
+
| Ptyp_poly (a, b) -> Ptyp_poly (List.map fst a, b)
430
+
| Ptyp_alias (a, Some b, _) -> Ptyp_alias (a, b.txt)
431
+
| Ptyp_alias (a, None, _) -> Ptyp_alias (a, fresh_name "_alias")
432
+
| Ptyp_tuple labeled_typs ->
433
+
Ptyp_tuple (as_unlabeled_tuple_unconditionally labeled_typs)
434
+
(* new constructors *)
435
+
| Ptyp_unboxed_tuple labeled_typs ->
436
+
Ptyp_tuple (as_unlabeled_tuple_unconditionally labeled_typs)
437
+
| Ptyp_of_kind _ -> failwith "[Ptyp_of_kind] unimplemented in ppxlib_jane"
438
+
(* unchanged constructors *)
439
+
| Ptyp_constr (a, b) -> Ptyp_constr (a, b)
440
+
| Ptyp_object (a, b) -> Ptyp_object (a, b)
441
+
| Ptyp_class (a, b) -> Ptyp_class (a, b)
442
+
| Ptyp_variant (a, b, c) -> Ptyp_variant (a, b, c)
443
+
| Ptyp_quote _ -> failwith "[Ptyp_quote] unimplemented in ppxlib_jane"
444
+
| Ptyp_splice _ -> failwith "[Ptyp_splice] unimplemented in ppxlib_jane"
445
+
| Ptyp_package a -> Ptyp_package a
446
+
| Ptyp_extension a -> Ptyp_extension a
447
+
;;
448
+
end
449
+
450
+
module Core_type = struct
451
+
type t =
452
+
{ ptyp_desc : Core_type_desc.t
453
+
; ptyp_loc : Location.t
454
+
; ptyp_loc_stack : Location.t list
455
+
; ptyp_attributes : attributes
456
+
}
457
+
458
+
let of_parsetree
459
+
{ Ppxlib_ast.Parsetree.ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes }
460
+
=
461
+
let ptyp_desc = Core_type_desc.of_parsetree ptyp_desc in
462
+
{ ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes }
463
+
;;
464
+
465
+
let to_parsetree { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } =
466
+
let ptyp_desc = Core_type_desc.to_parsetree ptyp_desc in
467
+
{ Ppxlib_ast.Parsetree.ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes }
468
+
;;
469
+
end
470
+
471
+
module Pattern_desc = struct
472
+
type t =
473
+
| Ppat_any
474
+
| Ppat_var of string loc
475
+
| Ppat_alias of pattern * string loc
476
+
| Ppat_constant of constant
477
+
| Ppat_interval of constant * constant
478
+
| Ppat_tuple of (string option * pattern) list * closed_flag
479
+
| Ppat_unboxed_tuple of (string option * pattern) list * closed_flag
480
+
| Ppat_construct of
481
+
Longident.t loc * ((string loc * jkind_annotation option) list * pattern) option
482
+
| Ppat_variant of label * pattern option
483
+
| Ppat_record of (Longident.t loc * pattern) list * closed_flag
484
+
| Ppat_record_unboxed_product of (Longident.t loc * pattern) list * closed_flag
485
+
| Ppat_array of mutable_flag * pattern list
486
+
| Ppat_or of pattern * pattern
487
+
| Ppat_constraint of pattern * core_type option * Modes.t
488
+
| Ppat_type of Longident.t loc
489
+
| Ppat_lazy of pattern
490
+
| Ppat_unpack of string option loc
491
+
| Ppat_exception of pattern
492
+
| Ppat_extension of extension
493
+
| Ppat_open of Longident.t loc * pattern
494
+
495
+
let of_parsetree : pattern_desc -> t = function
496
+
(* changed constructors *)
497
+
| Ppat_constraint (a, b) -> Ppat_constraint (a, Some b, [])
498
+
| Ppat_tuple a -> Ppat_tuple (add_none_labels a, Closed)
499
+
| Ppat_construct (a, b) ->
500
+
let b =
501
+
Option.map (fun (vars, pattern) -> List.map (fun s -> s, None) vars, pattern) b
502
+
in
503
+
Ppat_construct (a, b)
504
+
(* unchanged constructors *)
505
+
| Ppat_any -> Ppat_any
506
+
| Ppat_var a -> Ppat_var a
507
+
| Ppat_alias (a, b) -> Ppat_alias (a, b)
508
+
| Ppat_constant a -> Ppat_constant a
509
+
| Ppat_interval (a, b) -> Ppat_interval (a, b)
510
+
| Ppat_variant (a, b) -> Ppat_variant (a, b)
511
+
| Ppat_record (a, b) -> Ppat_record (a, b)
512
+
| Ppat_array a -> Ppat_array (Mutable, a)
513
+
| Ppat_or (a, b) -> Ppat_or (a, b)
514
+
| Ppat_type a -> Ppat_type a
515
+
| Ppat_lazy a -> Ppat_lazy a
516
+
| Ppat_unpack a -> Ppat_unpack a
517
+
| Ppat_exception a -> Ppat_exception a
518
+
| Ppat_extension a -> Ppat_extension a
519
+
| Ppat_open (a, b) -> Ppat_open (a, b)
520
+
;;
521
+
522
+
let to_parsetree : loc:Location.t -> t -> pattern_desc =
523
+
fun ~loc -> function
524
+
(* changed constructors *)
525
+
| Ppat_constraint (a, Some b, _) -> Ppat_constraint (a, b)
526
+
| Ppat_constraint (a, None, _) -> Ppat_constraint (a, ptyp_any)
527
+
| Ppat_tuple (_, Open) ->
528
+
Location.raise_errorf
529
+
~loc
530
+
"[Ppat_tuple] with an \"open\" pattern cannot be converted to an upstream \
531
+
[pattern_desc]"
532
+
| Ppat_tuple (labeled_pats, Closed) ->
533
+
(match as_unlabeled_tuple labeled_pats with
534
+
| Some pats -> Ppat_tuple pats
535
+
| None ->
536
+
failwith
537
+
"[Ppat_tuple], when labels are present, cannot be converted to an upstream \
538
+
[pattern_desc]")
539
+
| Ppat_array (Mutable, a) -> Ppat_array a
540
+
| Ppat_array (Immutable, _) ->
541
+
Location.raise_errorf
542
+
~loc
543
+
"Immutable [Ppat_array] cannot be converted to an usptream [pattern_desc]"
544
+
(* new constructors *)
545
+
| Ppat_unboxed_tuple (_, Open) ->
546
+
Location.raise_errorf
547
+
~loc
548
+
"[Ppat_unboxed_tuple] with an \"open\" pattern cannot be converted to an \
549
+
upstream [pattern_desc]"
550
+
| Ppat_unboxed_tuple (labeled_pats, Closed) ->
551
+
(match as_unlabeled_tuple labeled_pats with
552
+
| Some pats -> Ppat_tuple pats
553
+
| None ->
554
+
failwith
555
+
"[Ppat_unboxed_tuple], when labels are present, cannot be converted to an \
556
+
upstream [pattern_desc]")
557
+
| Ppat_record_unboxed_product (a, b) -> Ppat_record (a, b)
558
+
| Ppat_construct (a, b) ->
559
+
let b =
560
+
Option.map
561
+
(fun (vars, p) ->
562
+
let vars = List.map (fun (var, (_ : jkind_annotation option)) -> var) vars in
563
+
vars, p)
564
+
b
565
+
in
566
+
Ppat_construct (a, b)
567
+
(* unchanged constructors *)
568
+
| Ppat_any -> Ppat_any
569
+
| Ppat_var a -> Ppat_var a
570
+
| Ppat_alias (a, b) -> Ppat_alias (a, b)
571
+
| Ppat_constant a -> Ppat_constant a
572
+
| Ppat_interval (a, b) -> Ppat_interval (a, b)
573
+
| Ppat_variant (a, b) -> Ppat_variant (a, b)
574
+
| Ppat_record (a, b) -> Ppat_record (a, b)
575
+
| Ppat_or (a, b) -> Ppat_or (a, b)
576
+
| Ppat_type a -> Ppat_type a
577
+
| Ppat_lazy a -> Ppat_lazy a
578
+
| Ppat_unpack a -> Ppat_unpack a
579
+
| Ppat_exception a -> Ppat_exception a
580
+
| Ppat_extension a -> Ppat_extension a
581
+
| Ppat_open (a, b) -> Ppat_open (a, b)
582
+
;;
583
+
end
584
+
585
+
module Expression_desc = struct
586
+
type comprehension_expression = private
587
+
| Pcomp_list_comprehension of unit
588
+
| Pcomp_array_comprehension of unit
589
+
590
+
type t =
591
+
| Pexp_ident of Longident.t loc
592
+
| Pexp_constant of constant
593
+
| Pexp_let of mutable_flag * rec_flag * value_binding list * expression
594
+
| Pexp_function of
595
+
Pexp_function.function_param list
596
+
* Pexp_function.Function_constraint.t
597
+
* Pexp_function.function_body
598
+
| Pexp_apply of expression * (arg_label * expression) list
599
+
| Pexp_match of expression * case list
600
+
| Pexp_try of expression * case list
601
+
| Pexp_tuple of (string option * expression) list
602
+
| Pexp_unboxed_tuple of (string option * expression) list
603
+
| Pexp_construct of Longident.t loc * expression option
604
+
| Pexp_variant of label * expression option
605
+
| Pexp_record of (Longident.t loc * expression) list * expression option
606
+
| Pexp_record_unboxed_product of
607
+
(Longident.t loc * expression) list * expression option
608
+
| Pexp_field of expression * Longident.t loc
609
+
| Pexp_unboxed_field of expression * Longident.t loc
610
+
| Pexp_setfield of expression * Longident.t loc * expression
611
+
| Pexp_array of mutable_flag * expression list
612
+
| Pexp_idx of block_access * unboxed_access list
613
+
| Pexp_ifthenelse of expression * expression * expression option
614
+
| Pexp_sequence of expression * expression
615
+
| Pexp_while of expression * expression
616
+
| Pexp_for of pattern * expression * expression * direction_flag * expression
617
+
| Pexp_constraint of expression * core_type option * Modes.t
618
+
| Pexp_coerce of expression * core_type option * core_type
619
+
| Pexp_send of expression * label loc
620
+
| Pexp_new of Longident.t loc
621
+
| Pexp_setvar of label loc * expression
622
+
| Pexp_override of (label loc * expression) list
623
+
| Pexp_letmodule of string option loc * module_expr * expression
624
+
| Pexp_letexception of extension_constructor * expression
625
+
| Pexp_assert of expression
626
+
| Pexp_lazy of expression
627
+
| Pexp_poly of expression * core_type option
628
+
| Pexp_object of class_structure
629
+
| Pexp_newtype of string loc * jkind_annotation option * expression
630
+
| Pexp_pack of module_expr
631
+
| Pexp_open of open_declaration * expression
632
+
| Pexp_letop of letop
633
+
| Pexp_extension of extension
634
+
| Pexp_unreachable
635
+
| Pexp_stack of expression
636
+
| Pexp_comprehension of comprehension_expression
637
+
| Pexp_overwrite of expression * expression
638
+
| Pexp_quote of expression
639
+
| Pexp_splice of expression
640
+
| Pexp_hole
641
+
642
+
let to_parsetree : loc:Location.t -> t -> expression_desc =
643
+
fun ~loc -> function
644
+
(* changed constructors *)
645
+
| Pexp_function (x1, x2, x3) ->
646
+
Pexp_function.to_parsetree ~params:x1 ~constraint_:x2 ~body:x3
647
+
| Pexp_constraint (x1, Some x2, _) -> Pexp_constraint (x1, x2)
648
+
| Pexp_constraint (x1, None, _) -> Pexp_constraint (x1, ptyp_any)
649
+
| Pexp_tuple labeled_exps ->
650
+
Pexp_tuple (as_unlabeled_tuple_unconditionally labeled_exps)
651
+
| Pexp_newtype (x1, _, x2) -> Pexp_newtype (x1, x2)
652
+
| Pexp_array (Mutable, x) -> Pexp_array x
653
+
| Pexp_array (Immutable, _) ->
654
+
Location.raise_errorf
655
+
~loc
656
+
"Immutable [Pexp_array] cannot be converted to an upstream [expression_desc]"
657
+
| Pexp_record_unboxed_product (x1, x2) -> Pexp_record (x1, x2)
658
+
| Pexp_unboxed_field (x1, x2) -> Pexp_field (x1, x2)
659
+
(* new constructors *)
660
+
| Pexp_unboxed_tuple labeled_exps ->
661
+
Pexp_tuple (as_unlabeled_tuple_unconditionally labeled_exps)
662
+
| Pexp_idx _ ->
663
+
Location.raise_errorf
664
+
~loc
665
+
"[Pexp_idx] cannot be converted to an upstream [expression_desc]"
666
+
(* unchanged constructors *)
667
+
| Pexp_ident x -> Pexp_ident x
668
+
| Pexp_constant x -> Pexp_constant x
669
+
| Pexp_let (Immutable, x1, x2, x3) -> Pexp_let (x1, x2, x3)
670
+
| Pexp_let (Mutable, _, _, _) ->
671
+
Location.raise_errorf
672
+
~loc
673
+
"Mutable [Pexp_let] cannot be converted to an upstream [expression_desc]"
674
+
| Pexp_apply (x1, x2) -> Pexp_apply (x1, x2)
675
+
| Pexp_match (x1, x2) -> Pexp_match (x1, x2)
676
+
| Pexp_try (x1, x2) -> Pexp_try (x1, x2)
677
+
| Pexp_construct (x1, x2) -> Pexp_construct (x1, x2)
678
+
| Pexp_variant (x1, x2) -> Pexp_variant (x1, x2)
679
+
| Pexp_record (x1, x2) -> Pexp_record (x1, x2)
680
+
| Pexp_field (x1, x2) -> Pexp_field (x1, x2)
681
+
| Pexp_setfield (x1, x2, x3) -> Pexp_setfield (x1, x2, x3)
682
+
| Pexp_ifthenelse (x1, x2, x3) -> Pexp_ifthenelse (x1, x2, x3)
683
+
| Pexp_sequence (x1, x2) -> Pexp_sequence (x1, x2)
684
+
| Pexp_while (x1, x2) -> Pexp_while (x1, x2)
685
+
| Pexp_for (x1, x2, x3, x4, x5) -> Pexp_for (x1, x2, x3, x4, x5)
686
+
| Pexp_coerce (x1, x2, x3) -> Pexp_coerce (x1, x2, x3)
687
+
| Pexp_send (x1, x2) -> Pexp_send (x1, x2)
688
+
| Pexp_new x -> Pexp_new x
689
+
| Pexp_setvar (x1, x2) -> Pexp_setinstvar (x1, x2)
690
+
| Pexp_override x -> Pexp_override x
691
+
| Pexp_letmodule (x1, x2, x3) -> Pexp_letmodule (x1, x2, x3)
692
+
| Pexp_letexception (x1, x2) -> Pexp_letexception (x1, x2)
693
+
| Pexp_assert x -> Pexp_assert x
694
+
| Pexp_lazy x -> Pexp_lazy x
695
+
| Pexp_poly (x1, x2) -> Pexp_poly (x1, x2)
696
+
| Pexp_object x -> Pexp_object x
697
+
| Pexp_pack x -> Pexp_pack x
698
+
| Pexp_open (x1, x2) -> Pexp_open (x1, x2)
699
+
| Pexp_letop x -> Pexp_letop x
700
+
| Pexp_extension x -> Pexp_extension x
701
+
| Pexp_unreachable -> Pexp_unreachable
702
+
| Pexp_stack { pexp_desc; pexp_attributes; pexp_loc = _; pexp_loc_stack = _ } ->
703
+
(match pexp_attributes with
704
+
| [] -> pexp_desc
705
+
| _ :: _ ->
706
+
Location.raise_errorf
707
+
~loc
708
+
"[Pexp_stack] cannot be converted to an upstream [expression_desc] without \
709
+
erasing attributes")
710
+
| Pexp_comprehension _ ->
711
+
Location.raise_errorf
712
+
~loc
713
+
"[Pexp_comprehension] cannot be converted to an upstream [expression_desc]"
714
+
| Pexp_overwrite _ ->
715
+
Location.raise_errorf
716
+
~loc
717
+
"[Pexp_overwrite] cannot be converted to an upstream [expression_desc]"
718
+
| Pexp_quote _ ->
719
+
Location.raise_errorf
720
+
~loc
721
+
"[Pexp_quote] cannot be converted to an upstream [expression_desc]"
722
+
| Pexp_splice _ ->
723
+
Location.raise_errorf
724
+
~loc
725
+
"[Pexp_slice] cannot be converted to an upstream [expression_desc]"
726
+
| Pexp_hole ->
727
+
Pexp_assert
728
+
{ pexp_desc = Pexp_construct ({ loc; txt = Lident "false" }, None)
729
+
; pexp_loc = loc
730
+
; pexp_loc_stack = []
731
+
; pexp_attributes = []
732
+
}
733
+
;;
734
+
735
+
let of_parsetree (expr_desc : expression_desc) ~loc : t =
736
+
(* changed constructors *)
737
+
match Pexp_function.of_parsetree expr_desc ~loc with
738
+
| Some (x1, x2, x3) -> Pexp_function (x1, x2, x3)
739
+
| None ->
740
+
(match expr_desc with
741
+
| Pexp_function _ | Pexp_fun _ ->
742
+
(* matched by above call to [of_parsetree] *)
743
+
assert false
744
+
| Pexp_constraint (x1, x2) -> Pexp_constraint (x1, Some x2, [])
745
+
| Pexp_tuple x -> Pexp_tuple (add_none_labels x)
746
+
| Pexp_newtype (x1, x2) -> Pexp_newtype (x1, None, x2)
747
+
| Pexp_array x -> Pexp_array (Mutable, x)
748
+
(* unchanged constructors *)
749
+
| Pexp_ident x -> Pexp_ident x
750
+
| Pexp_constant x -> Pexp_constant x
751
+
| Pexp_let (x1, x2, x3) -> Pexp_let (Immutable, x1, x2, x3)
752
+
| Pexp_apply (x1, x2) -> Pexp_apply (x1, x2)
753
+
| Pexp_match (x1, x2) -> Pexp_match (x1, x2)
754
+
| Pexp_try (x1, x2) -> Pexp_try (x1, x2)
755
+
| Pexp_construct (x1, x2) -> Pexp_construct (x1, x2)
756
+
| Pexp_variant (x1, x2) -> Pexp_variant (x1, x2)
757
+
| Pexp_record (x1, x2) -> Pexp_record (x1, x2)
758
+
| Pexp_field (x1, x2) -> Pexp_field (x1, x2)
759
+
| Pexp_setfield (x1, x2, x3) -> Pexp_setfield (x1, x2, x3)
760
+
| Pexp_ifthenelse (x1, x2, x3) -> Pexp_ifthenelse (x1, x2, x3)
761
+
| Pexp_sequence (x1, x2) -> Pexp_sequence (x1, x2)
762
+
| Pexp_while (x1, x2) -> Pexp_while (x1, x2)
763
+
| Pexp_for (x1, x2, x3, x4, x5) -> Pexp_for (x1, x2, x3, x4, x5)
764
+
| Pexp_coerce (x1, x2, x3) -> Pexp_coerce (x1, x2, x3)
765
+
| Pexp_send (x1, x2) -> Pexp_send (x1, x2)
766
+
| Pexp_new x -> Pexp_new x
767
+
| Pexp_setinstvar (x1, x2) -> Pexp_setvar (x1, x2)
768
+
| Pexp_override x -> Pexp_override x
769
+
| Pexp_letmodule (x1, x2, x3) -> Pexp_letmodule (x1, x2, x3)
770
+
| Pexp_letexception (x1, x2) -> Pexp_letexception (x1, x2)
771
+
| Pexp_assert x -> Pexp_assert x
772
+
| Pexp_lazy x -> Pexp_lazy x
773
+
| Pexp_poly (x1, x2) -> Pexp_poly (x1, x2)
774
+
| Pexp_object x -> Pexp_object x
775
+
| Pexp_pack x -> Pexp_pack x
776
+
| Pexp_open (x1, x2) -> Pexp_open (x1, x2)
777
+
| Pexp_letop x -> Pexp_letop x
778
+
| Pexp_extension x -> Pexp_extension x
779
+
| Pexp_unreachable -> Pexp_unreachable)
780
+
;;
781
+
end
782
+
783
+
module Type_kind = struct
784
+
type t =
785
+
| Ptype_abstract
786
+
| Ptype_variant of constructor_declaration list
787
+
| Ptype_record of label_declaration list
788
+
| Ptype_record_unboxed_product of label_declaration list
789
+
| Ptype_open
790
+
791
+
let of_parsetree : type_kind -> t = function
792
+
| Ptype_abstract -> Ptype_abstract
793
+
| Ptype_variant x -> Ptype_variant x
794
+
| Ptype_record x -> Ptype_record x
795
+
| Ptype_open -> Ptype_open
796
+
;;
797
+
798
+
let to_parsetree : t -> type_kind = function
799
+
| Ptype_abstract -> Ptype_abstract
800
+
| Ptype_variant x -> Ptype_variant x
801
+
| Ptype_record x -> Ptype_record x
802
+
| Ptype_record_unboxed_product x -> Ptype_record x
803
+
| Ptype_open -> Ptype_open
804
+
;;
805
+
end
806
+
807
+
module Constructor_declaration = struct
808
+
let extract_vars_with_jkind_annotations cd = List.map (fun s -> s, None) cd.pcd_vars
809
+
810
+
let create ~name ~vars ~args ~res ~loc =
811
+
{ pcd_name = name
812
+
; pcd_vars = List.map fst vars
813
+
; pcd_args = args
814
+
; pcd_res = res
815
+
; pcd_loc = loc
816
+
; pcd_attributes = []
817
+
}
818
+
;;
819
+
end
820
+
821
+
module Include_infos = struct
822
+
type 'a t =
823
+
{ pincl_kind : Include_kind.t
824
+
; pincl_mod : 'a
825
+
; pincl_loc : Location.t
826
+
; pincl_attributes : attributes
827
+
}
828
+
829
+
let of_parsetree x : 'a t =
830
+
let ({ pincl_mod; pincl_loc; pincl_attributes } : 'a include_infos) = x in
831
+
let pincl_kind : Include_kind.t = Structure in
832
+
{ pincl_kind; pincl_mod; pincl_loc; pincl_attributes }
833
+
;;
834
+
835
+
let to_parsetree x : 'a include_infos =
836
+
let ({ pincl_kind; pincl_mod; pincl_loc; pincl_attributes } : 'a t) = x in
837
+
match pincl_kind with
838
+
| Structure -> { pincl_mod; pincl_loc; pincl_attributes }
839
+
| Functor ->
840
+
Location.raise_errorf
841
+
~loc:pincl_loc
842
+
"[include functor] cannot be converted to an upstream [include_infos]"
843
+
;;
844
+
end
845
+
846
+
module Signature_item_desc = struct
847
+
type t =
848
+
| Psig_value of value_description
849
+
| Psig_type of rec_flag * type_declaration list
850
+
| Psig_typesubst of type_declaration list
851
+
| Psig_typext of type_extension
852
+
| Psig_exception of type_exception
853
+
| Psig_module of module_declaration
854
+
| Psig_modsubst of module_substitution
855
+
| Psig_recmodule of module_declaration list
856
+
| Psig_modtype of module_type_declaration
857
+
| Psig_modtypesubst of module_type_declaration
858
+
| Psig_open of open_description
859
+
| Psig_include of include_description * Modalities.t
860
+
| Psig_class of class_description list
861
+
| Psig_class_type of class_type_declaration list
862
+
| Psig_attribute of attribute
863
+
| Psig_extension of extension * attributes
864
+
| Psig_kind_abbrev of string loc * jkind_annotation
865
+
866
+
let of_parsetree (sig_desc : signature_item_desc) =
867
+
match sig_desc with
868
+
| Psig_value a -> Psig_value a
869
+
| Psig_type (a, b) -> Psig_type (a, b)
870
+
| Psig_typesubst a -> Psig_typesubst a
871
+
| Psig_typext a -> Psig_typext a
872
+
| Psig_exception a -> Psig_exception a
873
+
| Psig_module a -> Psig_module a
874
+
| Psig_modsubst a -> Psig_modsubst a
875
+
| Psig_recmodule a -> Psig_recmodule a
876
+
| Psig_modtype a -> Psig_modtype a
877
+
| Psig_modtypesubst a -> Psig_modtypesubst a
878
+
| Psig_open a -> Psig_open a
879
+
| Psig_include a -> Psig_include (a, [])
880
+
| Psig_class a -> Psig_class a
881
+
| Psig_class_type a -> Psig_class_type a
882
+
| Psig_attribute a -> Psig_attribute a
883
+
| Psig_extension (a, b) -> Psig_extension (a, b)
884
+
;;
885
+
886
+
let to_parsetree (t : t) : signature_item_desc =
887
+
match t with
888
+
| Psig_value a -> Psig_value a
889
+
| Psig_type (a, b) -> Psig_type (a, b)
890
+
| Psig_typesubst a -> Psig_typesubst a
891
+
| Psig_typext a -> Psig_typext a
892
+
| Psig_exception a -> Psig_exception a
893
+
| Psig_module a -> Psig_module a
894
+
| Psig_modsubst a -> Psig_modsubst a
895
+
| Psig_recmodule a -> Psig_recmodule a
896
+
| Psig_modtype a -> Psig_modtype a
897
+
| Psig_modtypesubst a -> Psig_modtypesubst a
898
+
| Psig_open a -> Psig_open a
899
+
| Psig_include (a, _) -> Psig_include a
900
+
| Psig_class a -> Psig_class a
901
+
| Psig_class_type a -> Psig_class_type a
902
+
| Psig_attribute a -> Psig_attribute a
903
+
| Psig_extension (a, b) -> Psig_extension (a, b)
904
+
| Psig_kind_abbrev _ ->
905
+
(* erase to [include sig end] *)
906
+
Psig_include
907
+
{ pincl_loc = Location.none
908
+
; pincl_attributes = []
909
+
; pincl_mod =
910
+
{ pmty_desc = Pmty_signature []
911
+
; pmty_loc = Location.none
912
+
; pmty_attributes = []
913
+
}
914
+
}
915
+
;;
916
+
end
917
+
918
+
module Signature = struct
919
+
type t =
920
+
{ psg_modalities : Modalities.t
921
+
; psg_items : signature_item list
922
+
; psg_loc : Location.t
923
+
}
924
+
925
+
let of_parsetree psg_items = { psg_items; psg_modalities = []; psg_loc = Location.none }
926
+
let to_parsetree { psg_items; psg_modalities = _; psg_loc = _ } = psg_items
927
+
end
928
+
929
+
module Structure_item_desc = struct
930
+
type t =
931
+
| Pstr_eval of expression * attributes
932
+
| Pstr_value of rec_flag * value_binding list
933
+
| Pstr_primitive of value_description
934
+
| Pstr_type of rec_flag * type_declaration list
935
+
| Pstr_typext of type_extension
936
+
| Pstr_exception of type_exception
937
+
| Pstr_module of module_binding
938
+
| Pstr_recmodule of module_binding list
939
+
| Pstr_modtype of module_type_declaration
940
+
| Pstr_open of open_declaration
941
+
| Pstr_class of class_declaration list
942
+
| Pstr_class_type of class_type_declaration list
943
+
| Pstr_include of include_declaration
944
+
| Pstr_attribute of attribute
945
+
| Pstr_extension of extension * attributes
946
+
| Pstr_kind_abbrev of string loc * jkind_annotation
947
+
948
+
let of_parsetree : structure_item_desc -> t = function
949
+
| Pstr_eval (a, b) -> Pstr_eval (a, b)
950
+
| Pstr_value (a, b) -> Pstr_value (a, b)
951
+
| Pstr_primitive a -> Pstr_primitive a
952
+
| Pstr_type (a, b) -> Pstr_type (a, b)
953
+
| Pstr_typext a -> Pstr_typext a
954
+
| Pstr_exception a -> Pstr_exception a
955
+
| Pstr_module a -> Pstr_module a
956
+
| Pstr_recmodule a -> Pstr_recmodule a
957
+
| Pstr_modtype a -> Pstr_modtype a
958
+
| Pstr_open a -> Pstr_open a
959
+
| Pstr_class a -> Pstr_class a
960
+
| Pstr_class_type a -> Pstr_class_type a
961
+
| Pstr_include a -> Pstr_include a
962
+
| Pstr_attribute a -> Pstr_attribute a
963
+
| Pstr_extension (a, b) -> Pstr_extension (a, b)
964
+
;;
965
+
966
+
let to_parsetree : t -> structure_item_desc = function
967
+
| Pstr_eval (a, b) -> Pstr_eval (a, b)
968
+
| Pstr_value (a, b) -> Pstr_value (a, b)
969
+
| Pstr_primitive a -> Pstr_primitive a
970
+
| Pstr_type (a, b) -> Pstr_type (a, b)
971
+
| Pstr_typext a -> Pstr_typext a
972
+
| Pstr_exception a -> Pstr_exception a
973
+
| Pstr_module a -> Pstr_module a
974
+
| Pstr_recmodule a -> Pstr_recmodule a
975
+
| Pstr_modtype a -> Pstr_modtype a
976
+
| Pstr_open a -> Pstr_open a
977
+
| Pstr_class a -> Pstr_class a
978
+
| Pstr_class_type a -> Pstr_class_type a
979
+
| Pstr_include a -> Pstr_include a
980
+
| Pstr_attribute a -> Pstr_attribute a
981
+
| Pstr_extension (a, b) -> Pstr_extension (a, b)
982
+
| Pstr_kind_abbrev _ ->
983
+
(* erase to [include struct end] *)
984
+
Pstr_include
985
+
{ pincl_loc = Location.none
986
+
; pincl_attributes = []
987
+
; pincl_mod =
988
+
{ pmod_desc = Pmod_structure []
989
+
; pmod_loc = Location.none
990
+
; pmod_attributes = []
991
+
}
992
+
}
993
+
;;
994
+
end
995
+
996
+
module Functor_parameter = struct
997
+
type t =
998
+
| Unit
999
+
| Named of string option loc * module_type * Modes.t
1000
+
1001
+
let to_parsetree (t : t) : functor_parameter =
1002
+
match t with
1003
+
| Unit -> Unit
1004
+
| Named (name, type_, _) -> Named (name, type_)
1005
+
;;
1006
+
1007
+
let of_parsetree (t : functor_parameter) : t =
1008
+
match t with
1009
+
| Unit -> Unit
1010
+
| Named (name, type_) -> Named (name, type_, [])
1011
+
;;
1012
+
end
1013
+
1014
+
module Module_type_desc = struct
1015
+
type t =
1016
+
| Pmty_ident of Longident.t loc
1017
+
| Pmty_signature of signature
1018
+
| Pmty_functor of functor_parameter * module_type * Modes.t
1019
+
| Pmty_with of module_type * with_constraint list
1020
+
| Pmty_typeof of module_expr
1021
+
| Pmty_extension of extension
1022
+
| Pmty_alias of Longident.t loc
1023
+
| Pmty_strengthen of module_type * Longident.t loc
1024
+
1025
+
let of_parsetree : module_type_desc -> t = function
1026
+
| Pmty_ident x -> Pmty_ident x
1027
+
| Pmty_signature x -> Pmty_signature x
1028
+
| Pmty_functor (x0, x1) -> Pmty_functor (x0, x1, [])
1029
+
| Pmty_with (x0, x1) -> Pmty_with (x0, x1)
1030
+
| Pmty_typeof x -> Pmty_typeof x
1031
+
| Pmty_extension x -> Pmty_extension x
1032
+
| Pmty_alias x -> Pmty_alias x
1033
+
;;
1034
+
1035
+
let to_parsetree : loc:Location.t -> t -> module_type_desc =
1036
+
fun ~loc -> function
1037
+
(* new constructors *)
1038
+
| Pmty_strengthen _ ->
1039
+
Location.raise_errorf
1040
+
~loc
1041
+
"[Pmty_strengthen] cannot be converted to an upstream [module_type_desc]"
1042
+
(* unchanged constructors *)
1043
+
| Pmty_ident x -> Pmty_ident x
1044
+
| Pmty_signature x -> Pmty_signature x
1045
+
| Pmty_functor (x0, x1, _) -> Pmty_functor (x0, x1)
1046
+
| Pmty_with (x0, x1) -> Pmty_with (x0, x1)
1047
+
| Pmty_typeof x -> Pmty_typeof x
1048
+
| Pmty_extension x -> Pmty_extension x
1049
+
| Pmty_alias x -> Pmty_alias x
1050
+
;;
1051
+
end
1052
+
1053
+
module Module_expr_desc = struct
1054
+
type module_instance = private Module_instance
1055
+
1056
+
type t =
1057
+
| Pmod_ident of Longident.t loc
1058
+
| Pmod_structure of structure
1059
+
| Pmod_functor of functor_parameter * module_expr
1060
+
| Pmod_apply of module_expr * module_expr
1061
+
| Pmod_constraint of module_expr * module_type option * Modes.t
1062
+
| Pmod_unpack of expression
1063
+
| Pmod_extension of extension
1064
+
| Pmod_instance of module_instance
1065
+
1066
+
let of_parsetree : module_expr_desc -> t = function
1067
+
| Pmod_ident x -> Pmod_ident x
1068
+
| Pmod_structure x -> Pmod_structure x
1069
+
| Pmod_functor (x0, x1) -> Pmod_functor (x0, x1)
1070
+
| Pmod_apply (x0, x1) -> Pmod_apply (x0, x1)
1071
+
| Pmod_constraint (x0, x1) -> Pmod_constraint (x0, Some x1, [])
1072
+
| Pmod_unpack x -> Pmod_unpack x
1073
+
| Pmod_extension x -> Pmod_extension x
1074
+
;;
1075
+
1076
+
let to_parsetree : loc:Location.t -> t -> module_expr_desc =
1077
+
fun ~loc -> function
1078
+
(* new constructors *)
1079
+
| Pmod_instance _ ->
1080
+
Location.raise_errorf
1081
+
~loc
1082
+
"[Pmod_instance] cannot be converted to an upstream [module_expr_desc]"
1083
+
(* unchanged constructors *)
1084
+
| Pmod_ident x -> Pmod_ident x
1085
+
| Pmod_structure x -> Pmod_structure x
1086
+
| Pmod_functor (x0, x1) -> Pmod_functor (x0, x1)
1087
+
| Pmod_apply (x0, x1) -> Pmod_apply (x0, x1)
1088
+
| Pmod_constraint (x0, x1, _) ->
1089
+
(match x1 with
1090
+
| Some x1 -> Pmod_constraint (x0, x1)
1091
+
| None ->
1092
+
(match x0 with
1093
+
| { pmod_desc; pmod_loc = _; pmod_attributes = [] } -> pmod_desc
1094
+
| { pmod_attributes = _ :: _; _ } ->
1095
+
Location.raise_errorf
1096
+
~loc
1097
+
"[Pmod_constraint] without type cannot be converted to an upstream \
1098
+
[module_expr_desc] without erasing attributes"))
1099
+
| Pmod_unpack x -> Pmod_unpack x
1100
+
| Pmod_extension x -> Pmod_extension x
1101
+
;;
1102
+
end
1103
+
1104
+
module Ast_traverse = struct
1105
+
module Deriving_inline = struct
1106
+
type location = Location.t
1107
+
1108
+
type jkind_annotation_desc = T.jkind_annotation_desc =
1109
+
| Pjk_default
1110
+
| Pjk_abbreviation of string
1111
+
| Pjk_mod of jkind_annotation * modes
1112
+
| Pjk_with of jkind_annotation * core_type * modalities
1113
+
| Pjk_kind_of of core_type
1114
+
| Pjk_product of jkind_annotation list
1115
+
1116
+
and jkind_annotation = T.jkind_annotation =
1117
+
{ pjkind_loc : location
1118
+
; pjkind_desc : jkind_annotation_desc
1119
+
}
1120
+
1121
+
and function_param_desc = Pexp_function.function_param_desc =
1122
+
| Pparam_val of arg_label * expression option * pattern
1123
+
| Pparam_newtype of string loc * jkind_annotation option
1124
+
1125
+
and function_param = Pexp_function.function_param =
1126
+
{ pparam_loc : location
1127
+
; pparam_desc : function_param_desc
1128
+
}
1129
+
1130
+
and type_constraint = Pexp_function.type_constraint =
1131
+
| Pconstraint of core_type
1132
+
| Pcoerce of core_type option * core_type
1133
+
1134
+
and function_constraint = Pexp_function.Function_constraint.t =
1135
+
{ mode_annotations : modes
1136
+
; ret_mode_annotations : modes
1137
+
; ret_type_constraint : type_constraint option
1138
+
}
1139
+
1140
+
and function_body = Pexp_function.function_body =
1141
+
| Pfunction_body of expression
1142
+
| Pfunction_cases of case list * location * attributes
1143
+
1144
+
and mode = Mode.t = Mode of string [@@unboxed]
1145
+
and modes = mode loc list
1146
+
and modality = Modality.t = Modality of string [@@unboxed]
1147
+
and modalities = modality loc list
1148
+
and signature_items = signature_item list
1149
+
and signature = signature_items [@@deriving_inline traverse]
1150
+
1151
+
class virtual map =
1152
+
object (self)
1153
+
method virtual arg_label : arg_label -> arg_label
1154
+
method virtual attributes : attributes -> attributes
1155
+
method virtual case : case -> case
1156
+
method virtual core_type : core_type -> core_type
1157
+
method virtual expression : expression -> expression
1158
+
method virtual list : 'a. ('a -> 'a) -> 'a list -> 'a list
1159
+
method virtual loc : 'a. ('a -> 'a) -> 'a loc -> 'a loc
1160
+
method virtual location : location -> location
1161
+
method virtual option : 'a. ('a -> 'a) -> 'a option -> 'a option
1162
+
method virtual pattern : pattern -> pattern
1163
+
method virtual signature_item : signature_item -> signature_item
1164
+
method virtual string : string -> string
1165
+
1166
+
method jkind_annotation_desc : jkind_annotation_desc -> jkind_annotation_desc =
1167
+
fun x ->
1168
+
match x with
1169
+
| Pjk_default -> Pjk_default
1170
+
| Pjk_abbreviation a ->
1171
+
let a = self#string a in
1172
+
Pjk_abbreviation a
1173
+
| Pjk_mod (a, b) ->
1174
+
let a = self#jkind_annotation a in
1175
+
let b = self#modes b in
1176
+
Pjk_mod (a, b)
1177
+
| Pjk_with (a, b, c) ->
1178
+
let a = self#jkind_annotation a in
1179
+
let b = self#core_type b in
1180
+
let c = self#modalities c in
1181
+
Pjk_with (a, b, c)
1182
+
| Pjk_kind_of a ->
1183
+
let a = self#core_type a in
1184
+
Pjk_kind_of a
1185
+
| Pjk_product a ->
1186
+
let a = self#list self#jkind_annotation a in
1187
+
Pjk_product a
1188
+
1189
+
method jkind_annotation : jkind_annotation -> jkind_annotation =
1190
+
fun { pjkind_loc; pjkind_desc } ->
1191
+
let pjkind_loc = self#location pjkind_loc in
1192
+
let pjkind_desc = self#jkind_annotation_desc pjkind_desc in
1193
+
{ pjkind_loc; pjkind_desc }
1194
+
1195
+
method function_param_desc : function_param_desc -> function_param_desc =
1196
+
fun x ->
1197
+
match x with
1198
+
| Pparam_val (a, b, c) ->
1199
+
let a = self#arg_label a in
1200
+
let b = self#option self#expression b in
1201
+
let c = self#pattern c in
1202
+
Pparam_val (a, b, c)
1203
+
| Pparam_newtype (a, b) ->
1204
+
let a = self#loc self#string a in
1205
+
let b = self#option self#jkind_annotation b in
1206
+
Pparam_newtype (a, b)
1207
+
1208
+
method function_param : function_param -> function_param =
1209
+
fun { pparam_loc; pparam_desc } ->
1210
+
let pparam_loc = self#location pparam_loc in
1211
+
let pparam_desc = self#function_param_desc pparam_desc in
1212
+
{ pparam_loc; pparam_desc }
1213
+
1214
+
method type_constraint : type_constraint -> type_constraint =
1215
+
fun x ->
1216
+
match x with
1217
+
| Pconstraint a ->
1218
+
let a = self#core_type a in
1219
+
Pconstraint a
1220
+
| Pcoerce (a, b) ->
1221
+
let a = self#option self#core_type a in
1222
+
let b = self#core_type b in
1223
+
Pcoerce (a, b)
1224
+
1225
+
method function_constraint : function_constraint -> function_constraint =
1226
+
fun { mode_annotations; ret_mode_annotations; ret_type_constraint } ->
1227
+
let mode_annotations = self#modes mode_annotations in
1228
+
let ret_mode_annotations = self#modes ret_mode_annotations in
1229
+
let ret_type_constraint =
1230
+
self#option self#type_constraint ret_type_constraint
1231
+
in
1232
+
{ mode_annotations; ret_mode_annotations; ret_type_constraint }
1233
+
1234
+
method function_body : function_body -> function_body =
1235
+
fun x ->
1236
+
match x with
1237
+
| Pfunction_body a ->
1238
+
let a = self#expression a in
1239
+
Pfunction_body a
1240
+
| Pfunction_cases (a, b, c) ->
1241
+
let a = self#list self#case a in
1242
+
let b = self#location b in
1243
+
let c = self#attributes c in
1244
+
Pfunction_cases (a, b, c)
1245
+
1246
+
method mode : mode -> mode =
1247
+
fun x ->
1248
+
match x with
1249
+
| Mode a ->
1250
+
let a = self#string a in
1251
+
Mode a
1252
+
1253
+
method modes : modes -> modes = self#list (self#loc self#mode)
1254
+
1255
+
method modality : modality -> modality =
1256
+
fun x ->
1257
+
match x with
1258
+
| Modality a ->
1259
+
let a = self#string a in
1260
+
Modality a
1261
+
1262
+
method modalities : modalities -> modalities = self#list (self#loc self#modality)
1263
+
1264
+
method signature_items : signature_items -> signature_items =
1265
+
self#list self#signature_item
1266
+
1267
+
method signature : signature -> signature = self#signature_items
1268
+
end
1269
+
1270
+
class virtual iter =
1271
+
object (self)
1272
+
method virtual arg_label : arg_label -> unit
1273
+
method virtual attributes : attributes -> unit
1274
+
method virtual case : case -> unit
1275
+
method virtual core_type : core_type -> unit
1276
+
method virtual expression : expression -> unit
1277
+
method virtual list : 'a. ('a -> unit) -> 'a list -> unit
1278
+
method virtual loc : 'a. ('a -> unit) -> 'a loc -> unit
1279
+
method virtual location : location -> unit
1280
+
method virtual option : 'a. ('a -> unit) -> 'a option -> unit
1281
+
method virtual pattern : pattern -> unit
1282
+
method virtual signature_item : signature_item -> unit
1283
+
method virtual string : string -> unit
1284
+
1285
+
method jkind_annotation_desc : jkind_annotation_desc -> unit =
1286
+
fun x ->
1287
+
match x with
1288
+
| Pjk_default -> ()
1289
+
| Pjk_abbreviation a -> self#string a
1290
+
| Pjk_mod (a, b) ->
1291
+
self#jkind_annotation a;
1292
+
self#modes b
1293
+
| Pjk_with (a, b, c) ->
1294
+
self#jkind_annotation a;
1295
+
self#core_type b;
1296
+
self#modalities c
1297
+
| Pjk_kind_of a -> self#core_type a
1298
+
| Pjk_product a -> self#list self#jkind_annotation a
1299
+
1300
+
method jkind_annotation : jkind_annotation -> unit =
1301
+
fun { pjkind_loc; pjkind_desc } ->
1302
+
self#location pjkind_loc;
1303
+
self#jkind_annotation_desc pjkind_desc
1304
+
1305
+
method function_param_desc : function_param_desc -> unit =
1306
+
fun x ->
1307
+
match x with
1308
+
| Pparam_val (a, b, c) ->
1309
+
self#arg_label a;
1310
+
self#option self#expression b;
1311
+
self#pattern c
1312
+
| Pparam_newtype (a, b) ->
1313
+
self#loc self#string a;
1314
+
self#option self#jkind_annotation b
1315
+
1316
+
method function_param : function_param -> unit =
1317
+
fun { pparam_loc; pparam_desc } ->
1318
+
self#location pparam_loc;
1319
+
self#function_param_desc pparam_desc
1320
+
1321
+
method type_constraint : type_constraint -> unit =
1322
+
fun x ->
1323
+
match x with
1324
+
| Pconstraint a -> self#core_type a
1325
+
| Pcoerce (a, b) ->
1326
+
self#option self#core_type a;
1327
+
self#core_type b
1328
+
1329
+
method function_constraint : function_constraint -> unit =
1330
+
fun { mode_annotations; ret_mode_annotations; ret_type_constraint } ->
1331
+
self#modes mode_annotations;
1332
+
self#modes ret_mode_annotations;
1333
+
self#option self#type_constraint ret_type_constraint
1334
+
1335
+
method function_body : function_body -> unit =
1336
+
fun x ->
1337
+
match x with
1338
+
| Pfunction_body a -> self#expression a
1339
+
| Pfunction_cases (a, b, c) ->
1340
+
self#list self#case a;
1341
+
self#location b;
1342
+
self#attributes c
1343
+
1344
+
method mode : mode -> unit =
1345
+
fun x ->
1346
+
match x with
1347
+
| Mode a -> self#string a
1348
+
1349
+
method modes : modes -> unit = self#list (self#loc self#mode)
1350
+
1351
+
method modality : modality -> unit =
1352
+
fun x ->
1353
+
match x with
1354
+
| Modality a -> self#string a
1355
+
1356
+
method modalities : modalities -> unit = self#list (self#loc self#modality)
1357
+
method signature_items : signature_items -> unit = self#list self#signature_item
1358
+
method signature : signature -> unit = self#signature_items
1359
+
end
1360
+
1361
+
class virtual ['acc] fold =
1362
+
object (self)
1363
+
method virtual arg_label : arg_label -> 'acc -> 'acc
1364
+
method virtual attributes : attributes -> 'acc -> 'acc
1365
+
method virtual case : case -> 'acc -> 'acc
1366
+
method virtual core_type : core_type -> 'acc -> 'acc
1367
+
method virtual expression : expression -> 'acc -> 'acc
1368
+
method virtual list : 'a. ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc
1369
+
method virtual loc : 'a. ('a -> 'acc -> 'acc) -> 'a loc -> 'acc -> 'acc
1370
+
method virtual location : location -> 'acc -> 'acc
1371
+
method virtual option : 'a. ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc
1372
+
method virtual pattern : pattern -> 'acc -> 'acc
1373
+
method virtual signature_item : signature_item -> 'acc -> 'acc
1374
+
method virtual string : string -> 'acc -> 'acc
1375
+
1376
+
method jkind_annotation_desc : jkind_annotation_desc -> 'acc -> 'acc =
1377
+
fun x acc ->
1378
+
match x with
1379
+
| Pjk_default -> acc
1380
+
| Pjk_abbreviation a -> self#string a acc
1381
+
| Pjk_mod (a, b) ->
1382
+
let acc = self#jkind_annotation a acc in
1383
+
let acc = self#modes b acc in
1384
+
acc
1385
+
| Pjk_with (a, b, c) ->
1386
+
let acc = self#jkind_annotation a acc in
1387
+
let acc = self#core_type b acc in
1388
+
let acc = self#modalities c acc in
1389
+
acc
1390
+
| Pjk_kind_of a -> self#core_type a acc
1391
+
| Pjk_product a -> self#list self#jkind_annotation a acc
1392
+
1393
+
method jkind_annotation : jkind_annotation -> 'acc -> 'acc =
1394
+
fun { pjkind_loc; pjkind_desc } acc ->
1395
+
let acc = self#location pjkind_loc acc in
1396
+
let acc = self#jkind_annotation_desc pjkind_desc acc in
1397
+
acc
1398
+
1399
+
method function_param_desc : function_param_desc -> 'acc -> 'acc =
1400
+
fun x acc ->
1401
+
match x with
1402
+
| Pparam_val (a, b, c) ->
1403
+
let acc = self#arg_label a acc in
1404
+
let acc = self#option self#expression b acc in
1405
+
let acc = self#pattern c acc in
1406
+
acc
1407
+
| Pparam_newtype (a, b) ->
1408
+
let acc = self#loc self#string a acc in
1409
+
let acc = self#option self#jkind_annotation b acc in
1410
+
acc
1411
+
1412
+
method function_param : function_param -> 'acc -> 'acc =
1413
+
fun { pparam_loc; pparam_desc } acc ->
1414
+
let acc = self#location pparam_loc acc in
1415
+
let acc = self#function_param_desc pparam_desc acc in
1416
+
acc
1417
+
1418
+
method type_constraint : type_constraint -> 'acc -> 'acc =
1419
+
fun x acc ->
1420
+
match x with
1421
+
| Pconstraint a -> self#core_type a acc
1422
+
| Pcoerce (a, b) ->
1423
+
let acc = self#option self#core_type a acc in
1424
+
let acc = self#core_type b acc in
1425
+
acc
1426
+
1427
+
method function_constraint : function_constraint -> 'acc -> 'acc =
1428
+
fun { mode_annotations; ret_mode_annotations; ret_type_constraint } acc ->
1429
+
let acc = self#modes mode_annotations acc in
1430
+
let acc = self#modes ret_mode_annotations acc in
1431
+
let acc = self#option self#type_constraint ret_type_constraint acc in
1432
+
acc
1433
+
1434
+
method function_body : function_body -> 'acc -> 'acc =
1435
+
fun x acc ->
1436
+
match x with
1437
+
| Pfunction_body a -> self#expression a acc
1438
+
| Pfunction_cases (a, b, c) ->
1439
+
let acc = self#list self#case a acc in
1440
+
let acc = self#location b acc in
1441
+
let acc = self#attributes c acc in
1442
+
acc
1443
+
1444
+
method mode : mode -> 'acc -> 'acc =
1445
+
fun x acc ->
1446
+
match x with
1447
+
| Mode a -> self#string a acc
1448
+
1449
+
method modes : modes -> 'acc -> 'acc = self#list (self#loc self#mode)
1450
+
1451
+
method modality : modality -> 'acc -> 'acc =
1452
+
fun x acc ->
1453
+
match x with
1454
+
| Modality a -> self#string a acc
1455
+
1456
+
method modalities : modalities -> 'acc -> 'acc =
1457
+
self#list (self#loc self#modality)
1458
+
1459
+
method signature_items : signature_items -> 'acc -> 'acc =
1460
+
self#list self#signature_item
1461
+
1462
+
method signature : signature -> 'acc -> 'acc = self#signature_items
1463
+
end
1464
+
1465
+
class virtual ['acc] fold_map =
1466
+
object (self)
1467
+
method virtual arg_label : arg_label -> 'acc -> arg_label * 'acc
1468
+
method virtual attributes : attributes -> 'acc -> attributes * 'acc
1469
+
method virtual case : case -> 'acc -> case * 'acc
1470
+
method virtual core_type : core_type -> 'acc -> core_type * 'acc
1471
+
method virtual expression : expression -> 'acc -> expression * 'acc
1472
+
1473
+
method
1474
+
virtual list
1475
+
: 'a. ('a -> 'acc -> 'a * 'acc) -> 'a list -> 'acc -> 'a list * 'acc
1476
+
1477
+
method
1478
+
virtual loc
1479
+
: 'a. ('a -> 'acc -> 'a * 'acc) -> 'a loc -> 'acc -> 'a loc * 'acc
1480
+
1481
+
method virtual location : location -> 'acc -> location * 'acc
1482
+
1483
+
method
1484
+
virtual option
1485
+
: 'a. ('a -> 'acc -> 'a * 'acc) -> 'a option -> 'acc -> 'a option * 'acc
1486
+
1487
+
method virtual pattern : pattern -> 'acc -> pattern * 'acc
1488
+
method virtual signature_item : signature_item -> 'acc -> signature_item * 'acc
1489
+
method virtual string : string -> 'acc -> string * 'acc
1490
+
1491
+
method jkind_annotation_desc
1492
+
: jkind_annotation_desc -> 'acc -> jkind_annotation_desc * 'acc =
1493
+
fun x acc ->
1494
+
match x with
1495
+
| Pjk_default -> Pjk_default, acc
1496
+
| Pjk_abbreviation a ->
1497
+
let a, acc = self#string a acc in
1498
+
Pjk_abbreviation a, acc
1499
+
| Pjk_mod (a, b) ->
1500
+
let a, acc = self#jkind_annotation a acc in
1501
+
let b, acc = self#modes b acc in
1502
+
Pjk_mod (a, b), acc
1503
+
| Pjk_with (a, b, c) ->
1504
+
let a, acc = self#jkind_annotation a acc in
1505
+
let b, acc = self#core_type b acc in
1506
+
let c, acc = self#modalities c acc in
1507
+
Pjk_with (a, b, c), acc
1508
+
| Pjk_kind_of a ->
1509
+
let a, acc = self#core_type a acc in
1510
+
Pjk_kind_of a, acc
1511
+
| Pjk_product a ->
1512
+
let a, acc = self#list self#jkind_annotation a acc in
1513
+
Pjk_product a, acc
1514
+
1515
+
method jkind_annotation : jkind_annotation -> 'acc -> jkind_annotation * 'acc =
1516
+
fun { pjkind_loc; pjkind_desc } acc ->
1517
+
let pjkind_loc, acc = self#location pjkind_loc acc in
1518
+
let pjkind_desc, acc = self#jkind_annotation_desc pjkind_desc acc in
1519
+
{ pjkind_loc; pjkind_desc }, acc
1520
+
1521
+
method function_param_desc
1522
+
: function_param_desc -> 'acc -> function_param_desc * 'acc =
1523
+
fun x acc ->
1524
+
match x with
1525
+
| Pparam_val (a, b, c) ->
1526
+
let a, acc = self#arg_label a acc in
1527
+
let b, acc = self#option self#expression b acc in
1528
+
let c, acc = self#pattern c acc in
1529
+
Pparam_val (a, b, c), acc
1530
+
| Pparam_newtype (a, b) ->
1531
+
let a, acc = self#loc self#string a acc in
1532
+
let b, acc = self#option self#jkind_annotation b acc in
1533
+
Pparam_newtype (a, b), acc
1534
+
1535
+
method function_param : function_param -> 'acc -> function_param * 'acc =
1536
+
fun { pparam_loc; pparam_desc } acc ->
1537
+
let pparam_loc, acc = self#location pparam_loc acc in
1538
+
let pparam_desc, acc = self#function_param_desc pparam_desc acc in
1539
+
{ pparam_loc; pparam_desc }, acc
1540
+
1541
+
method type_constraint : type_constraint -> 'acc -> type_constraint * 'acc =
1542
+
fun x acc ->
1543
+
match x with
1544
+
| Pconstraint a ->
1545
+
let a, acc = self#core_type a acc in
1546
+
Pconstraint a, acc
1547
+
| Pcoerce (a, b) ->
1548
+
let a, acc = self#option self#core_type a acc in
1549
+
let b, acc = self#core_type b acc in
1550
+
Pcoerce (a, b), acc
1551
+
1552
+
method function_constraint
1553
+
: function_constraint -> 'acc -> function_constraint * 'acc =
1554
+
fun { mode_annotations; ret_mode_annotations; ret_type_constraint } acc ->
1555
+
let mode_annotations, acc = self#modes mode_annotations acc in
1556
+
let ret_mode_annotations, acc = self#modes ret_mode_annotations acc in
1557
+
let ret_type_constraint, acc =
1558
+
self#option self#type_constraint ret_type_constraint acc
1559
+
in
1560
+
{ mode_annotations; ret_mode_annotations; ret_type_constraint }, acc
1561
+
1562
+
method function_body : function_body -> 'acc -> function_body * 'acc =
1563
+
fun x acc ->
1564
+
match x with
1565
+
| Pfunction_body a ->
1566
+
let a, acc = self#expression a acc in
1567
+
Pfunction_body a, acc
1568
+
| Pfunction_cases (a, b, c) ->
1569
+
let a, acc = self#list self#case a acc in
1570
+
let b, acc = self#location b acc in
1571
+
let c, acc = self#attributes c acc in
1572
+
Pfunction_cases (a, b, c), acc
1573
+
1574
+
method mode : mode -> 'acc -> mode * 'acc =
1575
+
fun x acc ->
1576
+
match x with
1577
+
| Mode a ->
1578
+
let a, acc = self#string a acc in
1579
+
Mode a, acc
1580
+
1581
+
method modes : modes -> 'acc -> modes * 'acc = self#list (self#loc self#mode)
1582
+
1583
+
method modality : modality -> 'acc -> modality * 'acc =
1584
+
fun x acc ->
1585
+
match x with
1586
+
| Modality a ->
1587
+
let a, acc = self#string a acc in
1588
+
Modality a, acc
1589
+
1590
+
method modalities : modalities -> 'acc -> modalities * 'acc =
1591
+
self#list (self#loc self#modality)
1592
+
1593
+
method signature_items : signature_items -> 'acc -> signature_items * 'acc =
1594
+
self#list self#signature_item
1595
+
1596
+
method signature : signature -> 'acc -> signature * 'acc = self#signature_items
1597
+
end
1598
+
1599
+
class virtual ['ctx] map_with_context =
1600
+
object (self)
1601
+
method virtual arg_label : 'ctx -> arg_label -> arg_label
1602
+
method virtual attributes : 'ctx -> attributes -> attributes
1603
+
method virtual case : 'ctx -> case -> case
1604
+
method virtual core_type : 'ctx -> core_type -> core_type
1605
+
method virtual expression : 'ctx -> expression -> expression
1606
+
method virtual list : 'a. ('ctx -> 'a -> 'a) -> 'ctx -> 'a list -> 'a list
1607
+
method virtual loc : 'a. ('ctx -> 'a -> 'a) -> 'ctx -> 'a loc -> 'a loc
1608
+
method virtual location : 'ctx -> location -> location
1609
+
method virtual option : 'a. ('ctx -> 'a -> 'a) -> 'ctx -> 'a option -> 'a option
1610
+
method virtual pattern : 'ctx -> pattern -> pattern
1611
+
method virtual signature_item : 'ctx -> signature_item -> signature_item
1612
+
method virtual string : 'ctx -> string -> string
1613
+
1614
+
method jkind_annotation_desc
1615
+
: 'ctx -> jkind_annotation_desc -> jkind_annotation_desc =
1616
+
fun ctx x ->
1617
+
match x with
1618
+
| Pjk_default -> Pjk_default
1619
+
| Pjk_abbreviation a ->
1620
+
let a = self#string ctx a in
1621
+
Pjk_abbreviation a
1622
+
| Pjk_mod (a, b) ->
1623
+
let a = self#jkind_annotation ctx a in
1624
+
let b = self#modes ctx b in
1625
+
Pjk_mod (a, b)
1626
+
| Pjk_with (a, b, c) ->
1627
+
let a = self#jkind_annotation ctx a in
1628
+
let b = self#core_type ctx b in
1629
+
let c = self#modalities ctx c in
1630
+
Pjk_with (a, b, c)
1631
+
| Pjk_kind_of a ->
1632
+
let a = self#core_type ctx a in
1633
+
Pjk_kind_of a
1634
+
| Pjk_product a ->
1635
+
let a = self#list self#jkind_annotation ctx a in
1636
+
Pjk_product a
1637
+
1638
+
method jkind_annotation : 'ctx -> jkind_annotation -> jkind_annotation =
1639
+
fun ctx { pjkind_loc; pjkind_desc } ->
1640
+
let pjkind_loc = self#location ctx pjkind_loc in
1641
+
let pjkind_desc = self#jkind_annotation_desc ctx pjkind_desc in
1642
+
{ pjkind_loc; pjkind_desc }
1643
+
1644
+
method function_param_desc : 'ctx -> function_param_desc -> function_param_desc =
1645
+
fun ctx x ->
1646
+
match x with
1647
+
| Pparam_val (a, b, c) ->
1648
+
let a = self#arg_label ctx a in
1649
+
let b = self#option self#expression ctx b in
1650
+
let c = self#pattern ctx c in
1651
+
Pparam_val (a, b, c)
1652
+
| Pparam_newtype (a, b) ->
1653
+
let a = self#loc self#string ctx a in
1654
+
let b = self#option self#jkind_annotation ctx b in
1655
+
Pparam_newtype (a, b)
1656
+
1657
+
method function_param : 'ctx -> function_param -> function_param =
1658
+
fun ctx { pparam_loc; pparam_desc } ->
1659
+
let pparam_loc = self#location ctx pparam_loc in
1660
+
let pparam_desc = self#function_param_desc ctx pparam_desc in
1661
+
{ pparam_loc; pparam_desc }
1662
+
1663
+
method type_constraint : 'ctx -> type_constraint -> type_constraint =
1664
+
fun ctx x ->
1665
+
match x with
1666
+
| Pconstraint a ->
1667
+
let a = self#core_type ctx a in
1668
+
Pconstraint a
1669
+
| Pcoerce (a, b) ->
1670
+
let a = self#option self#core_type ctx a in
1671
+
let b = self#core_type ctx b in
1672
+
Pcoerce (a, b)
1673
+
1674
+
method function_constraint : 'ctx -> function_constraint -> function_constraint =
1675
+
fun ctx { mode_annotations; ret_mode_annotations; ret_type_constraint } ->
1676
+
let mode_annotations = self#modes ctx mode_annotations in
1677
+
let ret_mode_annotations = self#modes ctx ret_mode_annotations in
1678
+
let ret_type_constraint =
1679
+
self#option self#type_constraint ctx ret_type_constraint
1680
+
in
1681
+
{ mode_annotations; ret_mode_annotations; ret_type_constraint }
1682
+
1683
+
method function_body : 'ctx -> function_body -> function_body =
1684
+
fun ctx x ->
1685
+
match x with
1686
+
| Pfunction_body a ->
1687
+
let a = self#expression ctx a in
1688
+
Pfunction_body a
1689
+
| Pfunction_cases (a, b, c) ->
1690
+
let a = self#list self#case ctx a in
1691
+
let b = self#location ctx b in
1692
+
let c = self#attributes ctx c in
1693
+
Pfunction_cases (a, b, c)
1694
+
1695
+
method mode : 'ctx -> mode -> mode =
1696
+
fun ctx x ->
1697
+
match x with
1698
+
| Mode a ->
1699
+
let a = self#string ctx a in
1700
+
Mode a
1701
+
1702
+
method modes : 'ctx -> modes -> modes = self#list (self#loc self#mode)
1703
+
1704
+
method modality : 'ctx -> modality -> modality =
1705
+
fun ctx x ->
1706
+
match x with
1707
+
| Modality a ->
1708
+
let a = self#string ctx a in
1709
+
Modality a
1710
+
1711
+
method modalities : 'ctx -> modalities -> modalities =
1712
+
self#list (self#loc self#modality)
1713
+
1714
+
method signature_items : 'ctx -> signature_items -> signature_items =
1715
+
self#list self#signature_item
1716
+
1717
+
method signature : 'ctx -> signature -> signature = self#signature_items
1718
+
end
1719
+
1720
+
class virtual ['res] lift =
1721
+
object (self)
1722
+
method virtual record : (string * 'res) list -> 'res
1723
+
method virtual constr : string -> 'res list -> 'res
1724
+
method virtual arg_label : arg_label -> 'res
1725
+
method virtual attributes : attributes -> 'res
1726
+
method virtual case : case -> 'res
1727
+
method virtual core_type : core_type -> 'res
1728
+
method virtual expression : expression -> 'res
1729
+
method virtual list : 'a. ('a -> 'res) -> 'a list -> 'res
1730
+
method virtual loc : 'a. ('a -> 'res) -> 'a loc -> 'res
1731
+
method virtual location : location -> 'res
1732
+
method virtual option : 'a. ('a -> 'res) -> 'a option -> 'res
1733
+
method virtual pattern : pattern -> 'res
1734
+
method virtual signature_item : signature_item -> 'res
1735
+
method virtual string : string -> 'res
1736
+
1737
+
method jkind_annotation_desc : jkind_annotation_desc -> 'res =
1738
+
fun x ->
1739
+
match x with
1740
+
| Pjk_default -> self#constr "Pjk_default" []
1741
+
| Pjk_abbreviation a ->
1742
+
let a = self#string a in
1743
+
self#constr "Pjk_abbreviation" [ a ]
1744
+
| Pjk_mod (a, b) ->
1745
+
let a = self#jkind_annotation a in
1746
+
let b = self#modes b in
1747
+
self#constr "Pjk_mod" [ a; b ]
1748
+
| Pjk_with (a, b, c) ->
1749
+
let a = self#jkind_annotation a in
1750
+
let b = self#core_type b in
1751
+
let c = self#modalities c in
1752
+
self#constr "Pjk_with" [ a; b; c ]
1753
+
| Pjk_kind_of a ->
1754
+
let a = self#core_type a in
1755
+
self#constr "Pjk_kind_of" [ a ]
1756
+
| Pjk_product a ->
1757
+
let a = self#list self#jkind_annotation a in
1758
+
self#constr "Pjk_product" [ a ]
1759
+
1760
+
method jkind_annotation : jkind_annotation -> 'res =
1761
+
fun { pjkind_loc; pjkind_desc } ->
1762
+
let pjkind_loc = self#location pjkind_loc in
1763
+
let pjkind_desc = self#jkind_annotation_desc pjkind_desc in
1764
+
self#record [ "pjkind_loc", pjkind_loc; "pjkind_desc", pjkind_desc ]
1765
+
1766
+
method function_param_desc : function_param_desc -> 'res =
1767
+
fun x ->
1768
+
match x with
1769
+
| Pparam_val (a, b, c) ->
1770
+
let a = self#arg_label a in
1771
+
let b = self#option self#expression b in
1772
+
let c = self#pattern c in
1773
+
self#constr "Pparam_val" [ a; b; c ]
1774
+
| Pparam_newtype (a, b) ->
1775
+
let a = self#loc self#string a in
1776
+
let b = self#option self#jkind_annotation b in
1777
+
self#constr "Pparam_newtype" [ a; b ]
1778
+
1779
+
method function_param : function_param -> 'res =
1780
+
fun { pparam_loc; pparam_desc } ->
1781
+
let pparam_loc = self#location pparam_loc in
1782
+
let pparam_desc = self#function_param_desc pparam_desc in
1783
+
self#record [ "pparam_loc", pparam_loc; "pparam_desc", pparam_desc ]
1784
+
1785
+
method type_constraint : type_constraint -> 'res =
1786
+
fun x ->
1787
+
match x with
1788
+
| Pconstraint a ->
1789
+
let a = self#core_type a in
1790
+
self#constr "Pconstraint" [ a ]
1791
+
| Pcoerce (a, b) ->
1792
+
let a = self#option self#core_type a in
1793
+
let b = self#core_type b in
1794
+
self#constr "Pcoerce" [ a; b ]
1795
+
1796
+
method function_constraint : function_constraint -> 'res =
1797
+
fun { mode_annotations; ret_mode_annotations; ret_type_constraint } ->
1798
+
let mode_annotations = self#modes mode_annotations in
1799
+
let ret_mode_annotations = self#modes ret_mode_annotations in
1800
+
let ret_type_constraint =
1801
+
self#option self#type_constraint ret_type_constraint
1802
+
in
1803
+
self#record
1804
+
[ "mode_annotations", mode_annotations
1805
+
; "ret_mode_annotations", ret_mode_annotations
1806
+
; "ret_type_constraint", ret_type_constraint
1807
+
]
1808
+
1809
+
method function_body : function_body -> 'res =
1810
+
fun x ->
1811
+
match x with
1812
+
| Pfunction_body a ->
1813
+
let a = self#expression a in
1814
+
self#constr "Pfunction_body" [ a ]
1815
+
| Pfunction_cases (a, b, c) ->
1816
+
let a = self#list self#case a in
1817
+
let b = self#location b in
1818
+
let c = self#attributes c in
1819
+
self#constr "Pfunction_cases" [ a; b; c ]
1820
+
1821
+
method mode : mode -> 'res =
1822
+
fun x ->
1823
+
match x with
1824
+
| Mode a ->
1825
+
let a = self#string a in
1826
+
self#constr "Mode" [ a ]
1827
+
1828
+
method modes : modes -> 'res = self#list (self#loc self#mode)
1829
+
1830
+
method modality : modality -> 'res =
1831
+
fun x ->
1832
+
match x with
1833
+
| Modality a ->
1834
+
let a = self#string a in
1835
+
self#constr "Modality" [ a ]
1836
+
1837
+
method modalities : modalities -> 'res = self#list (self#loc self#modality)
1838
+
method signature_items : signature_items -> 'res = self#list self#signature_item
1839
+
method signature : signature -> 'res = self#signature_items
1840
+
end
1841
+
1842
+
class virtual ['ctx, 'res] lift_map_with_context =
1843
+
object (self)
1844
+
method virtual record : 'ctx -> (string * 'res) list -> 'res
1845
+
method virtual constr : 'ctx -> string -> 'res list -> 'res
1846
+
method virtual arg_label : 'ctx -> arg_label -> arg_label * 'res
1847
+
method virtual attributes : 'ctx -> attributes -> attributes * 'res
1848
+
method virtual case : 'ctx -> case -> case * 'res
1849
+
method virtual core_type : 'ctx -> core_type -> core_type * 'res
1850
+
method virtual expression : 'ctx -> expression -> expression * 'res
1851
+
1852
+
method
1853
+
virtual list
1854
+
: 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a list -> 'a list * 'res
1855
+
1856
+
method
1857
+
virtual loc
1858
+
: 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a loc -> 'a loc * 'res
1859
+
1860
+
method virtual location : 'ctx -> location -> location * 'res
1861
+
1862
+
method
1863
+
virtual option
1864
+
: 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a option -> 'a option * 'res
1865
+
1866
+
method virtual pattern : 'ctx -> pattern -> pattern * 'res
1867
+
method virtual signature_item : 'ctx -> signature_item -> signature_item * 'res
1868
+
method virtual string : 'ctx -> string -> string * 'res
1869
+
1870
+
method jkind_annotation_desc
1871
+
: 'ctx -> jkind_annotation_desc -> jkind_annotation_desc * 'res =
1872
+
fun ctx x ->
1873
+
match x with
1874
+
| Pjk_default -> Pjk_default, self#constr ctx "Pjk_default" []
1875
+
| Pjk_abbreviation a ->
1876
+
let a = self#string ctx a in
1877
+
( Pjk_abbreviation (Stdlib.fst a)
1878
+
, self#constr ctx "Pjk_abbreviation" [ Stdlib.snd a ] )
1879
+
| Pjk_mod (a, b) ->
1880
+
let a = self#jkind_annotation ctx a in
1881
+
let b = self#modes ctx b in
1882
+
( Pjk_mod (Stdlib.fst a, Stdlib.fst b)
1883
+
, self#constr ctx "Pjk_mod" [ Stdlib.snd a; Stdlib.snd b ] )
1884
+
| Pjk_with (a, b, c) ->
1885
+
let a = self#jkind_annotation ctx a in
1886
+
let b = self#core_type ctx b in
1887
+
let c = self#modalities ctx c in
1888
+
( Pjk_with (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c)
1889
+
, self#constr ctx "Pjk_with" [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] )
1890
+
| Pjk_kind_of a ->
1891
+
let a = self#core_type ctx a in
1892
+
Pjk_kind_of (Stdlib.fst a), self#constr ctx "Pjk_kind_of" [ Stdlib.snd a ]
1893
+
| Pjk_product a ->
1894
+
let a = self#list self#jkind_annotation ctx a in
1895
+
Pjk_product (Stdlib.fst a), self#constr ctx "Pjk_product" [ Stdlib.snd a ]
1896
+
1897
+
method jkind_annotation : 'ctx -> jkind_annotation -> jkind_annotation * 'res =
1898
+
fun ctx { pjkind_loc; pjkind_desc } ->
1899
+
let pjkind_loc = self#location ctx pjkind_loc in
1900
+
let pjkind_desc = self#jkind_annotation_desc ctx pjkind_desc in
1901
+
( { pjkind_loc = Stdlib.fst pjkind_loc; pjkind_desc = Stdlib.fst pjkind_desc }
1902
+
, self#record
1903
+
ctx
1904
+
[ "pjkind_loc", Stdlib.snd pjkind_loc
1905
+
; "pjkind_desc", Stdlib.snd pjkind_desc
1906
+
] )
1907
+
1908
+
method function_param_desc
1909
+
: 'ctx -> function_param_desc -> function_param_desc * 'res =
1910
+
fun ctx x ->
1911
+
match x with
1912
+
| Pparam_val (a, b, c) ->
1913
+
let a = self#arg_label ctx a in
1914
+
let b = self#option self#expression ctx b in
1915
+
let c = self#pattern ctx c in
1916
+
( Pparam_val (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c)
1917
+
, self#constr ctx "Pparam_val" [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ]
1918
+
)
1919
+
| Pparam_newtype (a, b) ->
1920
+
let a = self#loc self#string ctx a in
1921
+
let b = self#option self#jkind_annotation ctx b in
1922
+
( Pparam_newtype (Stdlib.fst a, Stdlib.fst b)
1923
+
, self#constr ctx "Pparam_newtype" [ Stdlib.snd a; Stdlib.snd b ] )
1924
+
1925
+
method function_param : 'ctx -> function_param -> function_param * 'res =
1926
+
fun ctx { pparam_loc; pparam_desc } ->
1927
+
let pparam_loc = self#location ctx pparam_loc in
1928
+
let pparam_desc = self#function_param_desc ctx pparam_desc in
1929
+
( { pparam_loc = Stdlib.fst pparam_loc; pparam_desc = Stdlib.fst pparam_desc }
1930
+
, self#record
1931
+
ctx
1932
+
[ "pparam_loc", Stdlib.snd pparam_loc
1933
+
; "pparam_desc", Stdlib.snd pparam_desc
1934
+
] )
1935
+
1936
+
method type_constraint : 'ctx -> type_constraint -> type_constraint * 'res =
1937
+
fun ctx x ->
1938
+
match x with
1939
+
| Pconstraint a ->
1940
+
let a = self#core_type ctx a in
1941
+
Pconstraint (Stdlib.fst a), self#constr ctx "Pconstraint" [ Stdlib.snd a ]
1942
+
| Pcoerce (a, b) ->
1943
+
let a = self#option self#core_type ctx a in
1944
+
let b = self#core_type ctx b in
1945
+
( Pcoerce (Stdlib.fst a, Stdlib.fst b)
1946
+
, self#constr ctx "Pcoerce" [ Stdlib.snd a; Stdlib.snd b ] )
1947
+
1948
+
method function_constraint
1949
+
: 'ctx -> function_constraint -> function_constraint * 'res =
1950
+
fun ctx { mode_annotations; ret_mode_annotations; ret_type_constraint } ->
1951
+
let mode_annotations = self#modes ctx mode_annotations in
1952
+
let ret_mode_annotations = self#modes ctx ret_mode_annotations in
1953
+
let ret_type_constraint =
1954
+
self#option self#type_constraint ctx ret_type_constraint
1955
+
in
1956
+
( { mode_annotations = Stdlib.fst mode_annotations
1957
+
; ret_mode_annotations = Stdlib.fst ret_mode_annotations
1958
+
; ret_type_constraint = Stdlib.fst ret_type_constraint
1959
+
}
1960
+
, self#record
1961
+
ctx
1962
+
[ "mode_annotations", Stdlib.snd mode_annotations
1963
+
; "ret_mode_annotations", Stdlib.snd ret_mode_annotations
1964
+
; "ret_type_constraint", Stdlib.snd ret_type_constraint
1965
+
] )
1966
+
1967
+
method function_body : 'ctx -> function_body -> function_body * 'res =
1968
+
fun ctx x ->
1969
+
match x with
1970
+
| Pfunction_body a ->
1971
+
let a = self#expression ctx a in
1972
+
( Pfunction_body (Stdlib.fst a)
1973
+
, self#constr ctx "Pfunction_body" [ Stdlib.snd a ] )
1974
+
| Pfunction_cases (a, b, c) ->
1975
+
let a = self#list self#case ctx a in
1976
+
let b = self#location ctx b in
1977
+
let c = self#attributes ctx c in
1978
+
( Pfunction_cases (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c)
1979
+
, self#constr
1980
+
ctx
1981
+
"Pfunction_cases"
1982
+
[ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] )
1983
+
1984
+
method mode : 'ctx -> mode -> mode * 'res =
1985
+
fun ctx x ->
1986
+
match x with
1987
+
| Mode a ->
1988
+
let a = self#string ctx a in
1989
+
Mode (Stdlib.fst a), self#constr ctx "Mode" [ Stdlib.snd a ]
1990
+
1991
+
method modes : 'ctx -> modes -> modes * 'res = self#list (self#loc self#mode)
1992
+
1993
+
method modality : 'ctx -> modality -> modality * 'res =
1994
+
fun ctx x ->
1995
+
match x with
1996
+
| Modality a ->
1997
+
let a = self#string ctx a in
1998
+
Modality (Stdlib.fst a), self#constr ctx "Modality" [ Stdlib.snd a ]
1999
+
2000
+
method modalities : 'ctx -> modalities -> modalities * 'res =
2001
+
self#list (self#loc self#modality)
2002
+
2003
+
method signature_items : 'ctx -> signature_items -> signature_items * 'res =
2004
+
self#list self#signature_item
2005
+
2006
+
method signature : 'ctx -> signature -> signature * 'res = self#signature_items
2007
+
end
2008
+
2009
+
[@@@end]
2010
+
end
2011
+
2012
+
module Jane_street_extensions0 (T : sig
2013
+
type 'a t
2014
+
end) =
2015
+
struct
2016
+
class type t = object
2017
+
method jkind_annotation : jkind_annotation T.t
2018
+
method jkind_annotation_desc : jkind_annotation_desc T.t
2019
+
method function_body : Pexp_function.function_body T.t
2020
+
method function_param : Pexp_function.function_param T.t
2021
+
method function_param_desc : Pexp_function.function_param_desc T.t
2022
+
method function_constraint : Pexp_function.Function_constraint.t T.t
2023
+
method type_constraint : Pexp_function.type_constraint T.t
2024
+
method mode : Mode.t T.t
2025
+
method modes : Modes.t T.t
2026
+
method modality : Modality.t T.t
2027
+
method modalities : Modalities.t T.t
2028
+
method signature_items : signature_item list T.t
2029
+
end
2030
+
end
2031
+
2032
+
module Jane_street_extensions0_ctx (T : sig
2033
+
type ('a, 'b) t
2034
+
end) =
2035
+
struct
2036
+
class type ['ctx] t = object
2037
+
method jkind_annotation : ('ctx, jkind_annotation) T.t
2038
+
method jkind_annotation_desc : ('ctx, jkind_annotation_desc) T.t
2039
+
method function_body : ('ctx, Pexp_function.function_body) T.t
2040
+
method function_param : ('ctx, Pexp_function.function_param) T.t
2041
+
method function_param_desc : ('ctx, Pexp_function.function_param_desc) T.t
2042
+
method function_constraint : ('ctx, Pexp_function.Function_constraint.t) T.t
2043
+
method type_constraint : ('ctx, Pexp_function.type_constraint) T.t
2044
+
method mode : ('ctx, Mode.t) T.t
2045
+
method modes : ('ctx, Modes.t) T.t
2046
+
method modality : ('ctx, Modality.t) T.t
2047
+
method modalities : ('ctx, Modalities.t) T.t
2048
+
method signature_items : ('ctx, signature_item list) T.t
2049
+
end
2050
+
end
2051
+
2052
+
module Jane_street_extensions1 (T : sig
2053
+
type ('a, 'b) t
2054
+
end) =
2055
+
struct
2056
+
class type ['a] t = object
2057
+
method jkind_annotation : (jkind_annotation, 'a) T.t
2058
+
method jkind_annotation_desc : (jkind_annotation_desc, 'a) T.t
2059
+
method function_body : (Pexp_function.function_body, 'a) T.t
2060
+
method function_param : (Pexp_function.function_param, 'a) T.t
2061
+
method function_param_desc : (Pexp_function.function_param_desc, 'a) T.t
2062
+
method function_constraint : (Pexp_function.Function_constraint.t, 'a) T.t
2063
+
method type_constraint : (Pexp_function.type_constraint, 'a) T.t
2064
+
method mode : (Mode.t, 'a) T.t
2065
+
method modes : (Modes.t, 'a) T.t
2066
+
method modality : (Modality.t, 'a) T.t
2067
+
method modalities : (Modalities.t, 'a) T.t
2068
+
method signature_items : (signature_item list, 'a) T.t
2069
+
end
2070
+
end
2071
+
2072
+
module Jane_street_extensions1_ctx (T : sig
2073
+
type ('a, 'b, 'c) t
2074
+
end) =
2075
+
struct
2076
+
class type ['ctx, 'res] t = object
2077
+
method jkind_annotation : ('ctx, jkind_annotation, 'res) T.t
2078
+
method jkind_annotation_desc : ('ctx, jkind_annotation_desc, 'res) T.t
2079
+
method function_body : ('ctx, Pexp_function.function_body, 'res) T.t
2080
+
method function_param : ('ctx, Pexp_function.function_param, 'res) T.t
2081
+
method function_param_desc : ('ctx, Pexp_function.function_param_desc, 'res) T.t
2082
+
method function_constraint : ('ctx, Pexp_function.Function_constraint.t, 'res) T.t
2083
+
method type_constraint : ('ctx, Pexp_function.type_constraint, 'res) T.t
2084
+
method mode : ('ctx, Mode.t, 'res) T.t
2085
+
method modes : ('ctx, Modes.t, 'res) T.t
2086
+
method modality : ('ctx, Modality.t, 'res) T.t
2087
+
method modalities : ('ctx, Modalities.t, 'res) T.t
2088
+
method signature_items : ('ctx, signature_item list, 'res) T.t
2089
+
end
2090
+
end
2091
+
2092
+
module Ts = struct
2093
+
module Map = struct
2094
+
type 'a t = 'a Ppxlib_traverse_builtins.T.map
2095
+
end
2096
+
2097
+
module Iter = struct
2098
+
type 'a t = 'a Ppxlib_traverse_builtins.T.iter
2099
+
end
2100
+
2101
+
module Fold = struct
2102
+
type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold
2103
+
end
2104
+
2105
+
module Fold_map = struct
2106
+
type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold_map
2107
+
end
2108
+
2109
+
module Map_with_context = struct
2110
+
type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.map_with_context
2111
+
end
2112
+
2113
+
module Lift = struct
2114
+
type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.lift
2115
+
end
2116
+
2117
+
module Lift_map_with_context = struct
2118
+
type ('a, 'b, 'c) t = ('a, 'b, 'c) Ppxlib_traverse_builtins.T.lift_map_with_context
2119
+
end
2120
+
end
2121
+
2122
+
class virtual map =
2123
+
object
2124
+
inherit Ppxlib_ast.Ast.map
2125
+
inherit Deriving_inline.map
2126
+
end
2127
+
2128
+
class virtual iter =
2129
+
object
2130
+
inherit Ppxlib_ast.Ast.iter
2131
+
inherit Deriving_inline.iter
2132
+
end
2133
+
2134
+
class virtual ['ctx] fold =
2135
+
object
2136
+
inherit ['ctx] Ppxlib_ast.Ast.fold
2137
+
inherit ['ctx] Deriving_inline.fold
2138
+
end
2139
+
2140
+
class virtual ['ctx] fold_map =
2141
+
object
2142
+
inherit ['ctx] Ppxlib_ast.Ast.fold_map
2143
+
inherit ['ctx] Deriving_inline.fold_map
2144
+
end
2145
+
2146
+
class virtual ['ctx] map_with_context =
2147
+
object
2148
+
inherit ['ctx] Ppxlib_ast.Ast.map_with_context
2149
+
inherit ['ctx] Deriving_inline.map_with_context
2150
+
end
2151
+
2152
+
class virtual ['res] lift =
2153
+
object
2154
+
inherit ['res] Ppxlib_ast.Ast.lift
2155
+
inherit ['res] Deriving_inline.lift
2156
+
end
2157
+
2158
+
class virtual ['ctx, 'res] lift_map_with_context =
2159
+
object
2160
+
inherit ['ctx, 'res] Ppxlib_ast.Ast.lift_map_with_context
2161
+
inherit ['ctx, 'res] Deriving_inline.lift_map_with_context
2162
+
end
2163
+
end
+628
vendor/opam/ppxlib_jane/src/shim.mli
+628
vendor/opam/ppxlib_jane/src/shim.mli
···
1
+
open Astlib
2
+
open Ppxlib_ast.Asttypes
3
+
open Ppxlib_ast.Parsetree
4
+
5
+
(** This file can have a different implementation in the Jane Street experimental compiler
6
+
and the upstream compiler, allowing ppxes to easily work with both versions *)
7
+
8
+
module Mode : sig
9
+
(** The modes that can go on function arguments or return types *)
10
+
type t = Mode of string [@@unboxed]
11
+
end
12
+
13
+
module Modes : sig
14
+
type t = Mode.t loc list
15
+
16
+
val none : t
17
+
val local : loc:Location.t -> t
18
+
end
19
+
20
+
module Modality : sig
21
+
(** The modalities that can go on constructor fields *)
22
+
type t = Modality of string [@@unboxed]
23
+
end
24
+
25
+
module Modalities : sig
26
+
type t = Modality.t loc list
27
+
28
+
val none : t
29
+
val portable : loc:Location.t -> t
30
+
end
31
+
32
+
module Include_kind : sig
33
+
type t =
34
+
| Structure
35
+
| Functor
36
+
end
37
+
38
+
(** Function arguments; a value of this type represents:
39
+
- [arg_mode arg_type -> ...] when [arg_label] is {{!Asttypes.arg_label.Nolabel}
40
+
[Nolabel]},
41
+
- [l:arg_mode arg_type -> ...] when [arg_label] is {{!Asttypes.arg_label.Labelled}
42
+
[Labelled]}, and
43
+
- [?l:arg_mode arg_type -> ...] when [arg_label] is {{!Asttypes.arg_label.Optional}
44
+
[Optional]}. *)
45
+
type arrow_argument =
46
+
{ arg_label : arg_label
47
+
; arg_modes : Modes.t
48
+
; arg_type : core_type
49
+
}
50
+
51
+
(** Function return types; a value of this type represents
52
+
[... -> result_mode result_type]. *)
53
+
type arrow_result =
54
+
{ result_modes : Modes.t
55
+
; result_type : core_type
56
+
}
57
+
58
+
(** A list of this type is stored in the [Pcstr_tuple] constructor of
59
+
[constructor_arguments]. With JS extensions, fields in constructors can contain
60
+
modalities. *)
61
+
module Pcstr_tuple_arg : sig
62
+
type t = core_type
63
+
64
+
val extract_modalities : t -> Modalities.t * core_type
65
+
val to_core_type : t -> core_type
66
+
val of_core_type : core_type -> t
67
+
val map_core_type : t -> f:(core_type -> core_type) -> t
68
+
val map_core_type_extra : t -> f:(core_type -> core_type * 'a) -> t * 'a
69
+
70
+
(** [loc] is ignored if there is no modality. *)
71
+
val create : loc:Location.t -> modalities:Modalities.t -> type_:core_type -> t
72
+
end
73
+
74
+
(** This is an interface around the [Parsetree.label_declaration] type, describing one
75
+
label in a record declaration. *)
76
+
module Label_declaration : sig
77
+
val extract_modalities : label_declaration -> Modalities.t * label_declaration
78
+
79
+
val create
80
+
: loc:Location.t
81
+
-> name:string Location.loc
82
+
-> mutable_:mutable_flag
83
+
-> modalities:Modalities.t
84
+
-> type_:core_type
85
+
-> label_declaration
86
+
end
87
+
88
+
module Value_description : sig
89
+
val extract_modalities : value_description -> Modalities.t * value_description
90
+
91
+
val create
92
+
: loc:Location.t
93
+
-> name:string Location.loc
94
+
-> type_:core_type
95
+
-> modalities:Modalities.t
96
+
-> prim:string list
97
+
-> value_description
98
+
end
99
+
100
+
module Module_declaration : sig
101
+
type t =
102
+
{ pmd_name : string option loc
103
+
; pmd_type : module_type
104
+
; pmd_modalities : Modalities.t
105
+
; pmd_attributes : attributes (** [... [\@\@id1] [\@\@id2]] *)
106
+
; pmd_loc : Location.t
107
+
}
108
+
109
+
val to_parsetree : t -> module_declaration
110
+
val of_parsetree : module_declaration -> t
111
+
end
112
+
113
+
module Value_binding : sig
114
+
val extract_modes : value_binding -> Modes.t * value_binding
115
+
116
+
val create
117
+
: loc:Location.t
118
+
-> pat:pattern
119
+
-> expr:expression
120
+
-> modes:Modes.t
121
+
-> value_binding
122
+
end
123
+
124
+
type jkind_annotation_desc =
125
+
| Pjk_default
126
+
| Pjk_abbreviation of string
127
+
| Pjk_mod of jkind_annotation * Modes.t
128
+
| Pjk_with of jkind_annotation * core_type * Modalities.t
129
+
| Pjk_kind_of of core_type
130
+
| Pjk_product of jkind_annotation list
131
+
132
+
and jkind_annotation =
133
+
{ pjkind_loc : Location.t
134
+
; pjkind_desc : jkind_annotation_desc
135
+
}
136
+
137
+
module Type_declaration : sig
138
+
type t =
139
+
{ ptype_name : string loc
140
+
; ptype_params : (core_type * (variance * injectivity)) list
141
+
; ptype_cstrs : (core_type * core_type * Location.t) list
142
+
; ptype_kind : type_kind
143
+
; ptype_private : private_flag
144
+
; ptype_manifest : core_type option
145
+
; ptype_attributes : attributes
146
+
; ptype_jkind_annotation : jkind_annotation option
147
+
; ptype_loc : Location.t
148
+
}
149
+
150
+
val of_parsetree : type_declaration -> t
151
+
val to_parsetree : t -> type_declaration
152
+
val extract_jkind_annotation : type_declaration -> jkind_annotation option
153
+
end
154
+
155
+
module Constant : sig
156
+
type t =
157
+
| Pconst_integer of string * char option
158
+
| Pconst_unboxed_integer of string * char
159
+
| Pconst_char of char
160
+
| Pconst_untagged_char of char
161
+
| Pconst_string of string * Location.t * string option
162
+
| Pconst_float of string * char option
163
+
| Pconst_unboxed_float of string * char option
164
+
165
+
val of_parsetree : constant -> t
166
+
val to_parsetree : t -> constant
167
+
end
168
+
169
+
(** Match and construct [Pexp_function], as in the OCaml parsetree at or after 5.2. *)
170
+
module Pexp_function : sig
171
+
type function_param_desc =
172
+
| Pparam_val of arg_label * expression option * pattern
173
+
| Pparam_newtype of string loc * jkind_annotation option
174
+
175
+
type function_param =
176
+
{ pparam_loc : Location.t
177
+
; pparam_desc : function_param_desc
178
+
}
179
+
180
+
type type_constraint =
181
+
| Pconstraint of core_type
182
+
| Pcoerce of core_type option * core_type
183
+
184
+
module Function_constraint : sig
185
+
type t =
186
+
{ mode_annotations : Modes.t
187
+
; ret_mode_annotations : Modes.t
188
+
; ret_type_constraint : type_constraint option
189
+
}
190
+
191
+
val none : t
192
+
val is_none : t -> bool
193
+
end
194
+
195
+
type function_body =
196
+
| Pfunction_body of expression
197
+
| Pfunction_cases of case list * Location.t * attributes
198
+
199
+
val to_parsetree
200
+
: params:function_param list
201
+
-> constraint_:Function_constraint.t
202
+
-> body:function_body
203
+
-> expression_desc
204
+
205
+
val of_parsetree
206
+
: expression_desc
207
+
-> loc:Location.t
208
+
-> (function_param list * Function_constraint.t * function_body) option
209
+
end
210
+
211
+
type index_kind =
212
+
| Index_int
213
+
| Index_unboxed_int64
214
+
| Index_unboxed_int32
215
+
| Index_unboxed_int16
216
+
| Index_unboxed_int8
217
+
| Index_unboxed_nativeint
218
+
219
+
type block_access =
220
+
| Baccess_field of Longident.t loc
221
+
| Baccess_array of mutable_flag * index_kind * expression
222
+
| Baccess_block of mutable_flag * expression
223
+
224
+
type unboxed_access = Uaccess_unboxed_field of Longident.t loc
225
+
226
+
module Core_type_desc : sig
227
+
type t =
228
+
| Ptyp_any of jkind_annotation option
229
+
| Ptyp_var of string * jkind_annotation option
230
+
| Ptyp_arrow of arg_label * core_type * core_type * Modes.t * Modes.t
231
+
| Ptyp_tuple of (string option * core_type) list
232
+
| Ptyp_unboxed_tuple of (string option * core_type) list
233
+
| Ptyp_constr of Longident.t loc * core_type list
234
+
| Ptyp_object of object_field list * closed_flag
235
+
| Ptyp_class of Longident.t loc * core_type list
236
+
| Ptyp_alias of core_type * string loc option * jkind_annotation option
237
+
| Ptyp_variant of row_field list * closed_flag * label list option
238
+
| Ptyp_poly of (string loc * jkind_annotation option) list * core_type
239
+
| Ptyp_package of package_type
240
+
| Ptyp_quote of core_type
241
+
| Ptyp_splice of core_type
242
+
| Ptyp_of_kind of jkind_annotation
243
+
| Ptyp_extension of extension
244
+
245
+
val of_parsetree : core_type_desc -> t
246
+
val to_parsetree : t -> core_type_desc
247
+
end
248
+
249
+
module Core_type : sig
250
+
type t =
251
+
{ ptyp_desc : Core_type_desc.t
252
+
; ptyp_loc : Location.t
253
+
; ptyp_loc_stack : Location.t list
254
+
; ptyp_attributes : attributes
255
+
}
256
+
257
+
val of_parsetree : core_type -> t
258
+
val to_parsetree : t -> core_type
259
+
end
260
+
261
+
module Pattern_desc : sig
262
+
type t =
263
+
| Ppat_any
264
+
| Ppat_var of string loc
265
+
| Ppat_alias of pattern * string loc
266
+
| Ppat_constant of constant
267
+
| Ppat_interval of constant * constant
268
+
| Ppat_tuple of (string option * pattern) list * closed_flag
269
+
| Ppat_unboxed_tuple of (string option * pattern) list * closed_flag
270
+
| Ppat_construct of
271
+
Longident.t loc * ((string loc * jkind_annotation option) list * pattern) option
272
+
| Ppat_variant of label * pattern option
273
+
| Ppat_record of (Longident.t loc * pattern) list * closed_flag
274
+
| Ppat_record_unboxed_product of (Longident.t loc * pattern) list * closed_flag
275
+
| Ppat_array of mutable_flag * pattern list
276
+
| Ppat_or of pattern * pattern
277
+
| Ppat_constraint of pattern * core_type option * Modes.t
278
+
| Ppat_type of Longident.t loc
279
+
| Ppat_lazy of pattern
280
+
| Ppat_unpack of string option loc
281
+
| Ppat_exception of pattern
282
+
| Ppat_extension of extension
283
+
| Ppat_open of Longident.t loc * pattern
284
+
285
+
val of_parsetree : pattern_desc -> t
286
+
val to_parsetree : loc:Location.t -> t -> pattern_desc
287
+
end
288
+
289
+
module Expression_desc : sig
290
+
type comprehension_expression = private
291
+
| Pcomp_list_comprehension of unit
292
+
| Pcomp_array_comprehension of unit
293
+
294
+
type t =
295
+
| Pexp_ident of Longident.t loc
296
+
| Pexp_constant of constant
297
+
| Pexp_let of mutable_flag * rec_flag * value_binding list * expression
298
+
| Pexp_function of
299
+
Pexp_function.function_param list
300
+
* Pexp_function.Function_constraint.t
301
+
* Pexp_function.function_body
302
+
| Pexp_apply of expression * (arg_label * expression) list
303
+
| Pexp_match of expression * case list
304
+
| Pexp_try of expression * case list
305
+
| Pexp_tuple of (string option * expression) list
306
+
| Pexp_unboxed_tuple of (string option * expression) list
307
+
| Pexp_construct of Longident.t loc * expression option
308
+
| Pexp_variant of label * expression option
309
+
| Pexp_record of (Longident.t loc * expression) list * expression option
310
+
| Pexp_record_unboxed_product of
311
+
(Longident.t loc * expression) list * expression option
312
+
| Pexp_field of expression * Longident.t loc
313
+
| Pexp_unboxed_field of expression * Longident.t loc
314
+
| Pexp_setfield of expression * Longident.t loc * expression
315
+
| Pexp_array of mutable_flag * expression list
316
+
| Pexp_idx of block_access * unboxed_access list
317
+
| Pexp_ifthenelse of expression * expression * expression option
318
+
| Pexp_sequence of expression * expression
319
+
| Pexp_while of expression * expression
320
+
| Pexp_for of pattern * expression * expression * direction_flag * expression
321
+
| Pexp_constraint of expression * core_type option * Modes.t
322
+
| Pexp_coerce of expression * core_type option * core_type
323
+
| Pexp_send of expression * label loc
324
+
| Pexp_new of Longident.t loc
325
+
| Pexp_setvar of label loc * expression
326
+
| Pexp_override of (label loc * expression) list
327
+
| Pexp_letmodule of string option loc * module_expr * expression
328
+
| Pexp_letexception of extension_constructor * expression
329
+
| Pexp_assert of expression
330
+
| Pexp_lazy of expression
331
+
| Pexp_poly of expression * core_type option
332
+
| Pexp_object of class_structure
333
+
| Pexp_newtype of string loc * jkind_annotation option * expression
334
+
| Pexp_pack of module_expr
335
+
| Pexp_open of open_declaration * expression
336
+
| Pexp_letop of letop
337
+
| Pexp_extension of extension
338
+
| Pexp_unreachable
339
+
| Pexp_stack of expression
340
+
| Pexp_comprehension of comprehension_expression
341
+
| Pexp_overwrite of expression * expression
342
+
| Pexp_quote of expression
343
+
| Pexp_splice of expression
344
+
| Pexp_hole
345
+
346
+
val of_parsetree : expression_desc -> loc:Location.t -> t
347
+
val to_parsetree : loc:Location.t -> t -> expression_desc
348
+
end
349
+
350
+
module Type_kind : sig
351
+
type t =
352
+
| Ptype_abstract
353
+
| Ptype_variant of constructor_declaration list
354
+
| Ptype_record of label_declaration list
355
+
| Ptype_record_unboxed_product of label_declaration list
356
+
| Ptype_open
357
+
358
+
val of_parsetree : type_kind -> t
359
+
val to_parsetree : t -> type_kind
360
+
end
361
+
362
+
module Constructor_declaration : sig
363
+
val extract_vars_with_jkind_annotations
364
+
: constructor_declaration
365
+
-> (string loc * jkind_annotation option) list
366
+
367
+
val create
368
+
: name:string loc
369
+
-> vars:(string loc * jkind_annotation option) list
370
+
-> args:constructor_arguments
371
+
-> res:core_type option
372
+
-> loc:Location.t
373
+
-> constructor_declaration
374
+
end
375
+
376
+
module Include_infos : sig
377
+
type 'a t =
378
+
{ pincl_kind : Include_kind.t
379
+
; pincl_mod : 'a
380
+
; pincl_loc : Location.t
381
+
; pincl_attributes : attributes
382
+
}
383
+
384
+
val of_parsetree : 'a include_infos -> 'a t
385
+
val to_parsetree : 'a t -> 'a include_infos
386
+
end
387
+
388
+
module Signature_item_desc : sig
389
+
type t =
390
+
| Psig_value of value_description
391
+
| Psig_type of rec_flag * type_declaration list
392
+
| Psig_typesubst of type_declaration list
393
+
| Psig_typext of type_extension
394
+
| Psig_exception of type_exception
395
+
| Psig_module of module_declaration
396
+
| Psig_modsubst of module_substitution
397
+
| Psig_recmodule of module_declaration list
398
+
| Psig_modtype of module_type_declaration
399
+
| Psig_modtypesubst of module_type_declaration
400
+
| Psig_open of open_description
401
+
| Psig_include of include_description * Modalities.t
402
+
| Psig_class of class_description list
403
+
| Psig_class_type of class_type_declaration list
404
+
| Psig_attribute of attribute
405
+
| Psig_extension of extension * attributes
406
+
| Psig_kind_abbrev of string loc * jkind_annotation
407
+
408
+
val of_parsetree : signature_item_desc -> t
409
+
val to_parsetree : t -> signature_item_desc
410
+
end
411
+
412
+
module Signature : sig
413
+
type t =
414
+
{ psg_modalities : Modalities.t
415
+
; psg_items : signature_item list
416
+
; psg_loc : Location.t
417
+
}
418
+
419
+
val of_parsetree : signature -> t
420
+
val to_parsetree : t -> signature
421
+
end
422
+
423
+
module Structure_item_desc : sig
424
+
type t =
425
+
| Pstr_eval of expression * attributes
426
+
| Pstr_value of rec_flag * value_binding list
427
+
| Pstr_primitive of value_description
428
+
| Pstr_type of rec_flag * type_declaration list
429
+
| Pstr_typext of type_extension
430
+
| Pstr_exception of type_exception
431
+
| Pstr_module of module_binding
432
+
| Pstr_recmodule of module_binding list
433
+
| Pstr_modtype of module_type_declaration
434
+
| Pstr_open of open_declaration
435
+
| Pstr_class of class_declaration list
436
+
| Pstr_class_type of class_type_declaration list
437
+
| Pstr_include of include_declaration
438
+
| Pstr_attribute of attribute
439
+
| Pstr_extension of extension * attributes
440
+
| Pstr_kind_abbrev of string loc * jkind_annotation
441
+
442
+
val of_parsetree : structure_item_desc -> t
443
+
val to_parsetree : t -> structure_item_desc
444
+
end
445
+
446
+
module Functor_parameter : sig
447
+
type t =
448
+
| Unit
449
+
| Named of string option loc * module_type * Modes.t
450
+
451
+
val to_parsetree : t -> functor_parameter
452
+
val of_parsetree : functor_parameter -> t
453
+
end
454
+
455
+
module Module_type_desc : sig
456
+
type t =
457
+
| Pmty_ident of Longident.t loc
458
+
| Pmty_signature of signature
459
+
| Pmty_functor of functor_parameter * module_type * Modes.t
460
+
| Pmty_with of module_type * with_constraint list
461
+
| Pmty_typeof of module_expr
462
+
| Pmty_extension of extension
463
+
| Pmty_alias of Longident.t loc
464
+
| Pmty_strengthen of module_type * Longident.t loc
465
+
466
+
val of_parsetree : module_type_desc -> t
467
+
val to_parsetree : loc:Location.t -> t -> module_type_desc
468
+
end
469
+
470
+
module Module_expr_desc : sig
471
+
type module_instance = private Module_instance
472
+
473
+
type t =
474
+
| Pmod_ident of Longident.t loc
475
+
| Pmod_structure of structure
476
+
| Pmod_functor of functor_parameter * module_expr
477
+
| Pmod_apply of module_expr * module_expr
478
+
| Pmod_constraint of module_expr * module_type option * Modes.t
479
+
| Pmod_unpack of expression
480
+
| Pmod_extension of extension
481
+
| Pmod_instance of module_instance
482
+
483
+
val of_parsetree : module_expr_desc -> t
484
+
val to_parsetree : loc:Location.t -> t -> module_expr_desc
485
+
end
486
+
487
+
module Ast_traverse : sig
488
+
module Jane_street_extensions0 (T : sig
489
+
type 'a t
490
+
end) : sig
491
+
class type t = object
492
+
method jkind_annotation : jkind_annotation T.t
493
+
method jkind_annotation_desc : jkind_annotation_desc T.t
494
+
method function_body : Pexp_function.function_body T.t
495
+
method function_param : Pexp_function.function_param T.t
496
+
method function_param_desc : Pexp_function.function_param_desc T.t
497
+
method function_constraint : Pexp_function.Function_constraint.t T.t
498
+
method type_constraint : Pexp_function.type_constraint T.t
499
+
method mode : Mode.t T.t
500
+
method modes : Modes.t T.t
501
+
method modality : Modality.t T.t
502
+
method modalities : Modalities.t T.t
503
+
method signature_items : signature_item list T.t
504
+
end
505
+
end
506
+
507
+
module Jane_street_extensions0_ctx (T : sig
508
+
type ('a, 'b) t
509
+
end) : sig
510
+
class type ['ctx] t = object
511
+
method jkind_annotation : ('ctx, jkind_annotation) T.t
512
+
method jkind_annotation_desc : ('ctx, jkind_annotation_desc) T.t
513
+
method function_body : ('ctx, Pexp_function.function_body) T.t
514
+
method function_param : ('ctx, Pexp_function.function_param) T.t
515
+
method function_param_desc : ('ctx, Pexp_function.function_param_desc) T.t
516
+
method function_constraint : ('ctx, Pexp_function.Function_constraint.t) T.t
517
+
method type_constraint : ('ctx, Pexp_function.type_constraint) T.t
518
+
method mode : ('ctx, Mode.t) T.t
519
+
method modes : ('ctx, Modes.t) T.t
520
+
method modality : ('ctx, Modality.t) T.t
521
+
method modalities : ('ctx, Modalities.t) T.t
522
+
method signature_items : ('ctx, signature_item list) T.t
523
+
end
524
+
end
525
+
526
+
module Jane_street_extensions1 (T : sig
527
+
type ('a, 'b) t
528
+
end) : sig
529
+
class type ['a] t = object
530
+
method jkind_annotation : (jkind_annotation, 'a) T.t
531
+
method jkind_annotation_desc : (jkind_annotation_desc, 'a) T.t
532
+
method function_body : (Pexp_function.function_body, 'a) T.t
533
+
method function_param : (Pexp_function.function_param, 'a) T.t
534
+
method function_param_desc : (Pexp_function.function_param_desc, 'a) T.t
535
+
method function_constraint : (Pexp_function.Function_constraint.t, 'a) T.t
536
+
method type_constraint : (Pexp_function.type_constraint, 'a) T.t
537
+
method mode : (Mode.t, 'a) T.t
538
+
method modes : (Modes.t, 'a) T.t
539
+
method modality : (Modality.t, 'a) T.t
540
+
method modalities : (Modalities.t, 'a) T.t
541
+
method signature_items : (signature_item list, 'a) T.t
542
+
end
543
+
end
544
+
545
+
module Jane_street_extensions1_ctx (T : sig
546
+
type ('a, 'b, 'c) t
547
+
end) : sig
548
+
class type ['ctx, 'res] t = object
549
+
method jkind_annotation : ('ctx, jkind_annotation, 'res) T.t
550
+
method jkind_annotation_desc : ('ctx, jkind_annotation_desc, 'res) T.t
551
+
method function_body : ('ctx, Pexp_function.function_body, 'res) T.t
552
+
method function_param : ('ctx, Pexp_function.function_param, 'res) T.t
553
+
method function_param_desc : ('ctx, Pexp_function.function_param_desc, 'res) T.t
554
+
method function_constraint : ('ctx, Pexp_function.Function_constraint.t, 'res) T.t
555
+
method type_constraint : ('ctx, Pexp_function.type_constraint, 'res) T.t
556
+
method mode : ('ctx, Mode.t, 'res) T.t
557
+
method modes : ('ctx, Modes.t, 'res) T.t
558
+
method modality : ('ctx, Modality.t, 'res) T.t
559
+
method modalities : ('ctx, Modalities.t, 'res) T.t
560
+
method signature_items : ('ctx, signature_item list, 'res) T.t
561
+
end
562
+
end
563
+
564
+
module Ts : sig
565
+
module Map : sig
566
+
type 'a t = 'a Ppxlib_traverse_builtins.T.map
567
+
end
568
+
569
+
module Iter : sig
570
+
type 'a t = 'a Ppxlib_traverse_builtins.T.iter
571
+
end
572
+
573
+
module Fold : sig
574
+
type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold
575
+
end
576
+
577
+
module Fold_map : sig
578
+
type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold_map
579
+
end
580
+
581
+
module Map_with_context : sig
582
+
type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.map_with_context
583
+
end
584
+
585
+
module Lift : sig
586
+
type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.lift
587
+
end
588
+
589
+
module Lift_map_with_context : sig
590
+
type ('a, 'b, 'c) t = ('a, 'b, 'c) Ppxlib_traverse_builtins.T.lift_map_with_context
591
+
end
592
+
end
593
+
594
+
class virtual map : object
595
+
inherit Ppxlib_ast.Ast.map
596
+
inherit Jane_street_extensions0(Ts.Map).t
597
+
end
598
+
599
+
class virtual iter : object
600
+
inherit Ppxlib_ast.Ast.iter
601
+
inherit Jane_street_extensions0(Ts.Iter).t
602
+
end
603
+
604
+
class virtual ['ctx] fold : object
605
+
inherit ['ctx] Ppxlib_ast.Ast.fold
606
+
inherit ['ctx] Jane_street_extensions0_ctx(Ts.Fold).t
607
+
end
608
+
609
+
class virtual ['ctx] fold_map : object
610
+
inherit ['ctx] Ppxlib_ast.Ast.fold_map
611
+
inherit ['ctx] Jane_street_extensions0_ctx(Ts.Fold_map).t
612
+
end
613
+
614
+
class virtual ['ctx] map_with_context : object
615
+
inherit ['ctx] Ppxlib_ast.Ast.map_with_context
616
+
inherit ['ctx] Jane_street_extensions0_ctx(Ts.Map_with_context).t
617
+
end
618
+
619
+
class virtual ['res] lift : object
620
+
inherit ['res] Ppxlib_ast.Ast.lift
621
+
inherit ['res] Jane_street_extensions1(Ts.Lift).t
622
+
end
623
+
624
+
class virtual ['ctx, 'res] lift_map_with_context : object
625
+
inherit ['ctx, 'res] Ppxlib_ast.Ast.lift_map_with_context
626
+
inherit ['ctx, 'res] Jane_street_extensions1_ctx(Ts.Lift_map_with_context).t
627
+
end
628
+
end
+281
vendor/opam/ppxlib_jane/src/shim.mli.diff
+281
vendor/opam/ppxlib_jane/src/shim.mli.diff
···
1
+
8,12d7
2
+
< (** When you change one of [shim.{ml,mli}], please also consider if you need to make
3
+
< changes to the corresponding [shim_upstream.{ml,mli}]. A diff between the mli files is
4
+
< automatically generated at [shim.mli.diff], so you'll find out if you change one but
5
+
< not the other *)
6
+
<
7
+
15c10
8
+
< type t = mode = Mode of string [@@unboxed]
9
+
---
10
+
> type t = Mode of string [@@unboxed]
11
+
27c22
12
+
< type t = modality = Modality of string [@@unboxed]
13
+
---
14
+
> type t = Modality of string [@@unboxed]
15
+
38c33
16
+
< type t = include_kind =
17
+
---
18
+
> type t =
19
+
67c62
20
+
< type t = constructor_argument
21
+
---
22
+
> type t = core_type
23
+
106c101
24
+
< type t = module_declaration =
25
+
---
26
+
> type t =
27
+
129c124
28
+
< type nonrec jkind_annotation_desc = jkind_annotation_desc =
29
+
---
30
+
> type jkind_annotation_desc =
31
+
137c132
32
+
< type nonrec jkind_annotation = jkind_annotation =
33
+
---
34
+
> and jkind_annotation =
35
+
143c138
36
+
< type t = type_declaration =
37
+
---
38
+
> type t =
39
+
161c156
40
+
< type t = constant =
41
+
---
42
+
> type t =
43
+
176c171
44
+
< type nonrec function_param_desc = function_param_desc =
45
+
---
46
+
> type function_param_desc =
47
+
180c175
48
+
< type nonrec function_param = function_param =
49
+
---
50
+
> type function_param =
51
+
185c180
52
+
< type nonrec type_constraint = type_constraint =
53
+
---
54
+
> type type_constraint =
55
+
190c185
56
+
< type t = function_constraint =
57
+
---
58
+
> type t =
59
+
200c195
60
+
< type nonrec function_body = function_body =
61
+
---
62
+
> type function_body =
63
+
216c211
64
+
< type nonrec index_kind = index_kind =
65
+
---
66
+
> type index_kind =
67
+
224c219
68
+
< type nonrec block_access = block_access =
69
+
---
70
+
> type block_access =
71
+
229c224
72
+
< type nonrec unboxed_access = unboxed_access = Uaccess_unboxed_field of Longident.t loc
73
+
---
74
+
> type unboxed_access = Uaccess_unboxed_field of Longident.t loc
75
+
232c227
76
+
< type t = core_type_desc =
77
+
---
78
+
> type t =
79
+
255c250
80
+
< type t = core_type =
81
+
---
82
+
> type t =
83
+
267c262
84
+
< type t = pattern_desc =
85
+
---
86
+
> type t =
87
+
295c290,297
88
+
< type t = expression_desc =
89
+
---
90
+
>
91
+
> type comprehension_expression = private
92
+
> | Pcomp_list_comprehension of unit
93
+
> | Pcomp_array_comprehension of unit
94
+
>
95
+
> type t =
96
+
352c354
97
+
< type t = type_kind =
98
+
---
99
+
> type t =
100
+
378c380
101
+
< type 'a t = 'a include_infos =
102
+
---
103
+
> type 'a t =
104
+
390c392
105
+
< type t = signature_item_desc =
106
+
---
107
+
> type t =
108
+
414c416
109
+
< type t = signature =
110
+
---
111
+
> type t =
112
+
425c427
113
+
< type t = structure_item_desc =
114
+
---
115
+
> type t =
116
+
448c450
117
+
< type t = functor_parameter =
118
+
---
119
+
> type t =
120
+
457c459
121
+
< type t = module_type_desc =
122
+
---
123
+
> type t =
124
+
472c474,479
125
+
< type t = module_expr_desc =
126
+
---
127
+
>
128
+
> type module_instance = private Module_instance
129
+
>
130
+
> type t =
131
+
487,492c494,511
132
+
< class virtual map : Ppxlib_ast.Ast.map
133
+
< class virtual iter : Ppxlib_ast.Ast.iter
134
+
< class virtual ['acc] fold : ['acc] Ppxlib_ast.Ast.fold
135
+
< class virtual ['acc] fold_map : ['acc] Ppxlib_ast.Ast.fold_map
136
+
< class virtual ['ctx] map_with_context : ['ctx] Ppxlib_ast.Ast.map_with_context
137
+
< class virtual ['res] lift : ['res] Ppxlib_ast.Ast.lift
138
+
---
139
+
> module Jane_street_extensions0 (T : sig
140
+
> type 'a t
141
+
> end) : sig
142
+
> class type t = object
143
+
> method jkind_annotation : jkind_annotation T.t
144
+
> method jkind_annotation_desc : jkind_annotation_desc T.t
145
+
> method function_body : Pexp_function.function_body T.t
146
+
> method function_param : Pexp_function.function_param T.t
147
+
> method function_param_desc : Pexp_function.function_param_desc T.t
148
+
> method function_constraint : Pexp_function.Function_constraint.t T.t
149
+
> method type_constraint : Pexp_function.type_constraint T.t
150
+
> method mode : Mode.t T.t
151
+
> method modes : Modes.t T.t
152
+
> method modality : Modality.t T.t
153
+
> method modalities : Modalities.t T.t
154
+
> method signature_items : signature_item list T.t
155
+
> end
156
+
> end
157
+
494,495c513,633
158
+
< class virtual ['ctx, 'res] lift_map_with_context :
159
+
< ['ctx, 'res] Ppxlib_ast.Ast.lift_map_with_context
160
+
---
161
+
> module Jane_street_extensions0_ctx (T : sig
162
+
> type ('a, 'b) t
163
+
> end) : sig
164
+
> class type ['ctx] t = object
165
+
> method jkind_annotation : ('ctx, jkind_annotation) T.t
166
+
> method jkind_annotation_desc : ('ctx, jkind_annotation_desc) T.t
167
+
> method function_body : ('ctx, Pexp_function.function_body) T.t
168
+
> method function_param : ('ctx, Pexp_function.function_param) T.t
169
+
> method function_param_desc : ('ctx, Pexp_function.function_param_desc) T.t
170
+
> method function_constraint : ('ctx, Pexp_function.Function_constraint.t) T.t
171
+
> method type_constraint : ('ctx, Pexp_function.type_constraint) T.t
172
+
> method mode : ('ctx, Mode.t) T.t
173
+
> method modes : ('ctx, Modes.t) T.t
174
+
> method modality : ('ctx, Modality.t) T.t
175
+
> method modalities : ('ctx, Modalities.t) T.t
176
+
> method signature_items : ('ctx, signature_item list) T.t
177
+
> end
178
+
> end
179
+
>
180
+
> module Jane_street_extensions1 (T : sig
181
+
> type ('a, 'b) t
182
+
> end) : sig
183
+
> class type ['a] t = object
184
+
> method jkind_annotation : (jkind_annotation, 'a) T.t
185
+
> method jkind_annotation_desc : (jkind_annotation_desc, 'a) T.t
186
+
> method function_body : (Pexp_function.function_body, 'a) T.t
187
+
> method function_param : (Pexp_function.function_param, 'a) T.t
188
+
> method function_param_desc : (Pexp_function.function_param_desc, 'a) T.t
189
+
> method function_constraint : (Pexp_function.Function_constraint.t, 'a) T.t
190
+
> method type_constraint : (Pexp_function.type_constraint, 'a) T.t
191
+
> method mode : (Mode.t, 'a) T.t
192
+
> method modes : (Modes.t, 'a) T.t
193
+
> method modality : (Modality.t, 'a) T.t
194
+
> method modalities : (Modalities.t, 'a) T.t
195
+
> method signature_items : (signature_item list, 'a) T.t
196
+
> end
197
+
> end
198
+
>
199
+
> module Jane_street_extensions1_ctx (T : sig
200
+
> type ('a, 'b, 'c) t
201
+
> end) : sig
202
+
> class type ['ctx, 'res] t = object
203
+
> method jkind_annotation : ('ctx, jkind_annotation, 'res) T.t
204
+
> method jkind_annotation_desc : ('ctx, jkind_annotation_desc, 'res) T.t
205
+
> method function_body : ('ctx, Pexp_function.function_body, 'res) T.t
206
+
> method function_param : ('ctx, Pexp_function.function_param, 'res) T.t
207
+
> method function_param_desc : ('ctx, Pexp_function.function_param_desc, 'res) T.t
208
+
> method function_constraint : ('ctx, Pexp_function.Function_constraint.t, 'res) T.t
209
+
> method type_constraint : ('ctx, Pexp_function.type_constraint, 'res) T.t
210
+
> method mode : ('ctx, Mode.t, 'res) T.t
211
+
> method modes : ('ctx, Modes.t, 'res) T.t
212
+
> method modality : ('ctx, Modality.t, 'res) T.t
213
+
> method modalities : ('ctx, Modalities.t, 'res) T.t
214
+
> method signature_items : ('ctx, signature_item list, 'res) T.t
215
+
> end
216
+
> end
217
+
>
218
+
> module Ts : sig
219
+
> module Map : sig
220
+
> type 'a t = 'a Ppxlib_traverse_builtins.T.map
221
+
> end
222
+
>
223
+
> module Iter : sig
224
+
> type 'a t = 'a Ppxlib_traverse_builtins.T.iter
225
+
> end
226
+
>
227
+
> module Fold : sig
228
+
> type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold
229
+
> end
230
+
>
231
+
> module Fold_map : sig
232
+
> type ('a, 'b) t = ('b, 'a) Ppxlib_traverse_builtins.T.fold_map
233
+
> end
234
+
>
235
+
> module Map_with_context : sig
236
+
> type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.map_with_context
237
+
> end
238
+
>
239
+
> module Lift : sig
240
+
> type ('a, 'b) t = ('a, 'b) Ppxlib_traverse_builtins.T.lift
241
+
> end
242
+
>
243
+
> module Lift_map_with_context : sig
244
+
> type ('a, 'b, 'c) t = ('a, 'b, 'c) Ppxlib_traverse_builtins.T.lift_map_with_context
245
+
> end
246
+
> end
247
+
>
248
+
> class virtual map : object
249
+
> inherit Ppxlib_ast.Ast.map
250
+
> inherit Jane_street_extensions0(Ts.Map).t
251
+
> end
252
+
>
253
+
> class virtual iter : object
254
+
> inherit Ppxlib_ast.Ast.iter
255
+
> inherit Jane_street_extensions0(Ts.Iter).t
256
+
> end
257
+
>
258
+
> class virtual ['ctx] fold : object
259
+
> inherit ['ctx] Ppxlib_ast.Ast.fold
260
+
> inherit ['ctx] Jane_street_extensions0_ctx(Ts.Fold).t
261
+
> end
262
+
>
263
+
> class virtual ['ctx] fold_map : object
264
+
> inherit ['ctx] Ppxlib_ast.Ast.fold_map
265
+
> inherit ['ctx] Jane_street_extensions0_ctx(Ts.Fold_map).t
266
+
> end
267
+
>
268
+
> class virtual ['ctx] map_with_context : object
269
+
> inherit ['ctx] Ppxlib_ast.Ast.map_with_context
270
+
> inherit ['ctx] Jane_street_extensions0_ctx(Ts.Map_with_context).t
271
+
> end
272
+
>
273
+
> class virtual ['res] lift : object
274
+
> inherit ['res] Ppxlib_ast.Ast.lift
275
+
> inherit ['res] Jane_street_extensions1(Ts.Lift).t
276
+
> end
277
+
>
278
+
> class virtual ['ctx, 'res] lift_map_with_context : object
279
+
> inherit ['ctx, 'res] Ppxlib_ast.Ast.lift_map_with_context
280
+
> inherit ['ctx, 'res] Jane_street_extensions1_ctx(Ts.Lift_map_with_context).t
281
+
> end