Skip to content

Commit 02f2b39

Browse files
committed
cleanup
1 parent 3366ba2 commit 02f2b39

File tree

6 files changed

+197
-217
lines changed

6 files changed

+197
-217
lines changed

jscomp/core/js_packages_info.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,8 @@ let is_runtime_package (x : t) = x.name = Pkg_runtime
8484

8585
let iter (x : t) cb = Ext_list.iter x.module_systems cb
8686

87+
let map (x : t) cb = List.map cb x.module_systems
88+
8789
(* let equal (x : t) ({name; module_systems}) =
8890
x.name = name &&
8991
Ext_list.for_all2_no_exn

jscomp/core/js_packages_info.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,8 @@ val same_package_by_name : t -> t -> bool
4646

4747
val iter : t -> (package_info -> unit) -> unit
4848

49+
val map : t -> (package_info -> 'a) -> 'a list
50+
4951
val empty : t
5052

5153
val from_name : string -> t

jscomp/core/lam_compile_primitive.ml

Lines changed: 46 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,45 @@ let ensure_value_unit (st : Lam_compile_context.continuation) e : E.t =
3636
| EffectCall Not_tail -> e
3737
(* NeedValue should return a meaningful expression*)
3838

39+
let rec module_of_expression = function
40+
| J.Var (J.Qualified (module_id, value)) -> [ (module_id, value) ]
41+
| J.Caml_block (exprs, _, _, _) ->
42+
exprs
43+
|> List.map (fun (e : J.expression) ->
44+
module_of_expression e.expression_desc)
45+
|> List.concat
46+
| _ -> []
47+
48+
let get_module_system () =
49+
let packages_info = Js_packages_state.get_packages_info () in
50+
let module_systems =
51+
Js_packages_info.map packages_info (fun { module_system } -> module_system)
52+
in
53+
match module_systems with
54+
| [] -> assert false
55+
| module_system :: _rest -> module_system
56+
57+
let import_of_path path =
58+
E.call
59+
~info:{ arity = Full; call_info = Call_na }
60+
(E.js_global "import")
61+
[ E.str path ]
62+
63+
let wrap_then import value =
64+
let arg = Ident.create "m" in
65+
E.call
66+
~info:{ arity = Full; call_info = Call_na }
67+
(E.dot import "then")
68+
[
69+
E.ocaml_fun ~return_unit:false ~async:false [ arg ]
70+
[
71+
{
72+
statement_desc = J.Return (E.dot (E.var arg) value);
73+
comment = None;
74+
};
75+
];
76+
]
77+
3978
let translate ?output_prefix loc (cxt : Lam_compile_context.t)
4079
(prim : Lam_primitive.t) (args : J.expression list) : J.expression =
4180
match prim with
@@ -87,69 +126,21 @@ let translate ?output_prefix loc (cxt : Lam_compile_context.t)
87126
| Some output_prefix -> (
88127
let output_dir = Filename.dirname output_prefix in
89128

90-
(* TODO: pull this function out to top-level *)
91-
let rec module_of_expression = function
92-
| J.Var (J.Qualified (module_id, value)) ->
93-
[ (module_id, value) ]
94-
| J.Caml_block (exprs, _, _, _) ->
95-
exprs
96-
|> List.map (fun (e : J.expression) ->
97-
module_of_expression e.expression_desc)
98-
|> List.concat
99-
| _ -> []
100-
in
101-
102-
let module_id, value =
129+
let module_id, module_value =
103130
match module_of_expression e.expression_desc with
104-
| [ module_name ] -> module_name
131+
| [ module_ ] -> module_
105132
| _ -> assert false
106133
(* TODO: graceful error message here *)
107134
in
108135

109-
let packages_info = Js_packages_state.get_packages_info () in
110-
111-
let module_system = ref None in
112-
let _ =
113-
Js_packages_info.iter packages_info
114-
(fun { module_system = ms } -> module_system := Some ms)
115-
in
116-
117136
let path =
118-
match !module_system with
119-
| Some module_system ->
120-
Js_name_of_module_id.string_of_module_id module_id
121-
~output_dir module_system
122-
| _ -> assert false
137+
Js_name_of_module_id.string_of_module_id module_id
138+
~output_dir (get_module_system ())
123139
in
124140

125-
let arg_of_callback_fn = Ident.create "m" in
126-
match value with
127-
| Some value ->
128-
E.call
129-
~info:{ arity = Full; call_info = Call_na }
130-
(E.dot
131-
(E.call
132-
~info:{ arity = Full; call_info = Call_na }
133-
(E.js_global "import")
134-
[ E.str path ])
135-
"then")
136-
[
137-
E.ocaml_fun ~return_unit:false ~async:false
138-
[ arg_of_callback_fn ]
139-
[
140-
{
141-
statement_desc =
142-
J.Return
143-
(E.dot (E.var arg_of_callback_fn) value);
144-
comment = None;
145-
};
146-
];
147-
]
148-
| None ->
149-
E.call
150-
~info:{ arity = Full; call_info = Call_na }
151-
(E.js_global "import")
152-
[ E.str path ])
141+
match module_value with
142+
| Some value -> wrap_then (import_of_path path) value
143+
| None -> import_of_path path)
153144
| None -> assert false))
154145
| _ -> assert false)
155146
| Pjs_function_length -> E.function_length (Ext_list.singleton_exn args)

lib/4.06.1/unstable/js_compiler.ml

Lines changed: 49 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -81420,6 +81420,8 @@ val same_package_by_name : t -> t -> bool
8142081420

8142181421
val iter : t -> (package_info -> unit) -> unit
8142281422

81423+
val map : t -> (package_info -> 'a) -> 'a list
81424+
8142381425
val empty : t
8142481426

8142581427
val from_name : string -> t
@@ -81539,6 +81541,8 @@ let is_runtime_package (x : t) = x.name = Pkg_runtime
8153981541

8154081542
let iter (x : t) cb = Ext_list.iter x.module_systems cb
8154181543

81544+
let map (x : t) cb = List.map cb x.module_systems
81545+
8154281546
(* let equal (x : t) ({name; module_systems}) =
8154381547
x.name = name &&
8154481548
Ext_list.for_all2_no_exn
@@ -96648,6 +96652,45 @@ let ensure_value_unit (st : Lam_compile_context.continuation) e : E.t =
9664896652
| EffectCall Not_tail -> e
9664996653
(* NeedValue should return a meaningful expression*)
9665096654

96655+
let rec module_of_expression = function
96656+
| J.Var (J.Qualified (module_id, value)) -> [ (module_id, value) ]
96657+
| J.Caml_block (exprs, _, _, _) ->
96658+
exprs
96659+
|> List.map (fun (e : J.expression) ->
96660+
module_of_expression e.expression_desc)
96661+
|> List.concat
96662+
| _ -> []
96663+
96664+
let get_module_system () =
96665+
let packages_info = Js_packages_state.get_packages_info () in
96666+
let module_systems =
96667+
Js_packages_info.map packages_info (fun { module_system } -> module_system)
96668+
in
96669+
match module_systems with
96670+
| [] -> assert false
96671+
| module_system :: _rest -> module_system
96672+
96673+
let import_of_path path =
96674+
E.call
96675+
~info:{ arity = Full; call_info = Call_na }
96676+
(E.js_global "import")
96677+
[ E.str path ]
96678+
96679+
let wrap_then import value =
96680+
let arg = Ident.create "m" in
96681+
E.call
96682+
~info:{ arity = Full; call_info = Call_na }
96683+
(E.dot import "then")
96684+
[
96685+
E.ocaml_fun ~return_unit:false ~async:false [ arg ]
96686+
[
96687+
{
96688+
statement_desc = J.Return (E.dot (E.var arg) value);
96689+
comment = None;
96690+
};
96691+
];
96692+
]
96693+
9665196694
let translate ?output_prefix loc (cxt : Lam_compile_context.t)
9665296695
(prim : Lam_primitive.t) (args : J.expression list) : J.expression =
9665396696
match prim with
@@ -96699,69 +96742,21 @@ let translate ?output_prefix loc (cxt : Lam_compile_context.t)
9669996742
| Some output_prefix -> (
9670096743
let output_dir = Filename.dirname output_prefix in
9670196744

96702-
(* TODO: pull this function out to top-level *)
96703-
let rec module_of_expression = function
96704-
| J.Var (J.Qualified (module_id, value)) ->
96705-
[ (module_id, value) ]
96706-
| J.Caml_block (exprs, _, _, _) ->
96707-
exprs
96708-
|> List.map (fun (e : J.expression) ->
96709-
module_of_expression e.expression_desc)
96710-
|> List.concat
96711-
| _ -> []
96712-
in
96713-
96714-
let module_id, value =
96745+
let module_id, module_value =
9671596746
match module_of_expression e.expression_desc with
9671696747
| [ module_name ] -> module_name
9671796748
| _ -> assert false
9671896749
(* TODO: graceful error message here *)
9671996750
in
9672096751

96721-
let packages_info = Js_packages_state.get_packages_info () in
96722-
96723-
let module_system = ref None in
96724-
let _ =
96725-
Js_packages_info.iter packages_info
96726-
(fun { module_system = ms } -> module_system := Some ms)
96727-
in
96728-
9672996752
let path =
96730-
match !module_system with
96731-
| Some module_system ->
96732-
Js_name_of_module_id.string_of_module_id module_id
96733-
~output_dir module_system
96734-
| _ -> assert false
96753+
Js_name_of_module_id.string_of_module_id module_id
96754+
~output_dir (get_module_system ())
9673596755
in
9673696756

96737-
let arg_of_callback_fn = Ident.create "m" in
96738-
match value with
96739-
| Some value ->
96740-
E.call
96741-
~info:{ arity = Full; call_info = Call_na }
96742-
(E.dot
96743-
(E.call
96744-
~info:{ arity = Full; call_info = Call_na }
96745-
(E.js_global "import")
96746-
[ E.str path ])
96747-
"then")
96748-
[
96749-
E.ocaml_fun ~return_unit:false ~async:false
96750-
[ arg_of_callback_fn ]
96751-
[
96752-
{
96753-
statement_desc =
96754-
J.Return
96755-
(E.dot (E.var arg_of_callback_fn) value);
96756-
comment = None;
96757-
};
96758-
];
96759-
]
96760-
| None ->
96761-
E.call
96762-
~info:{ arity = Full; call_info = Call_na }
96763-
(E.js_global "import")
96764-
[ E.str path ])
96757+
match module_value with
96758+
| Some value -> wrap_then (import_of_path path) value
96759+
| None -> import_of_path path)
9676596760
| None -> assert false))
9676696761
| _ -> assert false)
9676796762
| Pjs_function_length -> E.function_length (Ext_list.singleton_exn args)

0 commit comments

Comments
 (0)