Skip to content

Commit 7f1c9ff

Browse files
committed
experiment in-memory loading cmi file
- not turned on yet - use allow-approx to make it forgiving - extract binary search
1 parent 95fa7ce commit 7f1c9ff

24 files changed

+328
-155
lines changed

jscomp/bsb_helper/bsb_db_decode.ml

Lines changed: 1 addition & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -93,41 +93,6 @@ let read_build_cache ~dir : t =
9393
Ext_io.load_file (Filename.concat dir bsbuild_cache) in
9494
decode_internal all_content (ref (Ext_digest.length + 1)), all_content
9595

96-
(* Invariant: the same as encoding Map_string.compare_key *)
97-
let cmp = Ext_string.compare
98-
99-
100-
let rec binarySearchAux (arr : string array) (lo : int) (hi : int) (key : string) : _ option =
101-
let mid = (lo + hi)/2 in
102-
let midVal = Array.unsafe_get arr mid in
103-
let c = cmp key midVal in
104-
if c = 0 then Some (mid)
105-
else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *)
106-
if hi = mid then
107-
let loVal = (Array.unsafe_get arr lo) in
108-
if loVal = key then Some lo
109-
else None
110-
else binarySearchAux arr lo mid key
111-
else (* a[lo] =< a[mid] < key <= a[hi] *)
112-
if lo = mid then
113-
let hiVal = (Array.unsafe_get arr hi) in
114-
if hiVal = key then Some hi
115-
else None
116-
else binarySearchAux arr mid hi key
117-
118-
let find_opt_aux sorted key : _ option =
119-
let len = Array.length sorted in
120-
if len = 0 then None
121-
else
122-
let lo = Array.unsafe_get sorted 0 in
123-
let c = cmp key lo in
124-
if c < 0 then None
125-
else
126-
let hi = Array.unsafe_get sorted (len - 1) in
127-
let c2 = cmp key hi in
128-
if c2 > 0 then None
129-
else binarySearchAux sorted 0 (len - 1) key
130-
13196

13297

13398
type module_info = {
@@ -140,7 +105,7 @@ let find_opt
140105
((sorteds,whole) : t ) i (key : string)
141106
: module_info option =
142107
let group = sorteds.(i) in
143-
let i = find_opt_aux group.modules key in
108+
let i = Ext_string_array.find_sorted group.modules key in
144109
match i with
145110
| None -> None
146111
| Some count ->

jscomp/core/bs_conditional_initial.ml

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,19 @@
2424

2525

2626
let setup_env () =
27+
#if 0 then
28+
let old_loader = !Env.Persistent_signature.load in
29+
Env.Persistent_signature.load := (fun ~unit_name ->
30+
match Ext_string_array.find_sorted Js_cmi_datasets.module_sets unit_name with
31+
| Some index ->
32+
Format.fprintf Format.err_formatter "reading %s@." unit_name;
33+
Some {filename = Sys.executable_name ; cmi =
34+
Lazy.force Js_cmi_datasets.module_sets_cmi.(index)}
35+
| None -> old_loader ~unit_name
36+
);
37+
Clflags.keep_locs := false;
38+
Clflags.keep_docs := false;
39+
#end
2740
Warnings.parse_options false Bsc_warnings.defaults_w;
2841
Warnings.parse_options true Bsc_warnings.defaults_warn_error;
2942
Clflags.dump_location := false;

jscomp/core/js_cmj_format.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424

2525

2626

27-
[@@@ocaml.warning "+9"]
27+
[@@@warning "+9"]
2828

2929

3030
type arity =

jscomp/core/js_packages_info.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25-
[@@@ocaml.warning "+9"]
25+
[@@@warning "+9"]
2626

2727

2828

jscomp/ext/ext_array.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@ let filter f a =
7171
in aux [] 0
7272

7373

74-
let filter_map (f : _ -> _ option) a =
74+
let filter_map a (f : _ -> _ option) =
7575
let arr_len = Array.length a in
7676
let rec aux acc i =
7777
if i = arr_len

jscomp/ext/ext_array.mli

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,10 @@ val reverse_of_list : 'a list -> 'a array
3535

3636
val filter : ('a -> bool) -> 'a array -> 'a array
3737

38-
val filter_map : ('a -> 'b option) -> 'a array -> 'b array
38+
val filter_map :
39+
'a array ->
40+
('a -> 'b option) ->
41+
'b array
3942

4043
val range : int -> int -> int array
4144

jscomp/ext/ext_string_array.ml

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
(* Copyright (C) 2020 - Present Authors of BuckleScript
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
26+
(* Invariant: the same as encoding Map_string.compare_key *)
27+
let cmp = Ext_string.compare
28+
29+
30+
let rec binarySearchAux (arr : string array) (lo : int) (hi : int) (key : string) : _ option =
31+
let mid = (lo + hi)/2 in
32+
let midVal = Array.unsafe_get arr mid in
33+
let c = cmp key midVal in
34+
if c = 0 then Some (mid)
35+
else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *)
36+
if hi = mid then
37+
let loVal = (Array.unsafe_get arr lo) in
38+
if loVal = key then Some lo
39+
else None
40+
else binarySearchAux arr lo mid key
41+
else (* a[lo] =< a[mid] < key <= a[hi] *)
42+
if lo = mid then
43+
let hiVal = (Array.unsafe_get arr hi) in
44+
if hiVal = key then Some hi
45+
else None
46+
else binarySearchAux arr mid hi key
47+
48+
let find_sorted sorted key : int option =
49+
let len = Array.length sorted in
50+
if len = 0 then None
51+
else
52+
let lo = Array.unsafe_get sorted 0 in
53+
let c = cmp key lo in
54+
if c < 0 then None
55+
else
56+
let hi = Array.unsafe_get sorted (len - 1) in
57+
let c2 = cmp key hi in
58+
if c2 > 0 then None
59+
else binarySearchAux sorted 0 (len - 1) key
60+
61+

jscomp/ext/ext_string_array.mli

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
(* Copyright (C) 2020 - Present Authors of BuckleScript
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
val cmp : string -> string -> int
26+
27+
val find_sorted :
28+
string array -> string -> int option

jscomp/main/jscmj_main.ml renamed to jscomp/main/cmij_main.ml

Lines changed: 43 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -23,17 +23,16 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525

26-
26+
2727

2828

2929

3030
let get_files ext dir =
31-
let arr =
32-
Sys.readdir dir
33-
|> Ext_array.filter_map
34-
(fun x ->
35-
if Ext_string.ends_with x ext
36-
then Some (Filename.concat dir x) else None )
31+
let arr =
32+
Ext_array.filter_map (Sys.readdir dir)
33+
(fun x ->
34+
if Ext_string.ends_with x ext
35+
then Some (Filename.concat dir x) else None )
3736
in
3837
(* Sort to guarantee it works the same across OSes *)
3938
Array.sort (fun (x : string) y -> Pervasives.compare x y ) arr;
@@ -51,11 +50,12 @@ let from_cmj (files : string list) (output_file : string) =
5150
let aux file =
5251
let str = Ext_io.load_file file in
5352
begin
53+
#if 0 then
5454
prerr_endline (* can not embed corrupted data *)
5555
(Printf.sprintf "Begin Verifying %s" file);
5656
let _ = Js_cmj_format.from_string str in
5757
prerr_endline "End";
58-
58+
#end
5959
Ext_pp.paren_group f 1 (fun _ ->
6060
raw_to_str f (Filename.basename file) ;
6161
Ext_pp.string f ",";
@@ -68,58 +68,55 @@ let from_cmj (files : string list) (output_file : string) =
6868
Ext_pp.newline f
6969
end
7070
in
71-
Ext_pp.string f "(* -*-mode:fundamental-*- *)" ;
71+
7272
Ext_pp.newline f ;
7373
Ext_pp.string f "let data_sets = let map = Map_string.of_list " ;
7474
Ext_pp.bracket_vgroup f 1 (fun _ -> List.iter aux files);
75-
Ext_pp.string f " in ref map")
75+
Ext_pp.string f " in ref map")
7676

7777

7878
(** the cache should be readable and also update *)
79-
(**
79+
let _raw_to_str f str =
80+
Ext_pp.string f "\"" ;
81+
Ext_pp.string f (String.escaped str);
82+
Ext_pp.string f "\""
83+
8084
let from_cmi (files : string list) (output_file : string) =
81-
let raw_to_str f str =
82-
Ext_pp.string f "\"" ;
83-
Ext_pp.string f (Ext_string.escaped str);
84-
Ext_pp.string f "\""
85-
in
85+
let files = List.sort (fun filea fileb ->
86+
Ext_string_array.cmp (Ext_filename.module_name filea) (Ext_filename.module_name fileb)) files in
8687
let v = open_out_bin output_file in
87-
Ext_pervasives.finally v ~clean:close_out (fun v ->
88-
let f = Ext_pp.from_channel v in
89-
let aux file =
90-
let cmi = Cmi_format.read_cmi file in
91-
let str = Marshal.to_string cmi [] in
92-
begin
88+
Ext_pervasives.finally v ~clean:close_out (fun f ->
89+
output_string f
90+
(Printf.sprintf {|let module_sets = [|
91+
%s
92+
|]|}
93+
(String.concat ";\n" (Ext_list.map files (fun x -> "\"" ^ Ext_filename.module_name x ^ "\"")))
94+
) ;
95+
output_string f "\n";
96+
output_string f
97+
(Printf.sprintf {|let module_sets_cmi : Cmi_format.cmi_infos Lazy.t array = [|
98+
%s
99+
|]
100+
|} (String.concat ";\n" (Ext_list.map files (fun file ->
101+
Printf.sprintf "lazy (Marshal.from_string %S 0)"
102+
(let content = (Cmi_format.read_cmi file) in
103+
Marshal.to_string content []
104+
(* let header_len = (String.length Config.cmi_magic_number) in
105+
String.sub content header_len (String.length content - header_len) *)
106+
)))
107+
)
108+
))
109+
;;
93110

94-
Ext_pp.paren_group f 1 (fun _ ->
95-
raw_to_str f (Filename.basename file) ;
96-
Ext_pp.string f ",";
97-
Ext_pp.string f "lazy";
98-
Ext_pp.space f ;
99-
Ext_pp.paren_group f 1 (fun _ ->
100-
Ext_pp.string f "Marshal.from_string " ;
101-
raw_to_str f str;
102-
Ext_pp.space f;
103-
Ext_pp.string f "0";
104-
Ext_pp.space f ;
105-
Ext_pp.string f Ext_string.single_colon ;
106-
Ext_pp.space f ;
107-
Ext_pp.string f "Cmi_format.cmi_infos"
108-
));
109-
Ext_pp.string f ";";
110-
Ext_pp.newline f ;
111-
end
112-
in
113-
Ext_pp.string f "(* -*-mode:fundamental-*- *)" ;
114-
Ext_pp.newline f ;
115-
Ext_pp.string f "let data_sets = Map_string.of_list " ;
116-
Ext_pp.bracket_vgroup f 1 (fun _ -> List.iter aux files))
117-
*)
118111
let stdlib = "stdlib-406"
119112

120113
let () =
121114
from_cmj ( Ext_list.append (get_files Literals.suffix_cmj stdlib)
122115
(Ext_list.append (get_files Literals.suffix_cmj "runtime")
123116
(get_files Literals.suffix_cmj "others")))
124117
(Filename.concat "core" "js_cmj_datasets.ml")
118+
(* from_cmi ( Ext_list.append (get_files Literals.suffix_cmi stdlib)
119+
(Ext_list.append (get_files Literals.suffix_cmi "runtime")
120+
(get_files Literals.suffix_cmi "others")))
121+
(Filename.concat "core" "js_cmi_datasets.ml") *)
125122

jscomp/main/cmij_main.mli

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
2+
3+
val from_cmj :
4+
string list ->
5+
string ->
6+
unit
7+
8+
9+
val from_cmi :
10+
string list ->
11+
string ->
12+
unit

0 commit comments

Comments
 (0)