Skip to content

Commit a6ee05d

Browse files
bobzhangbobzhang
committed
add a digest to the generated file
1 parent fbb3460 commit a6ee05d

13 files changed

+1091
-1783
lines changed

‎jscomp/core/bs_cmi_load.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,10 @@
22

33
(* TODO: provide native load*)
44
let browse_load ~unit_name : Env.Persistent_signature.t option=
5-
match Ext_string_array.find_sorted Builtin_cmi_datasets.module_sets unit_name with
6-
| Some index ->
5+
match Ext_string_array.find_sorted_assoc Builtin_cmi_datasets.module_sets_cmi unit_name with
6+
| Some cmi ->
77
(* Format.fprintf Format.err_formatter "reading %s@." unit_name; *)
88
Some {filename = Sys.executable_name ;
99
cmi =
10-
Lazy.force Builtin_cmi_datasets.module_sets_cmi.(index)}
10+
Lazy.force cmi}
1111
| None -> assert false

‎jscomp/core/builtin_cmi_datasets.ml

Lines changed: 135 additions & 268 deletions
Large diffs are not rendered by default.

‎jscomp/core/builtin_cmi_datasets.mli

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
11

22

33

4-
(* TODO: we can hide some
5-
more internal units
6-
*)
7-
val module_sets : string array
8-
val module_sets_cmi : Cmi_format.cmi_infos Lazy.t array
4+
5+
val module_sets_cmi :
6+
(string * Cmi_format.cmi_infos Lazy.t) array

‎jscomp/core/builtin_cmj_datasets.ml

Lines changed: 142 additions & 292 deletions
Large diffs are not rendered by default.

‎jscomp/core/builtin_cmj_datasets.mli

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1-
val module_sets : string array
2-
val module_sets_cmj : Js_cmj_format.t Lazy.t array
3-
val query_by_name : string -> Js_cmj_format.t option
1+
2+
3+
val module_sets :
4+
(string * Js_cmj_format.t Lazy.t ) array

‎jscomp/core/js_cmj_load.ml

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,13 @@
3232

3333
#if BS_BROWSER then
3434
let load_unit_exn unit_name : Js_cmj_format.cmj_load_info =
35-
match Builtin_cmj_datasets.query_by_name unit_name with
36-
| Some v
35+
match Ext_string_array.find_sorted_assoc
36+
Builtin_cmj_datasets.module_sets
37+
unit_name with
38+
| Some cmj_table
3739
->
38-
{package_path = "BROWSER"; cmj_table = v}
40+
let lazy cmj_table = cmj_table in
41+
{package_path = "BROWSER"; cmj_table}
3942
| None
4043
->
4144
Bs_exception.error (Cmj_not_found unit_name)

‎jscomp/ext/ext_string_array.ml

Lines changed: 30 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,4 +58,33 @@ let find_sorted sorted key : int option =
5858
if c2 > 0 then None
5959
else binarySearchAux sorted 0 (len - 1) key
6060

61-
61+
let rec binarySearchAssoc (arr : (string * _) array) (lo : int) (hi : int) (key : string) : _ option =
62+
let mid = (lo + hi)/2 in
63+
let midVal = Array.unsafe_get arr mid in
64+
let c = cmp key (fst midVal) in
65+
if c = 0 then Some (snd midVal)
66+
else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *)
67+
if hi = mid then
68+
let loVal = (Array.unsafe_get arr lo) in
69+
if fst loVal = key then Some (snd loVal)
70+
else None
71+
else binarySearchAssoc arr lo mid key
72+
else (* a[lo] =< a[mid] < key <= a[hi] *)
73+
if lo = mid then
74+
let hiVal = (Array.unsafe_get arr hi) in
75+
if fst hiVal = key then Some (snd hiVal)
76+
else None
77+
else binarySearchAssoc arr mid hi key
78+
79+
let find_sorted_assoc (type a) (sorted : (string * a) array) (key : string) : a option =
80+
let len = Array.length sorted in
81+
if len = 0 then None
82+
else
83+
let lo = Array.unsafe_get sorted 0 in
84+
let c = cmp key (fst lo) in
85+
if c < 0 then None
86+
else
87+
let hi = Array.unsafe_get sorted (len - 1) in
88+
let c2 = cmp key (fst hi) in
89+
if c2 > 0 then None
90+
else binarySearchAssoc sorted 0 (len - 1) key

‎jscomp/ext/ext_string_array.mli

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,4 +25,9 @@
2525
val cmp : string -> string -> int
2626

2727
val find_sorted :
28-
string array -> string -> int option
28+
string array -> string -> int option
29+
30+
val find_sorted_assoc :
31+
(string * 'a ) array ->
32+
string ->
33+
'a option

‎jscomp/main/cmij_main.ml

Lines changed: 63 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -35,44 +35,51 @@ let get_files ext dir =
3535
|> Array.to_list
3636

3737
(** the cache should be readable and also update *)
38+
let check_digest output_file digest : bool =
39+
if Sys.file_exists output_file then
40+
match
41+
List.filter (fun x -> x <> "")
42+
(String.split_on_char ' '
43+
((Ext_io.load_file output_file))) with
44+
| head :: old_digest :: tail->
3845

39-
let from_cmj (files : string list) (output_file : string) =
46+
Digest.equal digest old_digest
47+
48+
| _ -> false
49+
else false
50+
let (+>) = Ext_buffer.add_string
51+
let from_cmj (files : string list) (output_file : string) : unit =
4052
let cmp = Ext_filename.module_name in
4153
let files = List.sort (fun filea fileb ->
4254
Ext_string_array.cmp (cmp filea) (cmp fileb)) files in
43-
let keys = Ext_list.map files (fun x -> "\"" ^cmp x ^ "\"") in
44-
let v = open_out_bin output_file in
45-
Ext_pervasives.finally v ~clean:close_out (fun f ->
46-
output_string f {|
55+
let buf = Ext_buffer.create 10000 in
56+
buf +> {|
4757
let i s = lazy (Marshal.from_string s 0)
4858
|};
49-
output_string f
50-
(Printf.sprintf {|let module_sets = [|
59+
buf +>
60+
(Printf.sprintf {|let module_sets : (string * Js_cmj_format.t Lazy.t) array = [|
5161
%s
5262
|]|}
53-
(String.concat ";\n" keys)
54-
) ;
55-
output_string f "\n";
56-
output_string f
57-
(Printf.sprintf {|let module_sets_cmj : Js_cmj_format.t Lazy.t array = [|
58-
%s
59-
|]
60-
|} (String.concat ";\n" (Ext_list.map files (fun file ->
61-
Printf.sprintf "i %S"
62-
(let content = Ext_io.load_file file in
63-
String.sub content Ext_cmj_magic.header_length (String.length content - Ext_cmj_magic.header_length)
64-
)))));
65-
output_string f "\n";
66-
output_string f {|
67-
let query_by_name s =
68-
match Ext_string_array.find_sorted
69-
module_sets s with
70-
| None -> None
71-
| Some i ->
72-
Some (Lazy.force module_sets_cmj.(i))
73-
|}
63+
(String.concat ";\n"
7464

75-
)
65+
(Ext_list.map files (fun file ->
66+
let c =
67+
(let content = Ext_io.load_file file in
68+
String.sub content Ext_cmj_magic.header_length (String.length content - Ext_cmj_magic.header_length)
69+
) in
70+
Printf.sprintf "%S, (* %d *)i %S"
71+
(cmp file)
72+
(String.length c) c
73+
))));
74+
buf +> "\n" ;
75+
let digest = Digest.to_hex (Ext_buffer.digest buf) in
76+
let same = check_digest output_file digest in
77+
if not same then
78+
let v = open_out_bin output_file in
79+
Ext_pervasives.finally v ~clean:close_out (fun f ->
80+
output_string f ("(* " ^ digest ^ " *) \n");
81+
Ext_buffer.output_buffer f buf
82+
)
7683

7784

7885

@@ -81,33 +88,33 @@ let from_cmi (files : string list) (output_file : string) =
8188
let cmp = Ext_filename.module_name in
8289
let files = List.sort (fun filea fileb ->
8390
Ext_string_array.cmp (cmp filea) (cmp fileb)) files in
84-
let keys = Ext_list.map files (fun x -> "\"" ^ cmp x ^ "\"") in
85-
let v = open_out_bin output_file in
86-
Ext_pervasives.finally v ~clean:close_out (fun f ->
87-
output_string f {|
88-
let i s = lazy (Marshal.from_string s 0)
89-
|};
90-
output_string f
91-
(Printf.sprintf {|let module_sets = [|
92-
%s
93-
|]|}
94-
(String.concat ";\n" keys)
95-
) ;
96-
output_string f "\n";
97-
output_string f
98-
(Printf.sprintf {|let module_sets_cmi : Cmi_format.cmi_infos Lazy.t array = [|
99-
%s
100-
|]
101-
|} (String.concat ";\n" (Ext_list.map files (fun file ->
102-
Printf.sprintf "i %S"
103-
(let content = (Cmi_format.read_cmi file) in
104-
Marshal.to_string content []
105-
(* let header_len = (String.length Config.cmi_magic_number) in
106-
String.sub content header_len (String.length content - header_len) *)
107-
)))
108-
)
109-
)
110-
)
91+
92+
let buf = Ext_buffer.create 10000 in
93+
buf +> {|
94+
let i s = lazy (Marshal.from_string s 0)
95+
|};
96+
buf +>
97+
(Printf.sprintf {|let module_sets_cmi : (string * Cmi_format.cmi_infos Lazy.t) array = [|
98+
%s
99+
|]|}
100+
(String.concat ";\n"
101+
(Ext_list.map files (fun file ->
102+
let content =
103+
Marshal.to_string (Cmi_format.read_cmi file) [] in
104+
Printf.sprintf "%S , (* %d *)i %S"
105+
(cmp file) (String.length content)
106+
content)))
107+
) ;
108+
buf +> "\n";
109+
let digest = Digest.to_hex (Ext_buffer.digest buf) in
110+
let same = check_digest output_file digest in
111+
if not same then
112+
let v = open_out_bin output_file in
113+
Ext_pervasives.finally v ~clean:close_out (fun f ->
114+
output_string f ("(* " ^ digest ^ " *)\n");
115+
Ext_buffer.output_buffer f buf
116+
)
117+
111118
;;
112119

113120
let stdlib = "stdlib-406"

‎lib/4.06.1/bsb_helper.ml

Lines changed: 36 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2903,6 +2903,11 @@ val cmp : string -> string -> int
29032903

29042904
val find_sorted :
29052905
string array -> string -> int option
2906+
2907+
val find_sorted_assoc :
2908+
(string * 'a ) array ->
2909+
string ->
2910+
'a option
29062911
end = struct
29072912
#1 "ext_string_array.ml"
29082913
(* Copyright (C) 2020 - Present Authors of BuckleScript
@@ -2965,7 +2970,37 @@ let find_sorted sorted key : int option =
29652970
if c2 > 0 then None
29662971
else binarySearchAux sorted 0 (len - 1) key
29672972

2968-
2973+
let rec binarySearchAssoc (arr : (string * _) array) (lo : int) (hi : int) (key : string) : _ option =
2974+
let mid = (lo + hi)/2 in
2975+
let midVal = Array.unsafe_get arr mid in
2976+
let c = cmp key (fst midVal) in
2977+
if c = 0 then Some (snd midVal)
2978+
else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *)
2979+
if hi = mid then
2980+
let loVal = (Array.unsafe_get arr lo) in
2981+
if fst loVal = key then Some (snd loVal)
2982+
else None
2983+
else binarySearchAssoc arr lo mid key
2984+
else (* a[lo] =< a[mid] < key <= a[hi] *)
2985+
if lo = mid then
2986+
let hiVal = (Array.unsafe_get arr hi) in
2987+
if fst hiVal = key then Some (snd hiVal)
2988+
else None
2989+
else binarySearchAssoc arr mid hi key
2990+
2991+
let find_sorted_assoc (type a) (sorted : (string * a) array) (key : string) : a option =
2992+
let len = Array.length sorted in
2993+
if len = 0 then None
2994+
else
2995+
let lo = Array.unsafe_get sorted 0 in
2996+
let c = cmp key (fst lo) in
2997+
if c < 0 then None
2998+
else
2999+
let hi = Array.unsafe_get sorted (len - 1) in
3000+
let c2 = cmp key (fst hi) in
3001+
if c2 > 0 then None
3002+
else binarySearchAssoc sorted 0 (len - 1) key
3003+
29693004
end
29703005
module Literals : sig
29713006
#1 "literals.mli"

0 commit comments

Comments
 (0)