From f1e213b8a830e335639ce470fb7d5801e7ef9611 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Mon, 19 Dec 2016 16:21:36 -0500 Subject: [PATCH 1/2] no raise for Ext_string.rindex --- jscomp/.merlin | 3 + jscomp/Makefile | 1 + jscomp/all.depend | 4 +- jscomp/bin/all_ounit_tests.d | 1 + jscomp/bin/all_ounit_tests.i.ml | 224 +++++++++++++---------- jscomp/bin/all_ounit_tests.ml | 51 ++++++ jscomp/bin/bsb.ml | 19 ++ jscomp/bin/bsb_helper.ml | 19 ++ jscomp/bin/bsdep.ml | 28 +++ jscomp/bin/bsppx.ml | 19 ++ jscomp/bin/whole_compiler.ml | 28 +++ jscomp/core/bs_conditional_initial.mli | 9 + jscomp/core/bspack_main.ml | 6 +- jscomp/ext/ext_filename.ml | 6 +- jscomp/ext/ext_string.ml | 15 ++ jscomp/ext/ext_string.mli | 6 + jscomp/ounit_tests/ounit_string_tests.ml | 27 +++ jscomp/ounit_tests/ounit_tests_main.ml | 1 + jscomp/test/ext_string.js | 46 +++++ 19 files changed, 412 insertions(+), 101 deletions(-) create mode 100644 jscomp/ounit_tests/ounit_string_tests.ml diff --git a/jscomp/.merlin b/jscomp/.merlin index 951fedd8da..f39aff883e 100644 --- a/jscomp/.merlin +++ b/jscomp/.merlin @@ -20,5 +20,8 @@ B ounit S ounit_tests B ounit_tests +S depends +B depends +PKG compiler-libs.common B +compiler-libs FLG -w -40-30 diff --git a/jscomp/Makefile b/jscomp/Makefile index d365a92025..d5d6d59f80 100644 --- a/jscomp/Makefile +++ b/jscomp/Makefile @@ -128,6 +128,7 @@ OUNIT_TESTS_SRCS = ounit_tests_util \ ounit_json_tests ounit_map_tests \ ounit_ordered_hash_set_tests \ ounit_vec_test \ + ounit_string_tests\ ounit_tests_main OUNIT_TESTS_CMXS = $(addprefix ounit_tests/, $(addsuffix .cmx, $(OUNIT_TESTS_SRCS))) diff --git a/jscomp/all.depend b/jscomp/all.depend index 2bded7e3c9..4ea60189f6 100644 --- a/jscomp/all.depend +++ b/jscomp/all.depend @@ -563,9 +563,11 @@ ounit_tests/ounit_ordered_hash_set_tests.cmx : \ ext/ordered_hash_set_string.cmx ounit/oUnit.cmx ext/ext_util.cmx ounit_tests/ounit_vec_test.cmx : ounit/oUnit.cmx ext/int_vec.cmx \ bsb/bsb_json.cmx +ounit_tests/ounit_string_tests.cmx : ounit/oUnit.cmx ext/ext_string.cmx ounit_tests/ounit_tests_main.cmx : ext/resize_array.cmx \ ounit_tests/ounit_vec_test.cmx ounit_tests/ounit_union_find_tests.cmx \ - ounit_tests/ounit_scc_tests.cmx ounit_tests/ounit_path_tests.cmx \ + ounit_tests/ounit_string_tests.cmx ounit_tests/ounit_scc_tests.cmx \ + ounit_tests/ounit_path_tests.cmx \ ounit_tests/ounit_ordered_hash_set_tests.cmx \ ounit_tests/ounit_map_tests.cmx ounit_tests/ounit_list_test.cmx \ ounit_tests/ounit_json_tests.cmx ounit_tests/ounit_hashtbl_tests.cmx \ diff --git a/jscomp/bin/all_ounit_tests.d b/jscomp/bin/all_ounit_tests.d index 89f53a32a6..862c133750 100644 --- a/jscomp/bin/all_ounit_tests.d +++ b/jscomp/bin/all_ounit_tests.d @@ -70,6 +70,7 @@ bin/all_ounit_tests.ml : ext/int_vec_vec.mli bin/all_ounit_tests.ml : ext/ext_scc.ml bin/all_ounit_tests.ml : ext/ext_scc.mli bin/all_ounit_tests.ml : ounit_tests/ounit_scc_tests.ml +bin/all_ounit_tests.ml : ounit_tests/ounit_string_tests.ml bin/all_ounit_tests.ml : ext/union_find.ml bin/all_ounit_tests.ml : ext/union_find.mli bin/all_ounit_tests.ml : ounit_tests/ounit_union_find_tests.ml diff --git a/jscomp/bin/all_ounit_tests.i.ml b/jscomp/bin/all_ounit_tests.i.ml index 783a9aa051..9a9a4e9ac3 100644 --- a/jscomp/bin/all_ounit_tests.i.ml +++ b/jscomp/bin/all_ounit_tests.i.ml @@ -75,7 +75,7 @@ open OUnitTypes (** Most simple heuristic, just pick the first test. *) let simple state = - (* 75 *) List.hd state.tests_planned + (* 77 *) List.hd state.tests_planned end module OUnitUtils @@ -98,22 +98,22 @@ let is_success = let is_failure = function | RFailure _ -> (* 0 *) true - | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 150 *) false + | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 154 *) false let is_error = function | RError _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 150 *) false + | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 154 *) false let is_skip = function | RSkip _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 150 *) false + | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 154 *) false let is_todo = function | RTodo _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 150 *) false + | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 154 *) false let result_flavour = function @@ -145,7 +145,7 @@ let rec was_successful = | [] -> (* 3 *) true | RSuccess _::t | RSkip _::t -> - (* 225 *) was_successful t + (* 231 *) was_successful t | RFailure _::_ | RError _::_ @@ -155,22 +155,22 @@ let rec was_successful = let string_of_node = function | ListItem n -> - (* 300 *) string_of_int n + (* 308 *) string_of_int n | Label s -> - (* 450 *) s + (* 462 *) s (* Return the number of available tests *) let rec test_case_count = function - | TestCase _ -> (* 75 *) 1 - | TestLabel (_, t) -> (* 89 *) test_case_count t + | TestCase _ -> (* 77 *) 1 + | TestLabel (_, t) -> (* 92 *) test_case_count t | TestList l -> - (* 14 *) List.fold_left - (fun c t -> (* 88 *) c + test_case_count t) + (* 15 *) List.fold_left + (fun c t -> (* 91 *) c + test_case_count t) 0 l let string_of_path path = - (* 150 *) String.concat ":" (List.rev_map string_of_node path) + (* 154 *) String.concat ":" (List.rev_map string_of_node path) let buff_format_printf f = (* 0 *) let buff = Buffer.create 13 in @@ -193,13 +193,13 @@ let mapi f l = rmapi 0 l let fold_lefti f accu l = - (* 14 *) let rec rfold_lefti cnt accup l = - (* 102 *) match l with + (* 15 *) let rec rfold_lefti cnt accup l = + (* 106 *) match l with | [] -> - (* 14 *) accup + (* 15 *) accup | h::t -> - (* 88 *) rfold_lefti (cnt + 1) (f accup h cnt) t + (* 91 *) rfold_lefti (cnt + 1) (f accup h cnt) t in rfold_lefti 0 accu l @@ -217,7 +217,7 @@ open OUnitUtils type event_type = GlobalEvent of global_event | TestEvent of test_event let format_event verbose event_type = - (* 452 *) match event_type with + (* 464 *) match event_type with | GlobalEvent e -> (* 2 *) begin match e with @@ -276,18 +276,18 @@ let format_event verbose event_type = end | TestEvent e -> - (* 450 *) begin + (* 462 *) begin let string_of_result = if verbose then function - | RSuccess _ -> (* 75 *) "ok\n" + | RSuccess _ -> (* 77 *) "ok\n" | RFailure (_, _) -> (* 0 *) "FAIL\n" | RError (_, _) -> (* 0 *) "ERROR\n" | RSkip (_, _) -> (* 0 *) "SKIP\n" | RTodo (_, _) -> (* 0 *) "TODO\n" else function - | RSuccess _ -> (* 75 *) "." + | RSuccess _ -> (* 77 *) "." | RFailure (_, _) -> (* 0 *) "F" | RError (_, _) -> (* 0 *) "E" | RSkip (_, _) -> (* 0 *) "S" @@ -296,11 +296,11 @@ let format_event verbose event_type = if verbose then match e with | EStart p -> - (* 75 *) Printf.sprintf "%s start\n" (string_of_path p) + (* 77 *) Printf.sprintf "%s start\n" (string_of_path p) | EEnd p -> - (* 75 *) Printf.sprintf "%s end\n" (string_of_path p) + (* 77 *) Printf.sprintf "%s end\n" (string_of_path p) | EResult result -> - (* 75 *) string_of_result result + (* 77 *) string_of_result result | ELog (lvl, str) -> (* 0 *) let prefix = match lvl with @@ -313,20 +313,20 @@ let format_event verbose event_type = (* 0 *) str else match e with - | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 150 *) "" - | EResult result -> (* 75 *) string_of_result result + | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 154 *) "" + | EResult result -> (* 77 *) string_of_result result end let file_logger fn = (* 1 *) let chn = open_out fn in (fun ev -> - (* 226 *) output_string chn (format_event true ev); + (* 232 *) output_string chn (format_event true ev); flush chn), (fun () -> (* 1 *) close_out chn) let std_logger verbose = (* 1 *) (fun ev -> - (* 226 *) print_string (format_event verbose ev); + (* 232 *) print_string (format_event verbose ev); flush stdout), (fun () -> (* 1 *) ()) @@ -343,7 +343,7 @@ let create output_file_opt verbose (log,close) = (* 0 *) null_logger in (fun ev -> - (* 226 *) std_log ev; file_log ev; log ev), + (* 232 *) std_log ev; file_log ev; log ev), (fun () -> (* 1 *) std_close (); file_close (); close ()) @@ -703,13 +703,13 @@ let assert_failure msg = (* 0 *) failwith ("OUnit: " ^ msg) let assert_bool msg b = - (* 2000208 *) if not b then assert_failure msg + (* 2000210 *) if not b then assert_failure msg let assert_string str = (* 0 *) if not (str = "") then assert_failure str let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual = - (* 2000400 *) let get_error_string () = + (* 2000398 *) let get_error_string () = (* 0 *) let res = buff_format_printf (fun fmt -> @@ -925,8 +925,8 @@ let (@?) = assert_bool (* Some shorthands which allows easy test construction *) let (>:) s t = (* 0 *) TestLabel(s, t) (* infix *) -let (>::) s f = (* 75 *) TestLabel(s, TestCase(f)) (* infix *) -let (>:::) s l = (* 14 *) TestLabel(s, TestList(l)) (* infix *) +let (>::) s f = (* 77 *) TestLabel(s, TestCase(f)) (* infix *) +let (>:::) s l = (* 15 *) TestLabel(s, TestList(l)) (* infix *) (* Utility function to manipulate test *) let rec test_decorate g = @@ -1061,7 +1061,7 @@ let maybe_backtrace = "" (* Run all tests, report starts, errors, failures, and return the results *) let perform_test report test = (* 1 *) let run_test_case f path = - (* 75 *) try + (* 77 *) try f (); RSuccess path with @@ -1080,22 +1080,22 @@ let perform_test report test = let rec flatten_test path acc = function | TestCase(f) -> - (* 75 *) (path, f) :: acc + (* 77 *) (path, f) :: acc | TestList (tests) -> - (* 14 *) fold_lefti + (* 15 *) fold_lefti (fun acc t cnt -> - (* 88 *) flatten_test + (* 91 *) flatten_test ((ListItem cnt)::path) acc t) acc tests | TestLabel (label, t) -> - (* 89 *) flatten_test ((Label label)::path) acc t + (* 92 *) flatten_test ((Label label)::path) acc t in let test_cases = List.rev (flatten_test [] [] test) in let runner (path, f) = - (* 75 *) let result = + (* 77 *) let result = report (EStart path); run_test_case f path in @@ -1104,18 +1104,18 @@ let perform_test report test = result in let rec iter state = - (* 76 *) match state.tests_planned with + (* 78 *) match state.tests_planned with | [] -> (* 1 *) state.results | _ -> - (* 75 *) let (path, f) = !global_chooser state in + (* 77 *) let (path, f) = !global_chooser state in let result = runner (path, f) in iter { results = result :: state.results; tests_planned = List.filter - (fun (path', _) -> (* 2850 *) path <> path') state.tests_planned + (fun (path', _) -> (* 3003 *) path <> path') state.tests_planned } in iter {results = []; tests_planned = test_cases} @@ -1145,7 +1145,7 @@ let run_test_tt ?verbose test = time_fun perform_test (fun ev -> - (* 225 *) log (OUnitLogger.TestEvent ev)) + (* 231 *) log (OUnitLogger.TestEvent ev)) test in @@ -1653,6 +1653,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -1889,7 +1894,7 @@ let starts_with_and_number s ~offset beg = else -1 -let equal (x : string) y = (* 8832017 *) x = y +let equal (x : string) y = (* 8826023 *) x = y let unsafe_concat_with_length len sep l = (* 0 *) match l with @@ -1910,6 +1915,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + (* 21 *) if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + (* 0 *) if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + (* 7 *) rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + (* 0 *) rindex_rec_opt s (String.length s - 1) c;; end module Ounit_array_tests = struct @@ -3164,7 +3183,7 @@ end = struct ]} *) let rec power_2_above x n = - (* 57 *) if x >= n then x + (* 56 *) if x >= n then x else if x * 2 > Sys.max_array_length then x else power_2_above (x * 2) n @@ -4377,7 +4396,6 @@ module type S = sig val copy: 'a t -> 'a t val add: 'a t -> key -> 'a -> unit val modify_or_init: 'a t -> key -> ('a -> unit) -> (unit -> 'a) -> unit - val replace_or_init: 'a t -> key -> ('a -> 'a) -> 'a -> unit val remove: 'a t -> key -> unit val find_exn: 'a t -> key -> 'a val find_all: 'a t -> key -> 'a list @@ -4409,7 +4427,7 @@ and ('a, 'b) bucketlist = let create initial_size = - (* 3 *) let s = Ext_util.power_2_above 16 initial_size in + (* 2 *) let s = Ext_util.power_2_above 16 initial_size in { initial_size = s; size = 0; seed = 0; data = Array.make s Empty } let clear h = @@ -4426,7 +4444,7 @@ let reset h = let copy h = (* 0 *) { h with data = Array.copy h.data } -let length h = (* 3 *) h.size +let length h = (* 2 *) h.size let resize indexfun h = (* 11 *) let odata = h.data in @@ -4449,11 +4467,11 @@ let resize indexfun h = let iter f h = - (* 1 *) let rec do_bucket = function + (* 0 *) let rec do_bucket = function | Empty -> - (* 16 *) () + (* 0 *) () | Cons(k, d, rest) -> - (* 6 *) f k d; do_bucket rest in + (* 0 *) f k d; do_bucket rest in let d = h.data in for i = 0 to Array.length d - 1 do do_bucket (Array.unsafe_get d i) @@ -4579,7 +4597,7 @@ end = struct type key = string type 'a t = (key, 'a) Hashtbl_gen.t let key_index (h : _ t ) (key : key) = - (* 13019 *) (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) + (* 7019 *) (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) let eq_key = Ext_string.equal # 24 @@ -4602,7 +4620,7 @@ let add (h : _ t) key info = h.size <- h.size + 1; if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h - +(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *) let modify_or_init (h : _ t) key modf default = (* 0 *) let rec find_bucket (bucketlist : _ bucketlist) = (* 0 *) match bucketlist with @@ -4664,8 +4682,7 @@ let find_all (h : _ t) key = find_in_bucket h.data.(key_index h key) let replace h key info = - (* 2000 *) let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = - (* 4462 *) match bucketlist with + (* 2000 *) let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = (* 4462 *) match bucketlist with | Empty -> (* 1000 *) raise_notrace Not_found | Cons(k, i, next) -> @@ -4681,24 +4698,6 @@ let replace h key info = h.size <- h.size + 1; if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h -let replace_or_init h key modf info = - (* 6000 *) let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = - (* 6000 *) match bucketlist with - | Empty -> - (* 6 *) raise_notrace Not_found - | Cons(k, i, next) -> - (* 5994 *) if eq_key k key - then Cons(key, modf i, next) - else Cons(k, i, replace_bucket next) in - let i = key_index h key in - let l = h.data.(i) in - try - h.data.(i) <- replace_bucket l - with Not_found -> - h.data.(i) <- Cons(key, info, l); - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h - let mem (h : _ t) key = (* 0 *) let rec mem_in_bucket (bucketlist : _ bucketlist) = (* 0 *) match bucketlist with | Empty -> @@ -4726,17 +4725,17 @@ let (=~) = OUnit.assert_equal let suites = __FILE__ >:::[ - __LOC__ >:: begin fun _ -> - (* 1 *) let h = String_hashtbl.create 0 in - let accu key = - (* 6000 *) String_hashtbl.replace_or_init h key succ 1 in - let count = 1000 in - for i = 0 to count - 1 do - Array.iter accu [|"a";"b";"c";"d";"e";"f"|] - done; - String_hashtbl.length h =~ 6; - String_hashtbl.iter (fun _ v -> (* 6 *) v =~ count ) h - end; + (* __LOC__ >:: begin fun _ -> *) + (* let h = String_hashtbl.create 0 in *) + (* let accu key = *) + (* String_hashtbl.replace_or_init h key succ 1 in *) + (* let count = 1000 in *) + (* for i = 0 to count - 1 do *) + (* Array.iter accu [|"a";"b";"c";"d";"e";"f"|] *) + (* done; *) + (* String_hashtbl.length h =~ 6; *) + (* String_hashtbl.iter (fun _ v -> v =~ count ) h *) + (* end; *) "add semantics " >:: begin fun _ -> (* 1 *) let h = String_hashtbl.create 0 in @@ -4760,6 +4759,7 @@ let suites = end; ] + end module Map_gen = struct @@ -7790,21 +7790,21 @@ let node_relative_path (file1 : t) +(* Input must be absolute directory *) +let rec find_root_filename ~cwd filename = + (* 0 *) if Sys.file_exists (cwd // filename) then cwd + else + let cwd' = Filename.dirname cwd in + if String.length cwd' < String.length cwd then + find_root_filename ~cwd:cwd' filename + else + Ext_pervasives.failwithf + ~loc:__LOC__ + "%s not found from %s" filename cwd let find_package_json_dir cwd = - (* 0 *) let rec aux cwd = - (* 0 *) if Sys.file_exists (cwd // Literals.package_json) then cwd - else - let cwd' = Filename.dirname cwd in - if String.length cwd' < String.length cwd then - aux cwd' - else - Ext_pervasives.failwithf - ~loc:__LOC__ - "package.json not found from %s" cwd - in - aux cwd + (* 0 *) find_root_filename ~cwd Literals.bsconfig_json let package_dir = lazy (find_package_json_dir (Lazy.force cwd)) @@ -9370,6 +9370,37 @@ let suites = ] end +module Ounit_string_tests += struct +#1 "ounit_string_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + + + +let suites = + __FILE__ >::: + [ + __LOC__ >:: begin fun _ -> + (* 1 *) OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 ) + end; + + __LOC__ >:: begin fun _ -> + (* 1 *) Ext_string.rindex_neg "hello" 'h' =~ 0 ; + Ext_string.rindex_neg "hello" 'e' =~ 1 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'o' =~ 4 ; + end; + + __LOC__ >:: begin fun _ -> + (* 1 *) OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) + end + ] +end module Union_find : sig #1 "union_find.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -10603,6 +10634,7 @@ let suites = Ounit_map_tests.suites; Ounit_ordered_hash_set_tests.suites; Ounit_hashtbl_tests.suites; + Ounit_string_tests.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/jscomp/bin/all_ounit_tests.ml b/jscomp/bin/all_ounit_tests.ml index d5fd0efd0b..c945e9c22e 100644 --- a/jscomp/bin/all_ounit_tests.ml +++ b/jscomp/bin/all_ounit_tests.ml @@ -1653,6 +1653,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -1910,6 +1915,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Ounit_array_tests = struct @@ -9351,6 +9370,37 @@ let suites = ] end +module Ounit_string_tests += struct +#1 "ounit_string_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + + + +let suites = + __FILE__ >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 ) + end; + + __LOC__ >:: begin fun _ -> + Ext_string.rindex_neg "hello" 'h' =~ 0 ; + Ext_string.rindex_neg "hello" 'e' =~ 1 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'o' =~ 4 ; + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) + end + ] +end module Union_find : sig #1 "union_find.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -10584,6 +10634,7 @@ let suites = Ounit_map_tests.suites; Ounit_ordered_hash_set_tests.suites; Ounit_hashtbl_tests.suites; + Ounit_string_tests.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/jscomp/bin/bsb.ml b/jscomp/bin/bsb.ml index 494233b331..546b1610d8 100644 --- a/jscomp/bin/bsb.ml +++ b/jscomp/bin/bsb.ml @@ -465,6 +465,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -722,6 +727,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Literals : sig #1 "literals.mli" diff --git a/jscomp/bin/bsb_helper.ml b/jscomp/bin/bsb_helper.ml index d7add39648..186879c47a 100644 --- a/jscomp/bin/bsb_helper.ml +++ b/jscomp/bin/bsb_helper.ml @@ -431,6 +431,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -688,6 +693,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Literals : sig #1 "literals.mli" diff --git a/jscomp/bin/bsdep.ml b/jscomp/bin/bsdep.ml index 7f7f56026b..6f3b983945 100644 --- a/jscomp/bin/bsdep.ml +++ b/jscomp/bin/bsdep.ml @@ -19795,6 +19795,15 @@ module Bs_conditional_initial : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** This function set up built in compile time variables used in + conditional compilation so that + {[ + #if BS then + #elif .. then + #end + ]} + Is understood, also make sure the playground do the same initialization. +*) val setup_env : unit -> unit end = struct @@ -23228,6 +23237,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -23485,6 +23499,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Ast_attributes : sig #1 "ast_attributes.mli" diff --git a/jscomp/bin/bsppx.ml b/jscomp/bin/bsppx.ml index 9496bbcba8..dc32c342b0 100644 --- a/jscomp/bin/bsppx.ml +++ b/jscomp/bin/bsppx.ml @@ -5086,6 +5086,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -5343,6 +5348,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Ast_attributes : sig #1 "ast_attributes.mli" diff --git a/jscomp/bin/whole_compiler.ml b/jscomp/bin/whole_compiler.ml index 6c74403e07..d7dbddbfdb 100644 --- a/jscomp/bin/whole_compiler.ml +++ b/jscomp/bin/whole_compiler.ml @@ -19795,6 +19795,15 @@ module Bs_conditional_initial : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** This function set up built in compile time variables used in + conditional compilation so that + {[ + #if BS then + #elif .. then + #end + ]} + Is understood, also make sure the playground do the same initialization. +*) val setup_env : unit -> unit end = struct @@ -21053,6 +21062,11 @@ val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -21310,6 +21324,20 @@ let unsafe_concat_with_length len sep l = tl; Bytes.unsafe_to_string r + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; end module Ext_filename : sig #1 "ext_filename.mli" diff --git a/jscomp/core/bs_conditional_initial.mli b/jscomp/core/bs_conditional_initial.mli index 3517ec28fd..0f9895b146 100644 --- a/jscomp/core/bs_conditional_initial.mli +++ b/jscomp/core/bs_conditional_initial.mli @@ -22,4 +22,13 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** This function set up built in compile time variables used in + conditional compilation so that + {[ + #if BS then + #elif .. then + #end + ]} + Is understood, also make sure the playground do the same initialization. +*) val setup_env : unit -> unit diff --git a/jscomp/core/bspack_main.ml b/jscomp/core/bspack_main.ml index 88c1b47308..94e6903a83 100644 --- a/jscomp/core/bspack_main.ml +++ b/jscomp/core/bspack_main.ml @@ -212,10 +212,10 @@ let normalize s = Ext_filename.normalize_absolute_path (Ext_filename.combine cwd s ) let process_include s : Ast_extract.dir_spec = - match String.rindex s '?' with - | exception Not_found -> + let i = Ext_string.rindex_neg s '?' in + if i < 0 then { dir = normalize s; excludes = []} - | i -> + else let dir = String.sub s 0 i in { dir = normalize dir; excludes = Ext_string.split diff --git a/jscomp/ext/ext_filename.ml b/jscomp/ext/ext_filename.ml index 00e61c2f46..7a97c68911 100644 --- a/jscomp/ext/ext_filename.ml +++ b/jscomp/ext/ext_filename.ml @@ -334,9 +334,13 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) diff --git a/jscomp/ext/ext_string.ml b/jscomp/ext/ext_string.ml index 17fc823645..72bdeec3df 100644 --- a/jscomp/ext/ext_string.ml +++ b/jscomp/ext/ext_string.ml @@ -252,3 +252,18 @@ let unsafe_concat_with_length len sep l = pos := !pos + s_len) tl; Bytes.unsafe_to_string r + + +let rec rindex_rec s i c = + if i < 0 then i else + if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c;; + +let rec rindex_rec_opt s i c = + if i < 0 then None else + if String.unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c;; + +let rindex_neg s c = + rindex_rec s (String.length s - 1) c;; + +let rindex_opt s c = + rindex_rec_opt s (String.length s - 1) c;; \ No newline at end of file diff --git a/jscomp/ext/ext_string.mli b/jscomp/ext/ext_string.mli index 0e8651ab36..8e0cf4e2b2 100644 --- a/jscomp/ext/ext_string.mli +++ b/jscomp/ext/ext_string.mli @@ -85,3 +85,9 @@ val digits_of_str : string -> offset:int -> int -> int val starts_with_and_number : string -> offset:int -> string -> int val unsafe_concat_with_length : int -> string -> string list -> string + + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option \ No newline at end of file diff --git a/jscomp/ounit_tests/ounit_string_tests.ml b/jscomp/ounit_tests/ounit_string_tests.ml new file mode 100644 index 0000000000..92ace83077 --- /dev/null +++ b/jscomp/ounit_tests/ounit_string_tests.ml @@ -0,0 +1,27 @@ +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + + + +let suites = + __FILE__ >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 ) + end; + + __LOC__ >:: begin fun _ -> + Ext_string.rindex_neg "hello" 'h' =~ 0 ; + Ext_string.rindex_neg "hello" 'e' =~ 1 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'l' =~ 3 ; + Ext_string.rindex_neg "hello" 'o' =~ 4 ; + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) + end + ] \ No newline at end of file diff --git a/jscomp/ounit_tests/ounit_tests_main.ml b/jscomp/ounit_tests/ounit_tests_main.ml index 05c152267e..02285aaa3f 100644 --- a/jscomp/ounit_tests/ounit_tests_main.ml +++ b/jscomp/ounit_tests/ounit_tests_main.ml @@ -30,6 +30,7 @@ let suites = Ounit_map_tests.suites; Ounit_ordered_hash_set_tests.suites; Ounit_hashtbl_tests.suites; + Ounit_string_tests.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/jscomp/test/ext_string.js b/jscomp/test/ext_string.js index a558e54bb0..6356705816 100644 --- a/jscomp/test/ext_string.js +++ b/jscomp/test/ext_string.js @@ -385,6 +385,48 @@ function unsafe_concat_with_length(len, sep, l) { } } +function rindex_rec(s, _i, c) { + while(true) { + var i = _i; + if (i < 0) { + return i; + } + else if (s.charCodeAt(i) === c) { + return i; + } + else { + _i = i - 1 | 0; + continue ; + + } + }; +} + +function rindex_rec_opt(s, _i, c) { + while(true) { + var i = _i; + if (i < 0) { + return /* None */0; + } + else if (s.charCodeAt(i) === c) { + return /* Some */[i]; + } + else { + _i = i - 1 | 0; + continue ; + + } + }; +} + +function rindex_neg(s, c) { + return rindex_rec(s, s.length - 1 | 0, c); +} + +function rindex_opt(s, c) { + return rindex_rec_opt(s, s.length - 1 | 0, c); +} + exports.split_by = split_by; exports.trim = trim; exports.split = split; @@ -405,4 +447,8 @@ exports.digits_of_str = digits_of_str; exports.starts_with_and_number = starts_with_and_number; exports.equal = equal; exports.unsafe_concat_with_length = unsafe_concat_with_length; +exports.rindex_rec = rindex_rec; +exports.rindex_rec_opt = rindex_rec_opt; +exports.rindex_neg = rindex_neg; +exports.rindex_opt = rindex_opt; /* No side effect */ From 2c816aabf3b672055652f08a4be2282d41efd068 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Mon, 19 Dec 2016 16:57:25 -0500 Subject: [PATCH 2/2] remove generic hashtbl completely, clean up --- jscomp/Makefile | 4 +- jscomp/all.depend | 21 +- jscomp/bin/all_ounit_tests.ml | 9 +- jscomp/bin/bsb.ml | 6 +- jscomp/bin/bsb_helper.ml | 6 +- jscomp/bin/bsdep.ml | 6 +- jscomp/bin/bsppx.ml | 6 +- jscomp/bin/whole_compiler.d | 13 +- jscomp/bin/whole_compiler.ml | 1486 +++++++++++++++++------------- jscomp/bsb/sexp_eval.ml | 28 +- jscomp/core/config_util.ml | 55 +- jscomp/core/config_util.mli | 2 +- jscomp/core/js_program_loader.ml | 10 +- jscomp/core/lam_compile_env.ml | 30 +- jscomp/core/lam_module_ident.ml | 9 + jscomp/core/lam_module_ident.mli | 2 + jscomp/depends/ast_extract.ml | 6 +- jscomp/depends/bs_exception.ml | 3 + jscomp/depends/bs_exception.mli | 1 + jscomp/ext/ext_hashtbl.ml | 45 - jscomp/ext/ext_hashtbl.mli | 38 - jscomp/ext/hashtbl.cppo.ml | 13 + jscomp/ext/hashtbl_make.ml | 123 +++ jscomp/ext/hashtbl_make.mli | 3 + jscomp/ext/ident_hashtbl.ml | 3 +- jscomp/ext/int_hashtbl.ml | 4 +- jscomp/ext/string_hashtbl.ml | 3 +- jscomp/test/ext_filename.js | 15 +- 28 files changed, 1111 insertions(+), 839 deletions(-) delete mode 100644 jscomp/ext/ext_hashtbl.ml delete mode 100644 jscomp/ext/ext_hashtbl.mli create mode 100644 jscomp/ext/hashtbl_make.ml create mode 100644 jscomp/ext/hashtbl_make.mli diff --git a/jscomp/Makefile b/jscomp/Makefile index d5d6d59f80..282f5bdc2f 100644 --- a/jscomp/Makefile +++ b/jscomp/Makefile @@ -81,6 +81,8 @@ ext/int_hashtbl.ml: ext/hashtbl.cppo.ml cppo -D TYPE_INT $< -o $@ ext/ident_hashtbl.ml: ext/hashtbl.cppo.ml cppo -D TYPE_IDENT $< -o $@ +ext/hashtbl_make.ml: ext/hashtbl.cppo.ml + cppo -D TYPE_FUNCTOR $< -o $@ ## Stubs .c.o: $(NATIVE) -ccopt -o -ccopt $@ -c $< @@ -144,7 +146,6 @@ EXT_SRCS = ext_util\ map_make\ ext_file_pp ext_format \ hashtbl_gen \ - ext_hashtbl \ ext_string \ string_hashtbl\ ext_list \ @@ -160,6 +161,7 @@ EXT_SRCS = ext_util\ ext_ident\ ident_map\ ident_set\ + hashtbl_make\ ordered_hash_map_local_ident\ int_map\ literals \ diff --git a/jscomp/all.depend b/jscomp/all.depend index 4ea60189f6..de206532d8 100644 --- a/jscomp/all.depend +++ b/jscomp/all.depend @@ -16,7 +16,6 @@ ext/map_make.cmx : ext/map_gen.cmx ext/map_make.cmi ext/ext_file_pp.cmx : ext/ext_file_pp.cmi ext/ext_format.cmx : ext/ext_format.cmi ext/hashtbl_gen.cmx : ext/ext_util.cmx -ext/ext_hashtbl.cmx : ext/ext_hashtbl.cmi ext/ext_string.cmx : ext/ext_bytes.cmx ext/ext_string.cmi ext/string_hashtbl.cmx : ext/hashtbl_gen.cmx ext/ext_string.cmx \ stubs/bs_hash_stubs.cmx ext/string_hashtbl.cmi @@ -45,6 +44,7 @@ ext/ext_ident.cmx : ext/string_hashtbl.cmx ext/string_hash_set.cmx \ ext/ext_string.cmx ext/ext_ident.cmi ext/ident_map.cmx : ext/map_gen.cmx ext/ext_ident.cmx ext/ident_map.cmi ext/ident_set.cmx : ext/set_gen.cmx ext/ident_set.cmi +ext/hashtbl_make.cmx : ext/hashtbl_gen.cmx ext/hashtbl_make.cmi ext/ordered_hash_map_local_ident.cmx : ext/ordered_hash_map_gen.cmx \ ext/ext_ident.cmx stubs/bs_hash_stubs.cmx \ ext/ordered_hash_map_local_ident.cmi @@ -79,7 +79,6 @@ ext/int_vec_vec.cmi : ext/vec_gen.cmx ext/int_vec.cmi ext/map_make.cmi : ext/map_gen.cmx ext/ext_file_pp.cmi : ext/ext_format.cmi : -ext/ext_hashtbl.cmi : ext/ext_string.cmi : ext/string_hashtbl.cmi : ext/hashtbl_gen.cmx ext/ext_list.cmi : @@ -98,6 +97,7 @@ ext/union_find.cmi : ext/ext_ident.cmi : ext/ident_map.cmi : ext/map_gen.cmx ext/ident_set.cmi : ext/set_gen.cmx +ext/hashtbl_make.cmi : ext/hashtbl_gen.cmx ext/ordered_hash_map_local_ident.cmi : ext/ordered_hash_map_gen.cmx ext/int_map.cmi : ext/map_gen.cmx ext/literals.cmi : @@ -203,9 +203,10 @@ depends/depends_post_process.cmx : ext/string_map.cmx ext/literals.cmx \ ext/ext_string.cmx ext/ext_pervasives.cmx common/binary_cache.cmx \ depends/depends_post_process.cmi depends/bs_exception.cmx : depends/bs_exception.cmi -depends/ast_extract.cmx : ext/string_map.cmx common/js_config.cmx \ - ext/ext_string.cmx ext/ext_list.cmx ext/ext_format.cmx \ - ext/ext_filename.cmx depends/bs_exception.cmx depends/ast_extract.cmi +depends/ast_extract.cmx : ext/string_map.cmx ext/string_hashtbl.cmx \ + common/js_config.cmx ext/ext_string.cmx ext/ext_list.cmx \ + ext/ext_format.cmx ext/ext_filename.cmx depends/bs_exception.cmx \ + depends/ast_extract.cmi depends/binary_ast.cmx : depends/ast_extract.cmx depends/binary_ast.cmi core/type_util.cmi : core/bs_conditional_initial.cmi : @@ -224,7 +225,8 @@ core/js_closure.cmi : ext/ident_set.cmi core/js_number.cmi : core/js_cmj_datasets.cmi : ext/string_map.cmi core/js_cmj_format.cmi core/lam_exit_code.cmi : core/lam.cmi -core/lam_module_ident.cmi : core/js_op.cmx common/js_config.cmi core/j.cmx +core/lam_module_ident.cmi : core/js_op.cmx common/js_config.cmi core/j.cmx \ + ext/hashtbl_gen.cmx core/lam_compile_util.cmi : core/js_op.cmx core/lam_stats.cmi : core/lam_module_ident.cmi core/lam.cmi \ ext/int_hash_set.cmi ext/ident_set.cmi ext/ident_hashtbl.cmi @@ -320,6 +322,7 @@ core/lam_exit_code.cmx : core/lam.cmx core/lam_exit_code.cmi core/j.cmx : core/js_op.cmx core/js_fun_env.cmx core/js_closure.cmx \ core/js_call_info.cmx ext/ident_set.cmx core/lam_module_ident.cmx : core/js_op.cmx common/js_config.cmx core/j.cmx \ + ext/hashtbl_make.cmx ext/ext_ident.cmx stubs/bs_hash_stubs.cmx \ core/lam_module_ident.cmi core/lam_compile_util.cmx : core/js_op.cmx core/lam_compile_util.cmi core/lam_stats.cmx : core/lam_module_ident.cmx core/lam.cmx \ @@ -421,7 +424,8 @@ core/lam_pass_collect.cmx : core/lam_util.cmx core/lam_stats_util.cmx \ core/js_program_loader.cmx : core/lam_module_ident.cmx \ core/lam_compile_env.cmx core/js_stmt_make.cmx core/js_exp_make.cmx \ common/js_config.cmx core/j.cmx ext/ident_set.cmx ext/ext_pervasives.cmx \ - ext/ext_filename.cmx core/config_util.cmx core/js_program_loader.cmi + ext/ext_filename.cmx core/config_util.cmx depends/bs_exception.cmx \ + core/js_program_loader.cmi core/js_dump.cmx : ext/literals.cmx core/lam_module_ident.cmx \ core/js_stmt_make.cmx core/js_program_loader.cmx core/js_op_util.cmx \ core/js_op.cmx core/js_number.cmx core/js_fun_env.cmx \ @@ -604,7 +608,8 @@ bsb/bsb_main.cmx : ext/string_vec.cmx ext/literals.cmx ext/ext_string.cmx \ bsb/bsb_ninja.cmx : ext/string_set.cmx ext/string_map.cmx ext/literals.cmx \ ext/ext_filename.cmx bsb/bsb_config.cmx bsb/bsb_build_util.cmx \ bsb/bsb_build_ui.cmx common/binary_cache.cmx bsb/bsb_ninja.cmi -bsb/sexp_eval.cmx : bsb/sexp_lexer.cmx ext/ext_list.cmx +bsb/sexp_eval.cmx : ext/string_hashtbl.cmx bsb/sexp_lexer.cmx \ + ext/ext_list.cmx bsb/sexp_lexer.cmx : bsb/sexp_lexer.cmi bsb/bsb_build_ui.cmi : ext/string_set.cmi ext/string_map.cmi \ ext/ext_file_pp.cmi bsb/bsb_json.cmi common/binary_cache.cmi diff --git a/jscomp/bin/all_ounit_tests.ml b/jscomp/bin/all_ounit_tests.ml index c945e9c22e..b9710843f1 100644 --- a/jscomp/bin/all_ounit_tests.ml +++ b/jscomp/bin/all_ounit_tests.ml @@ -4600,7 +4600,7 @@ let key_index (h : _ t ) (key : key) = (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) let eq_key = Ext_string.equal -# 24 +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -4712,6 +4712,7 @@ let of_list2 ks vs = List.iter2 (fun k v -> add map k v) ks vs ; map + end module Ounit_hashtbl_tests = struct @@ -7934,11 +7935,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end diff --git a/jscomp/bin/bsb.ml b/jscomp/bin/bsb.ml index 546b1610d8..517369b430 100644 --- a/jscomp/bin/bsb.ml +++ b/jscomp/bin/bsb.ml @@ -1391,11 +1391,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end diff --git a/jscomp/bin/bsb_helper.ml b/jscomp/bin/bsb_helper.ml index 186879c47a..69a96e0659 100644 --- a/jscomp/bin/bsb_helper.ml +++ b/jscomp/bin/bsb_helper.ml @@ -1357,11 +1357,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end diff --git a/jscomp/bin/bsdep.ml b/jscomp/bin/bsdep.ml index 6f3b983945..d7bdea1d78 100644 --- a/jscomp/bin/bsdep.ml +++ b/jscomp/bin/bsdep.ml @@ -26575,11 +26575,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end diff --git a/jscomp/bin/bsppx.ml b/jscomp/bin/bsppx.ml index dc32c342b0..a1cee29043 100644 --- a/jscomp/bin/bsppx.ml +++ b/jscomp/bin/bsppx.ml @@ -8433,11 +8433,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end diff --git a/jscomp/bin/whole_compiler.d b/jscomp/bin/whole_compiler.d index 0047eba5dc..bda59ec2e9 100644 --- a/jscomp/bin/whole_compiler.d +++ b/jscomp/bin/whole_compiler.d @@ -52,6 +52,12 @@ bin/whole_compiler.ml : ext/ext_format.ml bin/whole_compiler.ml : ext/ext_format.mli bin/whole_compiler.ml : ext/ext_list.ml bin/whole_compiler.ml : ext/ext_list.mli +bin/whole_compiler.ml : stubs/bs_hash_stubs.ml +bin/whole_compiler.ml : ext/ext_util.ml +bin/whole_compiler.ml : ext/ext_util.mli +bin/whole_compiler.ml : ext/hashtbl_gen.ml +bin/whole_compiler.ml : ext/string_hashtbl.ml +bin/whole_compiler.ml : ext/string_hashtbl.mli bin/whole_compiler.ml : ext/map_gen.ml bin/whole_compiler.ml : ext/string_map.ml bin/whole_compiler.ml : ext/string_map.mli @@ -130,15 +136,9 @@ bin/whole_compiler.ml : ../ocaml/driver/compmisc.ml bin/whole_compiler.ml : ../ocaml/driver/compmisc.mli bin/whole_compiler.ml : common/ext_log.ml bin/whole_compiler.ml : common/ext_log.mli -bin/whole_compiler.ml : stubs/bs_hash_stubs.ml -bin/whole_compiler.ml : ext/ext_util.ml -bin/whole_compiler.ml : ext/ext_util.mli bin/whole_compiler.ml : ext/hash_set_gen.ml bin/whole_compiler.ml : ext/string_hash_set.ml bin/whole_compiler.ml : ext/string_hash_set.mli -bin/whole_compiler.ml : ext/hashtbl_gen.ml -bin/whole_compiler.ml : ext/string_hashtbl.ml -bin/whole_compiler.ml : ext/string_hashtbl.mli bin/whole_compiler.ml : ext/ext_ident.ml bin/whole_compiler.ml : ext/ext_ident.mli bin/whole_compiler.ml : ext/ident_map.ml @@ -200,6 +200,7 @@ bin/whole_compiler.ml : ext/ident_hashtbl.ml bin/whole_compiler.ml : ext/ident_hashtbl.mli bin/whole_compiler.ml : core/lam_analysis.ml bin/whole_compiler.ml : core/lam_analysis.mli +bin/whole_compiler.ml : ext/hashtbl_make.ml bin/whole_compiler.ml : core/lam_module_ident.ml bin/whole_compiler.ml : core/lam_module_ident.mli bin/whole_compiler.ml : core/lam_print.ml diff --git a/jscomp/bin/whole_compiler.ml b/jscomp/bin/whole_compiler.ml index d7dbddbfdb..c3aaf51352 100644 --- a/jscomp/bin/whole_compiler.ml +++ b/jscomp/bin/whole_compiler.ml @@ -19866,6 +19866,7 @@ module Bs_exception : sig type error = | Cmj_not_found of string + | Js_not_found of string | Bs_cyclic_depends of string list | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) @@ -19912,6 +19913,7 @@ end = struct type error = | Cmj_not_found of string + | Js_not_found of string | Bs_cyclic_depends of string list | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) @@ -19926,6 +19928,8 @@ let error err = raise (Error err) let report_error ppf = function | Cmj_not_found s -> Format.fprintf ppf "%s not found, cmj format is generated by BuckleScript" s + | Js_not_found s -> + Format.fprintf ppf "%s not found, needed in script mode " s | Bs_cyclic_depends str -> Format.fprintf ppf "Cyclic depends : @[%a@]" @@ -21796,11 +21800,15 @@ let normalize_absolute_path x = let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos +(* try let pos = String.rindex x '.' in Ext_string.tail_from x pos with Not_found -> "" - +*) end @@ -23294,6 +23302,447 @@ let rec last xs = | [] -> invalid_arg "Ext_list.last" +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" +external hash_string : string -> int = "caml_bs_hash_string" "noalloc";; + +external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" "noalloc";; + +external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" "noalloc";; + +external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" "noalloc";; + +external hash_small_int : int -> int = "caml_bs_hash_small_int" "noalloc";; + +external hash_int : int -> int = "caml_bs_hash_int" "noalloc";; + +end +module Ext_util : sig +#1 "ext_util.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + +val power_2_above : int -> int -> int + + +val stats_to_string : Hashtbl.statistics -> string +end = struct +#1 "ext_util.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +(** + {[ + (power_2_above 16 63 = 64) + (power_2_above 16 76 = 128) + ]} +*) +let rec power_2_above x n = + if x >= n then x + else if x * 2 > Sys.max_array_length then x + else power_2_above (x * 2) n + + +let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = + Printf.sprintf + "bindings: %d,buckets: %d, longest: %d, hist:[%s]" + num_bindings + num_buckets + max_bucket_length + (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) +end +module Hashtbl_gen += struct +#1 "hashtbl_gen.ml" +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +(* Hash tables *) + + + +module type S = sig + type key + type 'a t + val create: int -> 'a t + val clear: 'a t -> unit + val reset: 'a t -> unit + val copy: 'a t -> 'a t + val add: 'a t -> key -> 'a -> unit + val modify_or_init: 'a t -> key -> ('a -> unit) -> (unit -> 'a) -> unit + val remove: 'a t -> key -> unit + val find_exn: 'a t -> key -> 'a + val find_all: 'a t -> key -> 'a list + val find_opt: 'a t -> key -> 'a option + val find_default: 'a t -> key -> 'a -> 'a + + val replace: 'a t -> key -> 'a -> unit + val mem: 'a t -> key -> bool + val iter: (key -> 'a -> unit) -> 'a t -> unit + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val length: 'a t -> int + val stats: 'a t -> Hashtbl.statistics + val of_list2: key list -> 'a list -> 'a t +end + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) + +type ('a, 'b) t = + { mutable size: int; (* number of entries *) + mutable data: ('a, 'b) bucketlist array; (* the buckets *) + mutable seed: int; (* for randomization *) + initial_size: int; (* initial array size *) + } + +and ('a, 'b) bucketlist = + | Empty + | Cons of 'a * 'b * ('a, 'b) bucketlist + + +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; seed = 0; data = Array.make s Empty } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + h.data.(i) <- Empty + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size Empty + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + +let resize indexfun h = + let odata = h.data in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + Empty -> () + | Cons(key, data, rest) -> + insert_bucket rest; (* preserve original order of elements *) + let nidx = indexfun h key in + ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + + + +let iter f h = + let rec do_bucket = function + | Empty -> + () + | Cons(k, d, rest) -> + f k d; do_bucket rest in + let d = h.data in + for i = 0 to Array.length d - 1 do + do_bucket (Array.unsafe_get d i) + done + +let fold f h init = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons(k, d, rest) -> + do_bucket rest (f k d accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket d.(i) !accu + done; + !accu + +let rec bucket_length accu = function + | Empty -> accu + | Cons(_, _, rest) -> bucket_length (accu + 1) rest + +let stats h = + let mbl = + Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in + let histo = Array.make (mbl + 1) 0 in + Array.iter + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + h.data; + {Hashtbl. + num_bindings = h.size; + num_buckets = Array.length h.data; + max_bucket_length = mbl; + bucket_histogram = histo } + + + +let rec small_bucket_mem eq key (lst : _ bucketlist) = + match lst with + | Empty -> false + | Cons(k1,_,rest1) -> + eq key k1 || + match rest1 with + | Empty -> false + | Cons(k2,_,rest2) -> + eq key k2 || + match rest2 with + | Empty -> false + | Cons(k3,_,rest3) -> + eq key k3 || + small_bucket_mem eq key rest3 + + +let rec small_bucket_opt eq key (lst : _ bucketlist) : _ option = + match lst with + | Empty -> None + | Cons(k1,d1,rest1) -> + if eq key k1 then Some d1 else + match rest1 with + | Empty -> None + | Cons(k2,d2,rest2) -> + if eq key k2 then Some d2 else + match rest2 with + | Empty -> None + | Cons(k3,d3,rest3) -> + if eq key k3 then Some d3 else + small_bucket_opt eq key rest3 + +let rec small_bucket_default eq key default (lst : _ bucketlist) = + match lst with + | Empty -> default + | Cons(k1,d1,rest1) -> + if eq key k1 then d1 else + match rest1 with + | Empty -> default + | Cons(k2,d2,rest2) -> + if eq key k2 then d2 else + match rest2 with + | Empty -> default + | Cons(k3,d3,rest3) -> + if eq key k3 then d3 else + small_bucket_default eq key default rest3 + +end +module String_hashtbl : sig +#1 "string_hashtbl.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + +include Hashtbl_gen.S with type key = string + + + + +end = struct +#1 "string_hashtbl.ml" +# 9 "ext/hashtbl.cppo.ml" +type key = string +type 'a t = (key, 'a) Hashtbl_gen.t +let key_index (h : _ t ) (key : key) = + (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) +let eq_key = Ext_string.equal + +# 33 +type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist +let create = Hashtbl_gen.create +let clear = Hashtbl_gen.clear +let reset = Hashtbl_gen.reset +let copy = Hashtbl_gen.copy +let iter = Hashtbl_gen.iter +let fold = Hashtbl_gen.fold +let length = Hashtbl_gen.length +let stats = Hashtbl_gen.stats + + + +let add (h : _ t) key info = + let i = key_index h key in + let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in + h.data.(i) <- bucket; + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *) +let modify_or_init (h : _ t) key modf default = + let rec find_bucket (bucketlist : _ bucketlist) = + match bucketlist with + | Cons(k,i,next) -> + if eq_key k key then begin modf i; false end + else find_bucket next + | Empty -> true in + let i = key_index h key in + if find_bucket h.data.(i) then + begin + h.data.(i) <- Cons(key,default (),h.data.(i)); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + end + +let remove (h : _ t ) key = + let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + Empty + | Cons(k, i, next) -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else Cons(k, i, remove_bucket next) in + let i = key_index h key in + h.data.(i) <- remove_bucket h.data.(i) + +let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + raise Not_found + | Cons(k, d, rest) -> + if eq_key key k then d else find_rec key rest + +let find_exn (h : _ t) key = + match h.data.(key_index h key) with + | Empty -> raise Not_found + | Cons(k1, d1, rest1) -> + if eq_key key k1 then d1 else + match rest1 with + | Empty -> raise Not_found + | Cons(k2, d2, rest2) -> + if eq_key key k2 then d2 else + match rest2 with + | Empty -> raise Not_found + | Cons(k3, d3, rest3) -> + if eq_key key k3 then d3 else find_rec key rest3 + +let find_opt (h : _ t) key = + Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key)) +let find_default (h : _ t) key default = + Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key)) +let find_all (h : _ t) key = + let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + [] + | Cons(k, d, rest) -> + if eq_key k key + then d :: find_in_bucket rest + else find_in_bucket rest in + find_in_bucket h.data.(key_index h key) + +let replace h key info = + let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + raise_notrace Not_found + | Cons(k, i, next) -> + if eq_key k key + then Cons(key, info, next) + else Cons(k, i, replace_bucket next) in + let i = key_index h key in + let l = h.data.(i) in + try + h.data.(i) <- replace_bucket l + with Not_found -> + h.data.(i) <- Cons(key, info, l); + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +let mem (h : _ t) key = + let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + false + | Cons(k, d, rest) -> + eq_key k key || mem_in_bucket rest in + mem_in_bucket h.data.(key_index h key) + + +let of_list2 ks vs = + let map = create 51 in + List.iter2 (fun k v -> add map k v) ks vs ; + map + + end module Map_gen = struct @@ -24199,7 +24648,7 @@ let collect_from_main ) acc (Sys.readdir dirname)) [] extra_dirs in let ast_table = collect_ast_map ppf files parse_implementation parse_interface in - let visited = Hashtbl.create 31 in + let visited = String_hashtbl.create 31 in let result = Queue.create () in let next module_name = match String_map.find_exn module_name ast_table with @@ -24218,7 +24667,7 @@ let collect_from_main if String_set.mem current visiting then Bs_exception.error (Bs_cyclic_depends (current::path)) else - if not (Hashtbl.mem visited current) + if not (String_hashtbl.mem visited current) && String_map.mem current ast_table then begin String_set.iter @@ -24227,7 +24676,7 @@ let collect_from_main (current::path)) (next current) ; Queue.push current result; - Hashtbl.add visited current (); + String_hashtbl.add visited current (); end in visit (String_set.empty) [] main_module ; ast_table, result @@ -56654,100 +57103,6 @@ let iinfo b str f = Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str -end -module Bs_hash_stubs -= struct -#1 "bs_hash_stubs.ml" -external hash_string : string -> int = "caml_bs_hash_string" "noalloc";; - -external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" "noalloc";; - -external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" "noalloc";; - -external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" "noalloc";; - -external hash_small_int : int -> int = "caml_bs_hash_small_int" "noalloc";; - -external hash_int : int -> int = "caml_bs_hash_int" "noalloc";; - -end -module Ext_util : sig -#1 "ext_util.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - -val power_2_above : int -> int -> int - - -val stats_to_string : Hashtbl.statistics -> string -end = struct -#1 "ext_util.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** - {[ - (power_2_above 16 63 = 64) - (power_2_above 16 76 = 128) - ]} -*) -let rec power_2_above x n = - if x >= n then x - else if x * 2 > Sys.max_array_length then x - else power_2_above (x * 2) n - - -let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = - Printf.sprintf - "bindings: %d,buckets: %d, longest: %d, hist:[%s]" - num_bindings - num_buckets - max_bucket_length - (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) end module Hash_set_gen = struct @@ -56972,408 +57327,62 @@ end = struct * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -# 31 -type key = string -let key_index (h : _ Hash_set_gen.t ) (key : key) = - (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) -let eq_key = Ext_string.equal -type t = key Hash_set_gen.t - - -# 59 -let create = Hash_set_gen.create -let clear = Hash_set_gen.clear -let reset = Hash_set_gen.reset -let copy = Hash_set_gen.copy -let iter = Hash_set_gen.iter -let fold = Hash_set_gen.fold -let length = Hash_set_gen.length -let stats = Hash_set_gen.stats -let elements = Hash_set_gen.elements - - - -let remove (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_h_size = h.size in - let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in - if old_h_size <> h.size then - Array.unsafe_set h_data i new_bucket - - - -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - if not (Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data i)) then - begin - h.data.(i) <- key :: h.data.(i); - h.size <- h.size + 1 ; - if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h - end - -let check_add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - if not (Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data i)) then - begin - h.data.(i) <- key :: h.data.(i); - h.size <- h.size + 1 ; - if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h; - true - end - else false - - -let mem (h : _ Hash_set_gen.t) key = - Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) - - - -end -module Hashtbl_gen -= struct -#1 "hashtbl_gen.ml" -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - -(* Hash tables *) - - - -module type S = sig - type key - type 'a t - val create: int -> 'a t - val clear: 'a t -> unit - val reset: 'a t -> unit - val copy: 'a t -> 'a t - val add: 'a t -> key -> 'a -> unit - val modify_or_init: 'a t -> key -> ('a -> unit) -> (unit -> 'a) -> unit - val remove: 'a t -> key -> unit - val find_exn: 'a t -> key -> 'a - val find_all: 'a t -> key -> 'a list - val find_opt: 'a t -> key -> 'a option - val find_default: 'a t -> key -> 'a -> 'a - - val replace: 'a t -> key -> 'a -> unit - val mem: 'a t -> key -> bool - val iter: (key -> 'a -> unit) -> 'a t -> unit - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val length: 'a t -> int - val stats: 'a t -> Hashtbl.statistics - val of_list2: key list -> 'a list -> 'a t -end - -(* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. *) - -type ('a, 'b) t = - { mutable size: int; (* number of entries *) - mutable data: ('a, 'b) bucketlist array; (* the buckets *) - mutable seed: int; (* for randomization *) - initial_size: int; (* initial array size *) - } - -and ('a, 'b) bucketlist = - | Empty - | Cons of 'a * 'b * ('a, 'b) bucketlist - - -let create initial_size = - let s = Ext_util.power_2_above 16 initial_size in - { initial_size = s; size = 0; seed = 0; data = Array.make s Empty } - -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - h.data.(i) <- Empty - done - -let reset h = - h.size <- 0; - h.data <- Array.make h.initial_size Empty - - -let copy h = { h with data = Array.copy h.data } - -let length h = h.size - -let resize indexfun h = - let odata = h.data in - let osize = Array.length odata in - let nsize = osize * 2 in - if nsize < Sys.max_array_length then begin - let ndata = Array.make nsize Empty in - h.data <- ndata; (* so that indexfun sees the new bucket count *) - let rec insert_bucket = function - Empty -> () - | Cons(key, data, rest) -> - insert_bucket rest; (* preserve original order of elements *) - let nidx = indexfun h key in - ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in - for i = 0 to osize - 1 do - insert_bucket (Array.unsafe_get odata i) - done - end - - - -let iter f h = - let rec do_bucket = function - | Empty -> - () - | Cons(k, d, rest) -> - f k d; do_bucket rest in - let d = h.data in - for i = 0 to Array.length d - 1 do - do_bucket (Array.unsafe_get d i) - done - -let fold f h init = - let rec do_bucket b accu = - match b with - Empty -> - accu - | Cons(k, d, rest) -> - do_bucket rest (f k d accu) in - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket d.(i) !accu - done; - !accu - -let rec bucket_length accu = function - | Empty -> accu - | Cons(_, _, rest) -> bucket_length (accu + 1) rest - -let stats h = - let mbl = - Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in - let histo = Array.make (mbl + 1) 0 in - Array.iter - (fun b -> - let l = bucket_length 0 b in - histo.(l) <- histo.(l) + 1) - h.data; - {Hashtbl. - num_bindings = h.size; - num_buckets = Array.length h.data; - max_bucket_length = mbl; - bucket_histogram = histo } - - - -let rec small_bucket_mem eq key (lst : _ bucketlist) = - match lst with - | Empty -> false - | Cons(k1,_,rest1) -> - eq key k1 || - match rest1 with - | Empty -> false - | Cons(k2,_,rest2) -> - eq key k2 || - match rest2 with - | Empty -> false - | Cons(k3,_,rest3) -> - eq key k3 || - small_bucket_mem eq key rest3 - - -let rec small_bucket_opt eq key (lst : _ bucketlist) : _ option = - match lst with - | Empty -> None - | Cons(k1,d1,rest1) -> - if eq key k1 then Some d1 else - match rest1 with - | Empty -> None - | Cons(k2,d2,rest2) -> - if eq key k2 then Some d2 else - match rest2 with - | Empty -> None - | Cons(k3,d3,rest3) -> - if eq key k3 then Some d3 else - small_bucket_opt eq key rest3 - -let rec small_bucket_default eq key default (lst : _ bucketlist) = - match lst with - | Empty -> default - | Cons(k1,d1,rest1) -> - if eq key k1 then d1 else - match rest1 with - | Empty -> default - | Cons(k2,d2,rest2) -> - if eq key k2 then d2 else - match rest2 with - | Empty -> default - | Cons(k3,d3,rest3) -> - if eq key k3 then d3 else - small_bucket_default eq key default rest3 - -end -module String_hashtbl : sig -#1 "string_hashtbl.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -include Hashtbl_gen.S with type key = string - +# 31 +type key = string +let key_index (h : _ Hash_set_gen.t ) (key : key) = + (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) +let eq_key = Ext_string.equal +type t = key Hash_set_gen.t +# 59 +let create = Hash_set_gen.create +let clear = Hash_set_gen.clear +let reset = Hash_set_gen.reset +let copy = Hash_set_gen.copy +let iter = Hash_set_gen.iter +let fold = Hash_set_gen.fold +let length = Hash_set_gen.length +let stats = Hash_set_gen.stats +let elements = Hash_set_gen.elements -end = struct -#1 "string_hashtbl.ml" -# 9 "ext/hashtbl.cppo.ml" -type key = string -type 'a t = (key, 'a) Hashtbl_gen.t -let key_index (h : _ t ) (key : key) = - (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) -let eq_key = Ext_string.equal -# 24 -type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist -let create = Hashtbl_gen.create -let clear = Hashtbl_gen.clear -let reset = Hashtbl_gen.reset -let copy = Hashtbl_gen.copy -let iter = Hashtbl_gen.iter -let fold = Hashtbl_gen.fold -let length = Hashtbl_gen.length -let stats = Hashtbl_gen.stats +let remove (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_h_size = h.size in + let new_bucket = Hash_set_gen.remove_bucket eq_key key h (Array.unsafe_get h_data i) in + if old_h_size <> h.size then + Array.unsafe_set h_data i new_bucket -let add (h : _ t) key info = - let i = key_index h key in - let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in - h.data.(i) <- bucket; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h -(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *) -let modify_or_init (h : _ t) key modf default = - let rec find_bucket (bucketlist : _ bucketlist) = - match bucketlist with - | Cons(k,i,next) -> - if eq_key k key then begin modf i; false end - else find_bucket next - | Empty -> true in - let i = key_index h key in - if find_bucket h.data.(i) then +let add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + if not (Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data i)) then begin - h.data.(i) <- Cons(key,default (),h.data.(i)); + h.data.(i) <- key :: h.data.(i); h.size <- h.size + 1 ; - if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h end -let remove (h : _ t ) key = - let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with - | Empty -> - Empty - | Cons(k, i, next) -> - if eq_key k key - then begin h.size <- h.size - 1; next end - else Cons(k, i, remove_bucket next) in - let i = key_index h key in - h.data.(i) <- remove_bucket h.data.(i) - -let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with - | Empty -> - raise Not_found - | Cons(k, d, rest) -> - if eq_key key k then d else find_rec key rest - -let find_exn (h : _ t) key = - match h.data.(key_index h key) with - | Empty -> raise Not_found - | Cons(k1, d1, rest1) -> - if eq_key key k1 then d1 else - match rest1 with - | Empty -> raise Not_found - | Cons(k2, d2, rest2) -> - if eq_key key k2 then d2 else - match rest2 with - | Empty -> raise Not_found - | Cons(k3, d3, rest3) -> - if eq_key key k3 then d3 else find_rec key rest3 - -let find_opt (h : _ t) key = - Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key)) -let find_default (h : _ t) key default = - Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key)) -let find_all (h : _ t) key = - let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with - | Empty -> - [] - | Cons(k, d, rest) -> - if eq_key k key - then d :: find_in_bucket rest - else find_in_bucket rest in - find_in_bucket h.data.(key_index h key) - -let replace h key info = - let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with - | Empty -> - raise_notrace Not_found - | Cons(k, i, next) -> - if eq_key k key - then Cons(key, info, next) - else Cons(k, i, replace_bucket next) in - let i = key_index h key in - let l = h.data.(i) in - try - h.data.(i) <- replace_bucket l - with Not_found -> - h.data.(i) <- Cons(key, info, l); - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + if not (Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data i)) then + begin + h.data.(i) <- key :: h.data.(i); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then Hash_set_gen.resize key_index h; + true + end + else false -let mem (h : _ t) key = - let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with - | Empty -> - false - | Cons(k, d, rest) -> - eq_key k key || mem_in_bucket rest in - mem_in_bucket h.data.(key_index h key) +let mem (h : _ Hash_set_gen.t) key = + Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) -let of_list2 ks vs = - let map = create 51 in - List.iter2 (fun k v -> add map k v) ks vs ; - map + end module Ext_ident : sig @@ -67248,161 +67257,174 @@ end = struct -type t = float - - -(* http://www.ecma-international.org/ecma-262/5.1/#sec-7.8.3 - http://caml.inria.fr/pub/docs/manual-ocaml/lex.html - {[ - float-literal ::= [-](0...9){0...9|_}[.{0...9|_}][(e|E)][(e|E)[+|-](0...9){0...9|_}] - ]} - In ocaml, the interpretation of floating-point literals that - fall outside the range of representable floating-point values is undefined. - Also, (_) are accepted - - see https://github.com/ocaml/ocaml/pull/268 that ocaml will have HEXADECIMAL notation - support in 4.3 - - The Hex part is quite different - *) - - - -let to_string v = - if v = infinity - then "Infinity" - else if v = neg_infinity - then "-Infinity" - else if v <> v - then "NaN" - else - let vint = (int_of_float v) - (* TODO: check if 32-bits will loose some precision *) - in - if float_of_int vint = v - then - string_of_int vint - else - let s1 = Printf.sprintf "%.12g" v in - if v = float_of_string s1 - then s1 - else - let s2 = Printf.sprintf "%.15g" v in - if v = float_of_string s2 - then s2 - else Printf.sprintf "%.18g" v - - - -let caml_float_literal_to_js_string v = - let len = String.length v in - if len >= 2 && - v.[0] = '0' && - (v.[1] = 'x' || v.[1] = 'X') then - assert false - (* TODO: catchup when upgraded to 4.3 - it does not make sense too much since js dos not - support it natively - *) - else - - let rec aux buf i = - if i >= len then buf +type t = float + + +(* http://www.ecma-international.org/ecma-262/5.1/#sec-7.8.3 + http://caml.inria.fr/pub/docs/manual-ocaml/lex.html + {[ + float-literal ::= [-](0...9){0...9|_}[.{0...9|_}][(e|E)][(e|E)[+|-](0...9){0...9|_}] + ]} + In ocaml, the interpretation of floating-point literals that + fall outside the range of representable floating-point values is undefined. + Also, (_) are accepted + + see https://github.com/ocaml/ocaml/pull/268 that ocaml will have HEXADECIMAL notation + support in 4.3 + + The Hex part is quite different + *) + + + +let to_string v = + if v = infinity + then "Infinity" + else if v = neg_infinity + then "-Infinity" + else if v <> v + then "NaN" + else + let vint = (int_of_float v) + (* TODO: check if 32-bits will loose some precision *) + in + if float_of_int vint = v + then + string_of_int vint + else + let s1 = Printf.sprintf "%.12g" v in + if v = float_of_string s1 + then s1 + else + let s2 = Printf.sprintf "%.15g" v in + if v = float_of_string s2 + then s2 + else Printf.sprintf "%.18g" v + + + +let caml_float_literal_to_js_string v = + let len = String.length v in + if len >= 2 && + v.[0] = '0' && + (v.[1] = 'x' || v.[1] = 'X') then + assert false + (* TODO: catchup when upgraded to 4.3 + it does not make sense too much since js dos not + support it natively + *) + else + + let rec aux buf i = + if i >= len then buf + else + let x = v.[i] in + if x = '_' then + aux buf (i + 1) + else if x = '.' && i = len - 1 then + buf + else + begin + Buffer.add_char buf x ; + aux buf ( i + 1) + end in + Buffer.contents (aux (Buffer.create len) 0) + + +end +module Config_util : sig +#1 "config_util.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + + + +(** A simple wrapper around [Config] module in compiler-libs, so that the search path + is the same +*) + + +val find_opt : string -> string option +(** [find filename] Input is a file name, output is absolute path *) + + +val find_cmj : string -> Js_cmj_format.t + +end = struct +#1 "config_util.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + +let find_in_path_uncap path name = + let uname = String.uncapitalize name in + let rec try_dir = function + | [] -> None + | dir::rem -> + let ufullname = Filename.concat dir uname in + if Sys.file_exists ufullname then Some ufullname else - let x = v.[i] in - if x = '_' then - aux buf (i + 1) - else if x = '.' && i = len - 1 then - buf - else - begin - Buffer.add_char buf x ; - aux buf ( i + 1) - end in - Buffer.contents (aux (Buffer.create len) 0) - - -end -module Config_util : sig -#1 "config_util.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - - - -(** A simple wrapper around [Config] module in compiler-libs, so that the search path - is the same -*) - - -val find : string -> string -(** [find filename] Input is a file name, output is absolute path *) - - -val find_cmj : string -> Js_cmj_format.t - -end = struct -#1 "config_util.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - + let fullname = Filename.concat dir name in + if Sys.file_exists fullname then Some fullname + else try_dir rem + in try_dir path (* ATTENTION: lazy to wait [Config.load_path] populated *) -let find file = Misc.find_in_path_uncap !Config.load_path file +let find_opt file = find_in_path_uncap !Config.load_path file + @@ -67411,14 +67433,14 @@ let find file = Misc.find_in_path_uncap !Config.load_path file make sure that the distributed files are platform independent *) let find_cmj file = - match find file with - | f + match find_opt file with + | Some f -> Js_cmj_format.from_file f - | exception Not_found -> + | None -> (* ONLY read the stored cmj data in browser environment *) - Bs_exception.error (Cmj_not_found file) + Bs_exception.error (Cmj_not_found file) @@ -67442,7 +67464,7 @@ let key_index (h : _ t ) (key : key) = (* (Bs_hash_stubs.hash_string_int key.name key.stamp ) land (Array.length h.data - 1) *) let eq_key = Ext_ident.equal -# 24 +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -67554,6 +67576,7 @@ let of_list2 ks vs = List.iter2 (fun k v -> add map k v) ks vs ; map + end module Lam_analysis : sig #1 "lam_analysis.mli" @@ -68191,6 +68214,134 @@ let safe_to_inline (lam : Lam.t) = | Lconst (Const_pointer _ | Const_immstring _ ) -> true | _ -> false +end +module Hashtbl_make += struct +#1 "hashtbl_make.ml" +# 22 "ext/hashtbl.cppo.ml" +module Make (Key : Hashtbl.HashedType) = struct +type key = Key.t +type 'a t = (key, 'a) Hashtbl_gen.t +let key_index (h : _ t ) (key : key) = + (Key.hash key ) land (Array.length h.data - 1) +let eq_key = Key.equal + + +# 33 +type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist +let create = Hashtbl_gen.create +let clear = Hashtbl_gen.clear +let reset = Hashtbl_gen.reset +let copy = Hashtbl_gen.copy +let iter = Hashtbl_gen.iter +let fold = Hashtbl_gen.fold +let length = Hashtbl_gen.length +let stats = Hashtbl_gen.stats + + + +let add (h : _ t) key info = + let i = key_index h key in + let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in + h.data.(i) <- bucket; + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *) +let modify_or_init (h : _ t) key modf default = + let rec find_bucket (bucketlist : _ bucketlist) = + match bucketlist with + | Cons(k,i,next) -> + if eq_key k key then begin modf i; false end + else find_bucket next + | Empty -> true in + let i = key_index h key in + if find_bucket h.data.(i) then + begin + h.data.(i) <- Cons(key,default (),h.data.(i)); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + end + +let remove (h : _ t ) key = + let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + Empty + | Cons(k, i, next) -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else Cons(k, i, remove_bucket next) in + let i = key_index h key in + h.data.(i) <- remove_bucket h.data.(i) + +let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + raise Not_found + | Cons(k, d, rest) -> + if eq_key key k then d else find_rec key rest + +let find_exn (h : _ t) key = + match h.data.(key_index h key) with + | Empty -> raise Not_found + | Cons(k1, d1, rest1) -> + if eq_key key k1 then d1 else + match rest1 with + | Empty -> raise Not_found + | Cons(k2, d2, rest2) -> + if eq_key key k2 then d2 else + match rest2 with + | Empty -> raise Not_found + | Cons(k3, d3, rest3) -> + if eq_key key k3 then d3 else find_rec key rest3 + +let find_opt (h : _ t) key = + Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key)) +let find_default (h : _ t) key default = + Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key)) +let find_all (h : _ t) key = + let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + [] + | Cons(k, d, rest) -> + if eq_key k key + then d :: find_in_bucket rest + else find_in_bucket rest in + find_in_bucket h.data.(key_index h key) + +let replace h key info = + let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + raise_notrace Not_found + | Cons(k, i, next) -> + if eq_key k key + then Cons(key, info, next) + else Cons(k, i, replace_bucket next) in + let i = key_index h key in + let l = h.data.(i) in + try + h.data.(i) <- replace_bucket l + with Not_found -> + h.data.(i) <- Cons(key, info, l); + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +let mem (h : _ t) key = + let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + false + | Cons(k, d, rest) -> + eq_key k key || mem_in_bucket rest in + mem_in_bucket h.data.(key_index h key) + + +let of_list2 ks vs = + let map = create 51 in + List.iter2 (fun k v -> add map k v) ks vs ; + map + +# 145 +end + end module Lam_module_ident : sig #1 "lam_module_ident.mli" @@ -68247,6 +68398,8 @@ val of_external : Ident.t -> string -> t val of_runtime : Ident.t -> t +module Hash : Hashtbl_gen.S with type key = t + end = struct #1 "lam_module_ident.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -68304,6 +68457,15 @@ let name x : string = (* OCaml runtime written in JS *) type module_property = bool +module Hash = Hashtbl_make.Make(struct + type nonrec t = t + let hash x = + let x_id = x.id in + Bs_hash_stubs.hash_stamp_and_name x_id.stamp x_id.name + let equal (x : t) y = + Ext_ident.equal x.id y.id && x.kind = y.kind + end) + end module Lam_print : sig #1 "lam_print.mli" @@ -70718,11 +70880,11 @@ type ident_info = { -let cached_tbl : (module_id , env_value) Hashtbl.t = Hashtbl.create 31 +let cached_tbl = Lam_module_ident.Hash.create 31 (* For each compilation we need reset to make it re-entrant *) let reset () = - Hashtbl.clear cached_tbl + Lam_module_ident.Hash.clear cached_tbl (* FIXME: JS external instead *) let add_js_module ?id module_name = @@ -70730,17 +70892,17 @@ let add_js_module ?id module_name = match id with | None -> Ext_ident.create_js_module module_name | Some id -> id in - Hashtbl.replace cached_tbl (Lam_module_ident.of_external id module_name) External; + Lam_module_ident.Hash.replace cached_tbl (Lam_module_ident.of_external id module_name) External; id -let add_cached_tbl = Hashtbl.add cached_tbl +let add_cached_tbl = Lam_module_ident.Hash.add cached_tbl let find_and_add_if_not_exist (id, pos) env ~not_found ~found = let oid = Lam_module_ident.of_ml id in - begin match Hashtbl.find cached_tbl oid with - | exception Not_found -> + begin match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in begin match Type_util.find_serializable_signatures_by_path @@ -70765,7 +70927,7 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = else None } end - | Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } -> + | Some (Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } ) -> let name = (Type_util.get_name serializable_sigs pos ) in let arity , closed_lambda = ( match String_map.find_opt name values with @@ -70783,8 +70945,8 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = else None (* TODO shall we cache the arity ?*) } - | Runtime _ -> assert false - | External -> assert false + | Some (Runtime _) -> assert false + | Some External -> assert false end @@ -70799,8 +70961,8 @@ type _ t = let query_and_add_if_not_exist (type u) (oid : Lam_module_ident.t) (env : u t) ~not_found ~found:(found : u -> _) = - match Hashtbl.find cached_tbl oid with - | exception Not_found -> + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> begin match oid.kind with | Runtime -> let cmj_table = @@ -70843,21 +71005,21 @@ let query_and_add_if_not_exist (type u) end end - | Visit {signatures ; cmj_table = cmj_table; _} -> + | Some (Visit {signatures ; cmj_table = cmj_table; _}) -> begin match env with | Has_env _ -> found { signature = signatures ; pure = (cmj_table.effect = None)} | No_env -> found cmj_table end - | Runtime (pure, cmj_table) -> + | Some (Runtime (pure, cmj_table)) -> begin match env with | Has_env _ -> found {signature = [] ; pure } | No_env -> found cmj_table end - | External -> + | Some External -> begin match env with | Has_env _ -> found {signature = [] ; pure = false} @@ -70887,7 +71049,7 @@ let get_requried_modules env (extras : module_id list ) (hard_dependencies let mem (x : Lam_module_ident.t) = not (is_pure x ) || Hash_set_poly.mem hard_dependencies x in - Hashtbl.iter (fun (id : module_id) _ -> + Lam_module_ident.Hash.iter (fun (id : module_id) _ -> if mem id then Hash_set_poly.add hard_dependencies id) cached_tbl ; List.iter (fun id -> @@ -71088,14 +71250,12 @@ let string_of_module_id ~output_prefix (`Empty | `Package_script _) , (`Empty | `Package_script _) -> - begin match Config_util.find js_file with - | file -> + begin match Config_util.find_opt js_file with + | Some file -> let package_dir = Lazy.force Ext_filename.package_dir in rebase package_dir (`File file) - | exception Not_found -> - Ext_pervasives.failwithf ~loc:__LOC__ - "@[%s was not found in search path - while compiling %s @] " - js_file !Location.input_name + | None -> + Bs_exception.error (Js_not_found js_file) end end | External name -> name in @@ -85615,7 +85775,8 @@ let key_index (h : _ t ) (key : key) = (Bs_hash_stubs.hash_int key ) land (Array.length h.data - 1) let eq_key = Ext_int.equal -# 24 + +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -85727,6 +85888,7 @@ let of_list2 ks vs = List.iter2 (fun k v -> add map k v) ks vs ; map + end module Lam_pass_exits : sig #1 "lam_pass_exits.mli" diff --git a/jscomp/bsb/sexp_eval.ml b/jscomp/bsb/sexp_eval.ml index b1b7909e1f..51a7b99e40 100644 --- a/jscomp/bsb/sexp_eval.ml +++ b/jscomp/bsb/sexp_eval.ml @@ -1,4 +1,4 @@ -type env = (string, Sexp_lexer.t) Hashtbl.t +type env = Sexp_lexer.t String_hashtbl.t let rec print fmt (x : Sexp_lexer.t) = match x with @@ -15,7 +15,7 @@ let rec print fmt (x : Sexp_lexer.t) = (Format.pp_print_list ~pp_sep:(Format.pp_print_space) print) vs let print_env fmt env = - Hashtbl.iter (fun k v -> + String_hashtbl.iter (fun k v -> Format.fprintf fmt "@[%s@ ->@ %a@]@." k print v @@ -29,10 +29,10 @@ exception Unbound_value of string let rec eval env (x : Sexp_lexer.t) : Sexp_lexer.t = match x with | Atom x -> - begin match Hashtbl.find env x with - | exception Not_found + begin match String_hashtbl.find_opt env x with + | None -> raise (Unbound_value x) - | x -> x + | Some x -> x end | Lit _ -> x | Data xs -> List xs @@ -44,10 +44,10 @@ let rec eval env (x : Sexp_lexer.t) : Sexp_lexer.t = match rest with | Sexp_lexer.Atom x :: v :: rest -> let xvalue = eval env v in - Hashtbl.add env x xvalue ; + String_hashtbl.add env x xvalue ; loop xvalue rest | [Atom x] - -> Hashtbl.add env x nil ; nil + -> String_hashtbl.add env x nil ; nil | [] -> last_value | (Lit _ | Data _ | List _ ) :: _ -> assert false in @@ -57,13 +57,13 @@ let rec eval env (x : Sexp_lexer.t) : Sexp_lexer.t = let eval_file s = let sexps = Sexp_lexer.from_file s in - let env : (string, Sexp_lexer.t) Hashtbl.t= Hashtbl.create 64 in + let env : Sexp_lexer.t String_hashtbl.t= String_hashtbl.create 64 in List.iter (fun x -> ignore (eval env x )) sexps ; env let eval_string s = let sexps = Sexp_lexer.token (Lexing.from_string s) in - let env : (string, Sexp_lexer.t) Hashtbl.t = Hashtbl.create 64 in + let env : Sexp_lexer.t String_hashtbl.t = String_hashtbl.create 64 in List.iter (fun x -> ignore (eval env x )) sexps ; env @@ -77,19 +77,19 @@ exception Expect of string * ty let error (x,ty) = raise (Expect (x,ty) ) let expect_string (key, default) (global_data : env) = - match Hashtbl.find global_data key with + match String_hashtbl.find_exn global_data key with | exception Not_found -> default | Atom s | Lit s -> s | List _ | Data _ -> error (key, String) let expect_string_opt key (global_data : env) = - match Hashtbl.find global_data key with + match String_hashtbl.find_exn global_data key with | exception Not_found -> None | Atom s | Lit s -> Some s | List _ | Data _ -> error (key, String) let expect_string_list key (global_data : env) = - match Hashtbl.find global_data key with + match String_hashtbl.find_exn global_data key with | exception Not_found -> [ ] | Atom _ | Lit _ | Data _ -> error(key, List String) | List xs -> @@ -103,7 +103,7 @@ let expect_string_list_unordered key (global_data : env) init update = - match Hashtbl.find global_data key with + match String_hashtbl.find_exn global_data key with | exception Not_found -> init | Atom _ | Lit _ | Data _ -> error(key, List String) @@ -115,7 +115,7 @@ let expect_string_list_unordered ) init files (* let rec expect_file_groups key (global_data : env) = *) -(* match Hashtbl.find global_data key with *) +(* match String_hashtbl.find global_data key with *) (* | exception Not_found -> [] *) (* | Atom _ | Lit _ *) (* | Data _ -> error (key, List Any) *) diff --git a/jscomp/core/config_util.ml b/jscomp/core/config_util.ml index 406f6caa4a..360ef1a570 100644 --- a/jscomp/core/config_util.ml +++ b/jscomp/core/config_util.ml @@ -27,11 +27,24 @@ +let find_in_path_uncap path name = + let uname = String.uncapitalize name in + let rec try_dir = function + | [] -> None + | dir::rem -> + let ufullname = Filename.concat dir uname in + if Sys.file_exists ufullname then Some ufullname + else + let fullname = Filename.concat dir name in + if Sys.file_exists fullname then Some fullname + else try_dir rem + in try_dir path (* ATTENTION: lazy to wait [Config.load_path] populated *) -let find file = Misc.find_in_path_uncap !Config.load_path file +let find_opt file = find_in_path_uncap !Config.load_path file + @@ -40,31 +53,31 @@ let find file = Misc.find_in_path_uncap !Config.load_path file make sure that the distributed files are platform independent *) let find_cmj file = - match find file with - | f + match find_opt file with + | Some f -> Js_cmj_format.from_file f - | exception Not_found -> + | None -> (* ONLY read the stored cmj data in browser environment *) #if BS_COMPILER_IN_BROWSER then - let target = String.uncapitalize (Filename.basename file) in - match String_map.find target Js_cmj_datasets.data_sets with - | v - -> - begin match Lazy.force v with - | exception _ - -> - Ext_log.warn __LOC__ - "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target (Js_config.get_current_file ()) ; - Js_cmj_format.no_pure_dummy; (* FIXME *) - | v -> v - end - | exception Not_found - -> - Ext_log.warn __LOC__ "@[%s not found @]" file ; - Js_cmj_format.no_pure_dummy + let target = String.uncapitalize (Filename.basename file) in + match String_map.find target Js_cmj_datasets.data_sets with + | v + -> + begin match Lazy.force v with + | exception _ + -> + Ext_log.warn __LOC__ + "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target (Js_config.get_current_file ()) ; + Js_cmj_format.no_pure_dummy; (* FIXME *) + | v -> v + end + | exception Not_found + -> + Ext_log.warn __LOC__ "@[%s not found @]" file ; + Js_cmj_format.no_pure_dummy #else - Bs_exception.error (Cmj_not_found file) + Bs_exception.error (Cmj_not_found file) #end diff --git a/jscomp/core/config_util.mli b/jscomp/core/config_util.mli index 69d9506cc7..c3c453d245 100644 --- a/jscomp/core/config_util.mli +++ b/jscomp/core/config_util.mli @@ -34,7 +34,7 @@ *) -val find : string -> string +val find_opt : string -> string option (** [find filename] Input is a file name, output is absolute path *) diff --git a/jscomp/core/js_program_loader.ml b/jscomp/core/js_program_loader.ml index 29cbace542..9f293bf6dc 100644 --- a/jscomp/core/js_program_loader.ml +++ b/jscomp/core/js_program_loader.ml @@ -138,14 +138,12 @@ let string_of_module_id ~output_prefix (`Empty | `Package_script _) , (`Empty | `Package_script _) -> - begin match Config_util.find js_file with - | file -> + begin match Config_util.find_opt js_file with + | Some file -> let package_dir = Lazy.force Ext_filename.package_dir in rebase package_dir (`File file) - | exception Not_found -> - Ext_pervasives.failwithf ~loc:__LOC__ - "@[%s was not found in search path - while compiling %s @] " - js_file !Location.input_name + | None -> + Bs_exception.error (Js_not_found js_file) end end | External name -> name in diff --git a/jscomp/core/lam_compile_env.ml b/jscomp/core/lam_compile_env.ml index ab893c7765..797c8935dd 100644 --- a/jscomp/core/lam_compile_env.ml +++ b/jscomp/core/lam_compile_env.ml @@ -75,11 +75,11 @@ type ident_info = { -let cached_tbl : (module_id , env_value) Hashtbl.t = Hashtbl.create 31 +let cached_tbl = Lam_module_ident.Hash.create 31 (* For each compilation we need reset to make it re-entrant *) let reset () = - Hashtbl.clear cached_tbl + Lam_module_ident.Hash.clear cached_tbl (* FIXME: JS external instead *) let add_js_module ?id module_name = @@ -87,17 +87,17 @@ let add_js_module ?id module_name = match id with | None -> Ext_ident.create_js_module module_name | Some id -> id in - Hashtbl.replace cached_tbl (Lam_module_ident.of_external id module_name) External; + Lam_module_ident.Hash.replace cached_tbl (Lam_module_ident.of_external id module_name) External; id -let add_cached_tbl = Hashtbl.add cached_tbl +let add_cached_tbl = Lam_module_ident.Hash.add cached_tbl let find_and_add_if_not_exist (id, pos) env ~not_found ~found = let oid = Lam_module_ident.of_ml id in - begin match Hashtbl.find cached_tbl oid with - | exception Not_found -> + begin match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> let cmj_table = Config_util.find_cmj (id.name ^ Js_config.cmj_ext) in begin match Type_util.find_serializable_signatures_by_path @@ -122,7 +122,7 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = else None } end - | Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } -> + | Some (Visit { signatures = serializable_sigs ; cmj_table = { values ; _} } ) -> let name = (Type_util.get_name serializable_sigs pos ) in let arity , closed_lambda = ( match String_map.find_opt name values with @@ -140,8 +140,8 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = else None (* TODO shall we cache the arity ?*) } - | Runtime _ -> assert false - | External -> assert false + | Some (Runtime _) -> assert false + | Some External -> assert false end @@ -156,8 +156,8 @@ type _ t = let query_and_add_if_not_exist (type u) (oid : Lam_module_ident.t) (env : u t) ~not_found ~found:(found : u -> _) = - match Hashtbl.find cached_tbl oid with - | exception Not_found -> + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> begin match oid.kind with | Runtime -> let cmj_table = @@ -200,21 +200,21 @@ let query_and_add_if_not_exist (type u) end end - | Visit {signatures ; cmj_table = cmj_table; _} -> + | Some (Visit {signatures ; cmj_table = cmj_table; _}) -> begin match env with | Has_env _ -> found { signature = signatures ; pure = (cmj_table.effect = None)} | No_env -> found cmj_table end - | Runtime (pure, cmj_table) -> + | Some (Runtime (pure, cmj_table)) -> begin match env with | Has_env _ -> found {signature = [] ; pure } | No_env -> found cmj_table end - | External -> + | Some External -> begin match env with | Has_env _ -> found {signature = [] ; pure = false} @@ -244,7 +244,7 @@ let get_requried_modules env (extras : module_id list ) (hard_dependencies let mem (x : Lam_module_ident.t) = not (is_pure x ) || Hash_set_poly.mem hard_dependencies x in - Hashtbl.iter (fun (id : module_id) _ -> + Lam_module_ident.Hash.iter (fun (id : module_id) _ -> if mem id then Hash_set_poly.add hard_dependencies id) cached_tbl ; List.iter (fun id -> diff --git a/jscomp/core/lam_module_ident.ml b/jscomp/core/lam_module_ident.ml index aa64f1a447..bdf975068f 100644 --- a/jscomp/core/lam_module_ident.ml +++ b/jscomp/core/lam_module_ident.ml @@ -52,3 +52,12 @@ let name x : string = (* OCaml runtime written in JS *) type module_property = bool + +module Hash = Hashtbl_make.Make(struct + type nonrec t = t + let hash x = + let x_id = x.id in + Bs_hash_stubs.hash_stamp_and_name x_id.stamp x_id.name + let equal (x : t) y = + Ext_ident.equal x.id y.id && x.kind = y.kind + end) diff --git a/jscomp/core/lam_module_ident.mli b/jscomp/core/lam_module_ident.mli index 99d259c2c7..4108e83797 100644 --- a/jscomp/core/lam_module_ident.mli +++ b/jscomp/core/lam_module_ident.mli @@ -50,3 +50,5 @@ val of_ml : Ident.t -> t val of_external : Ident.t -> string -> t val of_runtime : Ident.t -> t + +module Hash : Hashtbl_gen.S with type key = t diff --git a/jscomp/depends/ast_extract.ml b/jscomp/depends/ast_extract.ml index 283212acd2..64f46722bf 100644 --- a/jscomp/depends/ast_extract.ml +++ b/jscomp/depends/ast_extract.ml @@ -233,7 +233,7 @@ let collect_from_main ) acc (Sys.readdir dirname)) [] extra_dirs in let ast_table = collect_ast_map ppf files parse_implementation parse_interface in - let visited = Hashtbl.create 31 in + let visited = String_hashtbl.create 31 in let result = Queue.create () in let next module_name = match String_map.find_exn module_name ast_table with @@ -252,7 +252,7 @@ let collect_from_main if String_set.mem current visiting then Bs_exception.error (Bs_cyclic_depends (current::path)) else - if not (Hashtbl.mem visited current) + if not (String_hashtbl.mem visited current) && String_map.mem current ast_table then begin String_set.iter @@ -261,7 +261,7 @@ let collect_from_main (current::path)) (next current) ; Queue.push current result; - Hashtbl.add visited current (); + String_hashtbl.add visited current (); end in visit (String_set.empty) [] main_module ; ast_table, result diff --git a/jscomp/depends/bs_exception.ml b/jscomp/depends/bs_exception.ml index 3846b2ebf0..e206fdf2be 100644 --- a/jscomp/depends/bs_exception.ml +++ b/jscomp/depends/bs_exception.ml @@ -25,6 +25,7 @@ type error = | Cmj_not_found of string + | Js_not_found of string | Bs_cyclic_depends of string list | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) @@ -39,6 +40,8 @@ let error err = raise (Error err) let report_error ppf = function | Cmj_not_found s -> Format.fprintf ppf "%s not found, cmj format is generated by BuckleScript" s + | Js_not_found s -> + Format.fprintf ppf "%s not found, needed in script mode " s | Bs_cyclic_depends str -> Format.fprintf ppf "Cyclic depends : @[%a@]" diff --git a/jscomp/depends/bs_exception.mli b/jscomp/depends/bs_exception.mli index d99557d1aa..9d63f82ffb 100644 --- a/jscomp/depends/bs_exception.mli +++ b/jscomp/depends/bs_exception.mli @@ -24,6 +24,7 @@ type error = | Cmj_not_found of string + | Js_not_found of string | Bs_cyclic_depends of string list | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) diff --git a/jscomp/ext/ext_hashtbl.ml b/jscomp/ext/ext_hashtbl.ml deleted file mode 100644 index 9cf8550896..0000000000 --- a/jscomp/ext/ext_hashtbl.ml +++ /dev/null @@ -1,45 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - -let of_list kvs = - let map = Hashtbl.create 51 in - List.iter (fun (k, v) -> Hashtbl.add map k v) kvs ; - map - - -let of_list2 ks vs = - let map = Hashtbl.create 51 in - List.iter2 (fun k v -> Hashtbl.add map k v) ks vs ; - map - -let add_list map kvs = - List.iter (fun (k, v) -> Hashtbl.add map k v) kvs - -let add_list2 map ks vs = - List.iter2 (fun k v -> Hashtbl.add map k v) ks vs ; diff --git a/jscomp/ext/ext_hashtbl.mli b/jscomp/ext/ext_hashtbl.mli deleted file mode 100644 index d1ed745d2d..0000000000 --- a/jscomp/ext/ext_hashtbl.mli +++ /dev/null @@ -1,38 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - -(* -val of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t - -val of_list2 : 'a list -> 'b list -> ('a, 'b) Hashtbl.t - -val add_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list -> unit - -val add_list2 : ('a, 'b) Hashtbl.t -> 'a list -> 'b list -> unit -*) diff --git a/jscomp/ext/hashtbl.cppo.ml b/jscomp/ext/hashtbl.cppo.ml index c4df450d39..a5829e1024 100644 --- a/jscomp/ext/hashtbl.cppo.ml +++ b/jscomp/ext/hashtbl.cppo.ml @@ -17,6 +17,15 @@ type 'a t = (key, 'a) Hashtbl_gen.t let key_index (h : _ t ) (key : key) = (Bs_hash_stubs.hash_int key ) land (Array.length h.data - 1) let eq_key = Ext_int.equal + +#elif defined TYPE_FUNCTOR +module Make (Key : Hashtbl.HashedType) = struct +type key = Key.t +type 'a t = (key, 'a) Hashtbl_gen.t +let key_index (h : _ t ) (key : key) = + (Key.hash key ) land (Array.length h.data - 1) +let eq_key = Key.equal + #else [%error "unknown type"] #endif @@ -131,3 +140,7 @@ let of_list2 ks vs = let map = create 51 in List.iter2 (fun k v -> add map k v) ks vs ; map + +#if defined TYPE_FUNCTOR +end +#endif diff --git a/jscomp/ext/hashtbl_make.ml b/jscomp/ext/hashtbl_make.ml new file mode 100644 index 0000000000..68415dbbec --- /dev/null +++ b/jscomp/ext/hashtbl_make.ml @@ -0,0 +1,123 @@ +# 22 "ext/hashtbl.cppo.ml" +module Make (Key : Hashtbl.HashedType) = struct +type key = Key.t +type 'a t = (key, 'a) Hashtbl_gen.t +let key_index (h : _ t ) (key : key) = + (Key.hash key ) land (Array.length h.data - 1) +let eq_key = Key.equal + + +# 33 +type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist +let create = Hashtbl_gen.create +let clear = Hashtbl_gen.clear +let reset = Hashtbl_gen.reset +let copy = Hashtbl_gen.copy +let iter = Hashtbl_gen.iter +let fold = Hashtbl_gen.fold +let length = Hashtbl_gen.length +let stats = Hashtbl_gen.stats + + + +let add (h : _ t) key info = + let i = key_index h key in + let bucket : _ bucketlist = Cons(key, info, h.data.(i)) in + h.data.(i) <- bucket; + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *) +let modify_or_init (h : _ t) key modf default = + let rec find_bucket (bucketlist : _ bucketlist) = + match bucketlist with + | Cons(k,i,next) -> + if eq_key k key then begin modf i; false end + else find_bucket next + | Empty -> true in + let i = key_index h key in + if find_bucket h.data.(i) then + begin + h.data.(i) <- Cons(key,default (),h.data.(i)); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + end + +let remove (h : _ t ) key = + let rec remove_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + Empty + | Cons(k, i, next) -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else Cons(k, i, remove_bucket next) in + let i = key_index h key in + h.data.(i) <- remove_bucket h.data.(i) + +let rec find_rec key (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + raise Not_found + | Cons(k, d, rest) -> + if eq_key key k then d else find_rec key rest + +let find_exn (h : _ t) key = + match h.data.(key_index h key) with + | Empty -> raise Not_found + | Cons(k1, d1, rest1) -> + if eq_key key k1 then d1 else + match rest1 with + | Empty -> raise Not_found + | Cons(k2, d2, rest2) -> + if eq_key key k2 then d2 else + match rest2 with + | Empty -> raise Not_found + | Cons(k3, d3, rest3) -> + if eq_key key k3 then d3 else find_rec key rest3 + +let find_opt (h : _ t) key = + Hashtbl_gen.small_bucket_opt eq_key key (Array.unsafe_get h.data (key_index h key)) +let find_default (h : _ t) key default = + Hashtbl_gen.small_bucket_default eq_key key default (Array.unsafe_get h.data (key_index h key)) +let find_all (h : _ t) key = + let rec find_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + [] + | Cons(k, d, rest) -> + if eq_key k key + then d :: find_in_bucket rest + else find_in_bucket rest in + find_in_bucket h.data.(key_index h key) + +let replace h key info = + let rec replace_bucket (bucketlist : _ bucketlist) : _ bucketlist = match bucketlist with + | Empty -> + raise_notrace Not_found + | Cons(k, i, next) -> + if eq_key k key + then Cons(key, info, next) + else Cons(k, i, replace_bucket next) in + let i = key_index h key in + let l = h.data.(i) in + try + h.data.(i) <- replace_bucket l + with Not_found -> + h.data.(i) <- Cons(key, info, l); + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then Hashtbl_gen.resize key_index h + +let mem (h : _ t) key = + let rec mem_in_bucket (bucketlist : _ bucketlist) = match bucketlist with + | Empty -> + false + | Cons(k, d, rest) -> + eq_key k key || mem_in_bucket rest in + mem_in_bucket h.data.(key_index h key) + + +let of_list2 ks vs = + let map = create 51 in + List.iter2 (fun k v -> add map k v) ks vs ; + map + +# 145 +end diff --git a/jscomp/ext/hashtbl_make.mli b/jscomp/ext/hashtbl_make.mli new file mode 100644 index 0000000000..bd6a13ad14 --- /dev/null +++ b/jscomp/ext/hashtbl_make.mli @@ -0,0 +1,3 @@ + + +module Make (Key : Hashtbl.HashedType) : Hashtbl_gen.S with type key = Key.t diff --git a/jscomp/ext/ident_hashtbl.ml b/jscomp/ext/ident_hashtbl.ml index 0dabd8d46c..008d63b598 100644 --- a/jscomp/ext/ident_hashtbl.ml +++ b/jscomp/ext/ident_hashtbl.ml @@ -6,7 +6,7 @@ let key_index (h : _ t ) (key : key) = (* (Bs_hash_stubs.hash_string_int key.name key.stamp ) land (Array.length h.data - 1) *) let eq_key = Ext_ident.equal -# 24 +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -117,3 +117,4 @@ let of_list2 ks vs = let map = create 51 in List.iter2 (fun k v -> add map k v) ks vs ; map + diff --git a/jscomp/ext/int_hashtbl.ml b/jscomp/ext/int_hashtbl.ml index 87537f99ee..7acf7e0a51 100644 --- a/jscomp/ext/int_hashtbl.ml +++ b/jscomp/ext/int_hashtbl.ml @@ -5,7 +5,8 @@ let key_index (h : _ t ) (key : key) = (Bs_hash_stubs.hash_int key ) land (Array.length h.data - 1) let eq_key = Ext_int.equal -# 24 + +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -116,3 +117,4 @@ let of_list2 ks vs = let map = create 51 in List.iter2 (fun k v -> add map k v) ks vs ; map + diff --git a/jscomp/ext/string_hashtbl.ml b/jscomp/ext/string_hashtbl.ml index 88634b3d71..d976ac190e 100644 --- a/jscomp/ext/string_hashtbl.ml +++ b/jscomp/ext/string_hashtbl.ml @@ -5,7 +5,7 @@ let key_index (h : _ t ) (key : key) = (Bs_hash_stubs.hash_string key ) land (Array.length h.data - 1) let eq_key = Ext_string.equal -# 24 +# 33 type ('a, 'b) bucketlist = ('a,'b) Hashtbl_gen.bucketlist let create = Hashtbl_gen.create let clear = Hashtbl_gen.clear @@ -116,3 +116,4 @@ let of_list2 ks vs = let map = create 51 in List.iter2 (fun k v -> add map k v) ks vs ; map + diff --git a/jscomp/test/ext_filename.js b/jscomp/test/ext_filename.js index 0cb43851b2..84cc97298c 100644 --- a/jscomp/test/ext_filename.js +++ b/jscomp/test/ext_filename.js @@ -485,17 +485,12 @@ function normalize_absolute_path(x) { } function get_extension(x) { - try { - var pos = Bytes.rindex(Caml_string.bytes_of_string(x), /* "." */46); - return Ext_string.tail_from(x, pos); + var pos = Ext_string.rindex_neg(x, /* "." */46); + if (pos < 0) { + return ""; } - catch (exn){ - if (exn === Caml_builtin_exceptions.not_found) { - return ""; - } - else { - throw exn; - } + else { + return Ext_string.tail_from(x, pos); } }