@@ -72,6 +72,13 @@ let pat_mapper (self : mapper) (p : Parsetree.pattern) =
72
72
Ast_utf8_string_interp. transform_pat p s delim
73
73
| _ -> default_pat_mapper self p
74
74
75
+ (* Unpack requires core_type package for type inference:
76
+ Generate a module type name eg. __Belt_List__*)
77
+ let local_module_type_name txt =
78
+ " _"
79
+ ^ (Longident. flatten txt |> List. fold_left (fun ll l -> ll ^ " _" ^ l) " " )
80
+ ^ " __"
81
+
75
82
let expr_mapper ~async_context ~in_function_def (self : mapper )
76
83
(e : Parsetree.expression ) =
77
84
let old_in_function_def = ! in_function_def in
@@ -214,6 +221,42 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
214
221
the attribute to the whole expression, in general, when shuffuling the ast
215
222
it is very hard to place attributes correctly
216
223
*)
224
+ (* module M = await Belt.List *)
225
+ | Pexp_letmodule
226
+ (lid, ({pmod_desc = Pmod_ident {txt}; pmod_attributes} as me), expr)
227
+ when Res_parsetree_viewer. hasAwaitAttribute pmod_attributes ->
228
+ let safe_module_type_lid : Ast_helper.lid =
229
+ {txt = Lident (local_module_type_name txt); loc = me.pmod_loc}
230
+ in
231
+ {
232
+ e with
233
+ pexp_desc =
234
+ Pexp_letmodule
235
+ ( lid,
236
+ Ast_await. create_await_module_expression
237
+ ~module_type_lid: safe_module_type_lid me,
238
+ self.expr self expr );
239
+ }
240
+ (* module M = await (Belt.List: BeltList) *)
241
+ | Pexp_letmodule
242
+ ( lid,
243
+ ({
244
+ pmod_desc =
245
+ Pmod_constraint
246
+ ({pmod_desc = Pmod_ident _}, {pmty_desc = Pmty_ident mtyp_lid});
247
+ pmod_attributes;
248
+ } as me),
249
+ expr )
250
+ when Res_parsetree_viewer. hasAwaitAttribute pmod_attributes ->
251
+ {
252
+ e with
253
+ pexp_desc =
254
+ Pexp_letmodule
255
+ ( lid,
256
+ Ast_await. create_await_module_expression ~module_type_lid: mtyp_lid
257
+ me,
258
+ self.expr self expr );
259
+ }
217
260
| _ -> default_expr_mapper self e
218
261
219
262
let expr_mapper ~async_context ~in_function_def (self : mapper )
@@ -424,13 +467,6 @@ let local_module_name =
424
467
incr v;
425
468
" local_" ^ string_of_int ! v
426
469
427
- (* Unpack requires core_type package for type inference:
428
- Generate a module type name eg. __Belt_List__*)
429
- let local_module_type_name txt =
430
- " _"
431
- ^ (Longident. flatten txt |> List. fold_left (fun ll l -> ll ^ " _" ^ l) " " )
432
- ^ " __"
433
-
434
470
let expand_reverse (stru : Ast_structure.t ) (acc : Ast_structure.t ) :
435
471
Ast_structure. t =
436
472
if stru = [] then acc
@@ -509,15 +545,18 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
509
545
match has_local_module_name with
510
546
| Some _ -> []
511
547
| None ->
512
- let open Ast_helper in
513
548
Hashtbl. add ! await_context safe_module_type_name safe_module_type_name;
514
549
[
515
- Str. modtype ~loc
516
- (Mtd. mk ~loc
517
- {txt = safe_module_type_name; loc}
518
- ~typ: (Mty. typeof_ ~loc me));
550
+ Ast_helper. (
551
+ Str. modtype ~loc
552
+ (Mtd. mk ~loc
553
+ {txt = safe_module_type_name; loc}
554
+ ~typ: (Mty. typeof_ ~loc me)));
519
555
]
520
556
in
557
+ let safe_module_type_lid : Ast_helper.lid =
558
+ {txt = Lident safe_module_type_name; loc = mb.pmb_expr.pmod_loc}
559
+ in
521
560
module_type_decl
522
561
@ (* module M = @res.await Belt.List *)
523
562
{
@@ -528,10 +567,44 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
528
567
mb with
529
568
pmb_expr =
530
569
Ast_await. create_await_module_expression
531
- ~module_type_name: safe_module_type_name mb.pmb_expr;
570
+ ~module_type_lid: safe_module_type_lid mb.pmb_expr;
532
571
};
533
572
}
534
573
:: structure_mapper ~await_context self rest
574
+ | Pstr_value (_ , vbs ) ->
575
+ let item = self.structure_item self item in
576
+ (* [ module __Belt_List__ = module type of Belt.List ] *)
577
+ let module_type_decls =
578
+ vbs
579
+ |> List. filter_map (fun ({pvb_expr} : Parsetree.value_binding ) ->
580
+ match pvb_expr.pexp_desc with
581
+ | Pexp_letmodule
582
+ ( _,
583
+ ({pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as
584
+ me),
585
+ _ )
586
+ when Res_parsetree_viewer. hasAwaitAttribute pmod_attributes
587
+ -> (
588
+ let safe_module_type_name = local_module_type_name txt in
589
+ let has_local_module_name =
590
+ Hashtbl. find_opt ! await_context safe_module_type_name
591
+ in
592
+
593
+ match has_local_module_name with
594
+ | Some _ -> None
595
+ | None ->
596
+ Hashtbl. add ! await_context safe_module_type_name
597
+ safe_module_type_name;
598
+ Some
599
+ Ast_helper. (
600
+ Str. modtype ~loc
601
+ (Mtd. mk ~loc
602
+ {txt = safe_module_type_name; loc}
603
+ ~typ: (Mty. typeof_ ~loc me))))
604
+ | _ -> None )
605
+ in
606
+
607
+ module_type_decls @ (item :: structure_mapper ~await_context self rest)
535
608
| _ ->
536
609
self.structure_item self item :: structure_mapper ~await_context self rest
537
610
)
0 commit comments