Skip to content

Commit 32408a8

Browse files
bobzhangbobzhang
committed
better/faster bundler (rescript-lang#331)
* [refact] clean * [refact] now the api is ready * [refact] better/fast bundler
1 parent 1102d80 commit 32408a8

File tree

6 files changed

+1090
-842
lines changed

6 files changed

+1090
-842
lines changed

‎jscomp/tools/ocaml_extract.ml

+164-110
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,8 @@ let merge (files : (string * file_kind * Depend.StringSet.t) list ) =
4141
) files in tbl
4242

4343

44-
let sort_files_by_dependencies (files : (string * file_kind * Depend.StringSet.t) list)
44+
let sort_files_by_dependencies
45+
(files : (string * file_kind * Depend.StringSet.t) list)
4546
=
4647
let h : (string, Depend.StringSet.t) Hashtbl.t = merge files in
4748
let () =
@@ -88,140 +89,193 @@ let sort_files_by_dependencies (files : (string * file_kind * Depend.StringSet.t
8889
done;
8990
result
9091
;;
91-
92-
let process arg_files : Parsetree.structure_item =
93-
(* let len = Array.length Sys.argv in *)
92+
93+
type 'a code_info =
94+
{
95+
name : string ;
96+
content : string;
97+
ast : 'a
98+
}
99+
100+
type ml_info = Parsetree.structure code_info
101+
102+
type mli_info = Parsetree.signature code_info
103+
104+
(** on 32 bit , there are 16M limitation *)
105+
let load_file f =
106+
let ic = open_in f in
107+
let n = in_channel_length ic in
108+
let s = Bytes.create n in
109+
really_input ic s 0 n;
110+
close_in ic;
111+
Bytes.unsafe_to_string s
112+
113+
let _loc = Location.none
114+
115+
let assemble ast_tbl stack =
116+
let structure_items = ref [] in
117+
let visited = Hashtbl.create 31 in
118+
Stack.iter
119+
(fun base ->
120+
match Hashtbl.find visited base with
121+
| exception Not_found ->
122+
Hashtbl.add visited base ();
123+
begin match Hashtbl.find_all ast_tbl base with
124+
| `ml {ast = structure; _}:: `mli { ast = signature; _}::[]
125+
| `mli { ast = signature; _} ::`ml { ast = structure; _}::[] ->
126+
let v: Parsetree.structure_item =
127+
{
128+
Parsetree.pstr_loc = _loc;
129+
pstr_desc =
130+
(Pstr_module
131+
{
132+
pmb_name =
133+
{ txt = (String.capitalize base); loc = _loc
134+
};
135+
pmb_expr =
136+
{
137+
pmod_desc =
138+
(Pmod_constraint
139+
({
140+
pmod_desc =
141+
(Pmod_structure structure);
142+
pmod_loc = _loc;
143+
pmod_attributes = []
144+
},
145+
({
146+
pmty_desc =
147+
(Pmty_signature signature);
148+
pmty_loc = _loc;
149+
pmty_attributes = []
150+
} : Parsetree.module_type)));
151+
pmod_loc = _loc;
152+
pmod_attributes = []
153+
};
154+
pmb_attributes = [];
155+
pmb_loc = _loc
156+
})
157+
} in
158+
structure_items := (v :: (!structure_items))
159+
| `ml {ast = structure; _}::[] ->
160+
let v: Parsetree.structure_item =
161+
{
162+
Parsetree.pstr_loc = _loc;
163+
pstr_desc =
164+
(Pstr_module
165+
{
166+
pmb_name =
167+
{ txt = (String.capitalize base); loc = _loc
168+
};
169+
pmb_expr =
170+
{
171+
pmod_desc = (Pmod_structure structure);
172+
pmod_loc = _loc;
173+
pmod_attributes = []
174+
};
175+
pmb_attributes = [];
176+
pmb_loc = _loc
177+
})
178+
} in
179+
structure_items := (v :: (!structure_items))
180+
181+
| _ -> assert false
182+
end
183+
| _ -> ()
184+
) stack;
185+
{
186+
Parsetree.pstr_loc = _loc;
187+
pstr_desc =
188+
(Pstr_include
189+
{
190+
pincl_mod =
191+
{
192+
pmod_desc = (Pmod_structure ( !structure_items));
193+
pmod_loc = _loc;
194+
pmod_attributes = []
195+
};
196+
pincl_loc = _loc;
197+
pincl_attributes = []
198+
})
199+
}
200+
201+
202+
let assemble_as_string ast_tbl stack =
203+
let structure_items = ref [] in
204+
let visited = Hashtbl.create 31 in
205+
Stack.iter
206+
(fun base ->
207+
match Hashtbl.find visited base with
208+
| exception Not_found ->
209+
Hashtbl.add visited base ();
210+
begin match Hashtbl.find_all ast_tbl base with
211+
| [`ml {content = ml_content; name = ml_name};
212+
`mli { content = mli_content; name = mli_name}]
213+
| [`mli {content = mli_content; name = mli_name} ;
214+
`ml { content = ml_content; name = ml_name}] ->
215+
structure_items :=
216+
`All (base, ml_content,ml_name, mli_content, mli_name)
217+
:: !structure_items
218+
| `ml {content = ml_content; name}::[] ->
219+
structure_items :=
220+
`Ml (base, ml_content, name) :: !structure_items
221+
| _ -> assert false
222+
end
223+
| _ -> ()
224+
) stack;
225+
!structure_items
226+
227+
228+
let prepare arg_files =
94229
let ast_tbl = Hashtbl.create 31 in
95230
let files_set = Depend.StringSet.of_list @@ arg_files in
96231
let () = files_set |> Depend.StringSet.iter (fun name ->
97-
98-
let chan = open_in name in
99-
let lexbuf = Lexing.from_channel chan in
232+
let content = load_file name in
100233
let base = normalize name in
101234
if Filename.check_suffix name ".ml"
102235
then
103-
let ast = Parse.implementation lexbuf in
104-
(Hashtbl.add ast_tbl base (`ml ast);
236+
let ast = Parse.implementation (Lexing.from_string content) in
237+
(Hashtbl.add ast_tbl base (`ml {ast; name; content });
105238
ml_file_dependencies (name, ast))
106239
else
107240
if Filename.check_suffix name ".mli"
108241
then
109-
(if Depend.StringSet.mem (Filename.chop_extension name ^ ".ml") files_set then
110-
match Parse.interface lexbuf with
242+
(if Depend.StringSet.mem
243+
(Filename.chop_extension name ^ ".ml") files_set then
244+
match Parse.interface (Lexing.from_string content) with
111245
| ast ->
112-
Hashtbl.add ast_tbl base (`mli ast);
246+
Hashtbl.add ast_tbl base (`mli {ast; name; content});
113247
mli_file_dependencies (name, ast)
114248
| exception _ -> failwith (Printf.sprintf "failed parsing %s" name)
115249
else
116-
begin match Parse.interface lexbuf with
250+
begin match Parse.interface (Lexing.from_string content) with
117251
| ast ->
118252
(* prerr_endline name; *)
119-
Hashtbl.add ast_tbl base (`mli ast);
253+
Hashtbl.add ast_tbl base (`mli {ast ; name; content});
120254
mli_file_dependencies (name, ast);
121-
seek_in chan 0 ;
122-
let lexbuf = Lexing.from_channel chan in
123-
begin match Parse.implementation lexbuf with
124-
| impl ->
125-
Hashtbl.add ast_tbl base (`ml impl);
255+
begin match
256+
Parse.implementation
257+
(Lexing.from_string content)
258+
with
259+
| ast ->
260+
Hashtbl.add ast_tbl base (`ml { ast; name; content});
126261
ml_file_dependencies
127-
(name, impl) (* Fake*)
262+
(name, ast) (* Fake*)
128263
| exception _ -> failwith (Printf.sprintf "failed parsing %s as ml" name)
129264
end
130265
| exception _ ->
131266
failwith (Printf.sprintf "failed parsing %s" name)
132267
end
133268
)
134269
else assert false) in
135-
136-
(let stack = sort_files_by_dependencies (!files) in
137-
let visited = Hashtbl.create 31 in
138-
let _loc = Location.none in
139-
let structure_items = ref [] in
140-
C.iter
141-
(fun base ->
142-
match Hashtbl.find visited base with
143-
| exception Not_found ->
144-
Hashtbl.add visited base ();
145-
(* prerr_endline base ; *)
146-
begin match Hashtbl.find_all ast_tbl base with
147-
| (`ml structure)::(`mli signature)::[]
148-
|(`mli signature)::(`ml structure)::[] ->
149-
let v: Parsetree.structure_item =
150-
{
151-
Parsetree.pstr_loc = _loc;
152-
pstr_desc =
153-
(Pstr_module
154-
{
155-
pmb_name =
156-
{ txt = (String.capitalize base); loc = _loc
157-
};
158-
pmb_expr =
159-
{
160-
pmod_desc =
161-
(Pmod_constraint
162-
({
163-
pmod_desc =
164-
(Pmod_structure structure);
165-
pmod_loc = _loc;
166-
pmod_attributes = []
167-
},
168-
({
169-
pmty_desc =
170-
(Pmty_signature signature);
171-
pmty_loc = _loc;
172-
pmty_attributes = []
173-
} : Parsetree.module_type)));
174-
pmod_loc = _loc;
175-
pmod_attributes = []
176-
};
177-
pmb_attributes = [];
178-
pmb_loc = _loc
179-
})
180-
} in
181-
structure_items := (v :: (!structure_items))
182-
| (`ml structure)::[] ->
183-
let v: Parsetree.structure_item =
184-
{
185-
Parsetree.pstr_loc = _loc;
186-
pstr_desc =
187-
(Pstr_module
188-
{
189-
pmb_name =
190-
{ txt = (String.capitalize base); loc = _loc
191-
};
192-
pmb_expr =
193-
{
194-
pmod_desc = (Pmod_structure structure);
195-
pmod_loc = _loc;
196-
pmod_attributes = []
197-
};
198-
pmb_attributes = [];
199-
pmb_loc = _loc
200-
})
201-
} in
202-
structure_items := (v :: (!structure_items))
203-
204-
| _ -> assert false
205-
end
206-
| _ -> ()
207-
) stack;
208-
(let final: Parsetree.structure_item =
209-
{
210-
Parsetree.pstr_loc = _loc;
211-
pstr_desc =
212-
(Pstr_include
213-
{
214-
pincl_mod =
215-
{
216-
pmod_desc = (Pmod_structure ((* List.rev *) !structure_items));
217-
pmod_loc = _loc;
218-
pmod_attributes = []
219-
};
220-
pincl_loc = _loc;
221-
pincl_attributes = []
222-
})
223-
} in
224-
final))
270+
ast_tbl, sort_files_by_dependencies (!files)
271+
272+
let process arg_files : Parsetree.structure_item =
273+
let ast_tbl, stack_files = prepare arg_files in
274+
assemble ast_tbl stack_files
275+
276+
let process_as_string arg_files =
277+
let ast_tbl, stack_files = prepare arg_files in
278+
assemble_as_string ast_tbl stack_files
225279

226280

227281
(**

‎jscomp/tools/ocaml_extract.mli

+5
Original file line numberDiff line numberDiff line change
@@ -16,3 +16,8 @@ val sort_files_by_dependencies :
1616
Depend.StringSet.elt C.t
1717

1818
val process : string list -> Parsetree.structure_item
19+
20+
val process_as_string :
21+
string list ->
22+
[`All of string * string * string * string * string
23+
|`Ml of string * string * string ] list

0 commit comments

Comments
 (0)