@@ -41,8 +41,6 @@ open Jane_syntax_parsing
41
41
future syntax features to remember to do this wrapping.
42
42
*)
43
43
44
- module With_attributes = With_attributes
45
-
46
44
(* * List and array comprehensions *)
47
45
module Comprehensions = struct
48
46
let feature : Feature.t = Language_extension Comprehensions
@@ -94,9 +92,7 @@ module Comprehensions = struct
94
92
v}
95
93
*)
96
94
97
- let comprehension_expr names x =
98
- Expression. wrap_desc ~info: [] ~loc: x.pexp_loc @@
99
- Expression. make_jane_syntax feature names x
95
+ let comprehension_expr names x = Expression. make_jane_syntax feature names x
100
96
101
97
(* * First, we define how to go from the nice AST to the OCaml AST; this is
102
98
the [expr_of_...] family of expressions, culminating in
@@ -143,9 +139,9 @@ module Comprehensions = struct
143
139
clauses
144
140
(comprehension_expr [" body" ] body)))
145
141
146
- let expr_of ~loc cexpr =
142
+ let expr_of ~loc ? attrs cexpr =
147
143
(* See Note [Wrapping with make_entire_jane_syntax] *)
148
- Expression. make_entire_jane_syntax ~loc feature (fun () ->
144
+ let expr = Expression. make_entire_jane_syntax ~loc feature (fun () ->
149
145
match cexpr with
150
146
| Cexp_list_comprehension comp ->
151
147
expr_of_comprehension ~type_: [" list" ] comp
@@ -157,6 +153,10 @@ module Comprehensions = struct
157
153
| Immutable -> " immutable"
158
154
]
159
155
comp)
156
+ in
157
+ match attrs with
158
+ | None -> expr
159
+ | Some attrs -> { expr with pexp_attributes = expr.pexp_attributes @ attrs }
160
160
161
161
(* * Then, we define how to go from the OCaml AST to the nice AST; this is
162
162
the [..._of_expr] family of expressions, culminating in
@@ -286,22 +286,22 @@ module Immutable_arrays = struct
286
286
287
287
let feature : Feature.t = Language_extension Immutable_arrays
288
288
289
- let expr_of ~loc = function
289
+ let expr_of ~loc ? attrs = function
290
290
| Iaexp_immutable_array elts ->
291
291
(* See Note [Wrapping with make_entire_jane_syntax] *)
292
292
Expression. make_entire_jane_syntax ~loc feature (fun () ->
293
- Ast_helper.Exp. array elts)
293
+ Ast_helper.Exp. array ?attrs elts)
294
294
295
295
(* Returns remaining unconsumed attributes *)
296
296
let of_expr expr = match expr.pexp_desc with
297
297
| Pexp_array elts -> Iaexp_immutable_array elts, expr.pexp_attributes
298
298
| _ -> failwith " Malformed immutable array expression"
299
299
300
- let pat_of ~loc = function
300
+ let pat_of ~loc ? attrs = function
301
301
| Iapat_immutable_array elts ->
302
302
(* See Note [Wrapping with make_entire_jane_syntax] *)
303
303
Pattern. make_entire_jane_syntax ~loc feature (fun () ->
304
- Ast_helper.Pat. array elts)
304
+ Ast_helper.Pat. array ?attrs elts)
305
305
306
306
(* Returns remaining unconsumed attributes *)
307
307
let of_pat pat = match pat.ppat_desc with
@@ -351,10 +351,10 @@ module Strengthen = struct
351
351
the [(module M)] is a [Pmty_alias]. This isn't syntax we can write, but
352
352
[(module M)] can be the inferred type for [M], so this should be fine. *)
353
353
354
- let mty_of ~loc { mty; mod_id } =
354
+ let mty_of ~loc ? attrs { mty; mod_id } =
355
355
(* See Note [Wrapping with make_entire_jane_syntax] *)
356
356
Module_type. make_entire_jane_syntax ~loc feature (fun () ->
357
- Ast_helper.Mty. functor_ (Named (Location. mknoloc None , mty))
357
+ Ast_helper.Mty. functor_ ?attrs (Named (Location. mknoloc None , mty))
358
358
(Ast_helper.Mty. alias mod_id))
359
359
360
360
(* Returns remaining unconsumed attributes *)
@@ -404,15 +404,15 @@ module Unboxed_constants = struct
404
404
| Float (x , suffix ) -> Pconst_float (x, suffix)
405
405
| Integer (x , suffix ) -> Pconst_integer (x, Some suffix)
406
406
407
- let expr_of ~loc t =
407
+ let expr_of ~loc ? attrs t =
408
408
let constant = constant_of t in
409
409
Expression. make_entire_jane_syntax ~loc feature (fun () ->
410
- Ast_helper.Exp. constant constant)
410
+ Ast_helper.Exp. constant ?attrs constant)
411
411
412
- let pat_of ~loc t =
412
+ let pat_of ~loc ? attrs t =
413
413
let constant = constant_of t in
414
414
Pattern. make_entire_jane_syntax ~loc feature (fun () ->
415
- Ast_helper.Pat. constant constant)
415
+ Ast_helper.Pat. constant ?attrs constant)
416
416
end
417
417
418
418
(* *****************************************************************************)
@@ -463,10 +463,10 @@ module Expression = struct
463
463
464
464
let of_ast = Expression. make_of_ast ~of_ast_internal
465
465
466
- let expr_of ~loc = function
467
- | Jexp_comprehension x -> Comprehensions. expr_of ~loc x
468
- | Jexp_immutable_array x -> Immutable_arrays. expr_of ~loc x
469
- | Jexp_unboxed_constant x -> Unboxed_constants. expr_of ~loc x
466
+ let expr_of ~loc ? attrs = function
467
+ | Jexp_comprehension x -> Comprehensions. expr_of ~loc ?attrs x
468
+ | Jexp_immutable_array x -> Immutable_arrays. expr_of ~loc ?attrs x
469
+ | Jexp_unboxed_constant x -> Unboxed_constants. expr_of ~loc ?attrs x
470
470
end
471
471
472
472
module Pattern = struct
@@ -485,9 +485,9 @@ module Pattern = struct
485
485
486
486
let of_ast = Pattern. make_of_ast ~of_ast_internal
487
487
488
- let pat_of ~loc = function
489
- | Jpat_immutable_array x -> Immutable_arrays. pat_of ~loc x
490
- | Jpat_unboxed_constant x -> Unboxed_constants. pat_of ~loc x
488
+ let pat_of ~loc ? attrs = function
489
+ | Jpat_immutable_array x -> Immutable_arrays. pat_of ~loc ?attrs x
490
+ | Jpat_unboxed_constant x -> Unboxed_constants. pat_of ~loc ?attrs x
491
491
end
492
492
493
493
module Module_type = struct
0 commit comments