@@ -72,6 +72,13 @@ let pat_mapper (self : mapper) (p : Parsetree.pattern) =
7272 Ast_utf8_string_interp. transform_pat p s delim
7373 | _ -> default_pat_mapper self p
7474
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+
7582let expr_mapper ~async_context ~in_function_def (self : mapper )
7683 (e : Parsetree.expression ) =
7784 let old_in_function_def = ! in_function_def in
@@ -214,6 +221,42 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
214221 the attribute to the whole expression, in general, when shuffuling the ast
215222 it is very hard to place attributes correctly
216223 *)
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+ }
217260 | _ -> default_expr_mapper self e
218261
219262let expr_mapper ~async_context ~in_function_def (self : mapper )
@@ -424,13 +467,6 @@ let local_module_name =
424467 incr v;
425468 " local_" ^ string_of_int ! v
426469
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-
434470let expand_reverse (stru : Ast_structure.t ) (acc : Ast_structure.t ) :
435471 Ast_structure. t =
436472 if stru = [] then acc
@@ -509,15 +545,18 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
509545 match has_local_module_name with
510546 | Some _ -> []
511547 | None ->
512- let open Ast_helper in
513548 Hashtbl. add ! await_context safe_module_type_name safe_module_type_name;
514549 [
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)));
519555 ]
520556 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
521560 module_type_decl
522561 @ (* module M = @res.await Belt.List *)
523562 {
@@ -528,10 +567,44 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
528567 mb with
529568 pmb_expr =
530569 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;
532571 };
533572 }
534573 :: 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)
535608 | _ ->
536609 self.structure_item self item :: structure_mapper ~await_context self rest
537610 )
0 commit comments