@@ -426,13 +426,10 @@ let local_module_name =
426
426
427
427
(* Unpack requires core_type package for type inference;
428
428
use module type bindings and a function to create safe local names instead. *)
429
- let local_module_type_name =
430
- let v = ref 0 in
431
- fun ({txt} : Longident.t Location.loc ) ->
432
- incr v;
433
- " __"
434
- ^ (Longident. flatten txt |> List. fold_left (fun ll l -> ll ^ l) " " )
435
- ^ string_of_int ! v ^ " __"
429
+ let local_module_type_name txt =
430
+ " _"
431
+ ^ (Longident. flatten txt |> List. fold_left (fun ll l -> ll ^ " _" ^ l) " " )
432
+ ^ " __"
436
433
437
434
let expand_reverse (stru : Ast_structure.t ) (acc : Ast_structure.t ) :
438
435
Ast_structure. t =
@@ -466,14 +463,15 @@ let expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) :
466
463
}
467
464
:: acc)
468
465
469
- let rec structure_mapper (self : mapper ) (stru : Ast_structure.t ) =
466
+ let rec structure_mapper ~await_context (self : mapper ) (stru : Ast_structure.t )
467
+ =
470
468
match stru with
471
469
| [] -> []
472
470
| item :: rest -> (
473
471
match item.pstr_desc with
474
472
| Pstr_extension (({txt = "bs.raw" | "raw" ; loc} , payload ), _attrs ) ->
475
473
Ast_exp_handle_external. handle_raw_structure loc payload
476
- :: structure_mapper self rest
474
+ :: structure_mapper ~await_context self rest
477
475
(* | Pstr_extension (({txt = "i"}, _),_)
478
476
->
479
477
structure_mapper self rest *)
@@ -490,7 +488,7 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) =
490
488
next
491
489
| PSig _ | PTyp _ | PPat _ ->
492
490
Location. raise_errorf ~loc " private extension is not support" )
493
- | _ -> expand_reverse acc (structure_mapper self rest)
491
+ | _ -> expand_reverse acc (structure_mapper ~await_context self rest)
494
492
in
495
493
aux [] stru
496
494
(* Dynamic import of module transformation: module M = @res.await Belt.List *)
@@ -499,30 +497,49 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) =
499
497
as mb)
500
498
when Res_parsetree_viewer. hasAwaitAttribute pmod_attributes ->
501
499
let item = self.structure_item self item in
502
- let safe_module_type_name = local_module_type_name {txt; loc} in
500
+ let safe_module_type_name = local_module_type_name txt in
501
+ let has_local_module_name =
502
+ Hashtbl. find_opt ! await_context safe_module_type_name
503
+ in
504
+ (* module __Belt_List__ = module type of Belt.List *)
503
505
let module_type_decl =
504
- let open Ast_helper in
505
- Str. modtype ~loc
506
- (Mtd. mk ~loc
507
- {txt = safe_module_type_name; loc}
508
- ~typ: (Mty. typeof_ ~loc me))
506
+ match has_local_module_name with
507
+ | Some _ -> []
508
+ | None ->
509
+ let open Ast_helper in
510
+ Hashtbl. add ! await_context safe_module_type_name safe_module_type_name;
511
+ [
512
+ Str. modtype ~loc
513
+ (Mtd. mk ~loc
514
+ {txt = safe_module_type_name; loc}
515
+ ~typ: (Mty. typeof_ ~loc me));
516
+ ]
509
517
in
510
- (* module __BeltList1__ = module type of Belt.List *)
511
518
module_type_decl
512
- :: {
513
- item with
514
- pstr_desc =
515
- Pstr_module
516
- {
517
- mb with
518
- pmb_expr =
519
- Ast_await. create_await_module_expression
520
- ~module_type_name: safe_module_type_name mb.pmb_expr;
521
- };
522
- }
523
- (* module M = @res.await Belt.List *)
524
- :: structure_mapper self rest
525
- | _ -> self.structure_item self item :: structure_mapper self rest)
519
+ @ (* module M = @res.await Belt.List *)
520
+ {
521
+ item with
522
+ pstr_desc =
523
+ Pstr_module
524
+ {
525
+ mb with
526
+ pmb_expr =
527
+ Ast_await. create_await_module_expression
528
+ ~module_type_name: safe_module_type_name mb.pmb_expr;
529
+ };
530
+ }
531
+ :: structure_mapper ~await_context self rest
532
+ | _ ->
533
+ self.structure_item self item :: structure_mapper ~await_context self rest
534
+ )
535
+
536
+ let structure_mapper ~await_context (self : mapper ) (stru : Ast_structure.t ) =
537
+ let await_saved = ! await_context in
538
+ let result =
539
+ structure_mapper ~await_context: (ref (Hashtbl. create 10 )) self stru
540
+ in
541
+ await_context := await_saved;
542
+ result
526
543
527
544
let mapper : mapper =
528
545
{
@@ -533,7 +550,7 @@ let mapper : mapper =
533
550
signature_item = signature_item_mapper;
534
551
value_bindings = Ast_tuple_pattern_flatten. value_bindings_mapper;
535
552
structure_item = structure_item_mapper;
536
- structure = structure_mapper;
553
+ structure = structure_mapper ~await_context: ( ref ( Hashtbl. create 10 )) ;
537
554
(* Ad-hoc way to internalize stuff *)
538
555
label_declaration =
539
556
(fun self lbl ->
0 commit comments