diff --git a/.gitignore b/.gitignore index 4c8c71bb5a..3b4df6898a 100644 --- a/.gitignore +++ b/.gitignore @@ -89,6 +89,7 @@ odoc_gen/*.cmxs lib/prebuilt.ninja lib/release.ninja lib/build.ninja +lib/copy.ninja jscomp/release.ninja jscomp/build.ninja jscomp/compiler.ninja @@ -134,7 +135,6 @@ jscomp/ext/string_set.ml jscomp/outcome_printer/tweaked_reason_oprint.ml jscomp/outcome_printer/reason_syntax_util.ml jscomp/outcome_printer/reason_syntax_util.mli -native/bin -native/lib -native/main +jscomp/bin/all_ounit_tests.ml +native/ vendor/ocaml \ No newline at end of file diff --git a/jscomp/bin/all_ounit_tests.mli b/jscomp/bin/all_ounit_tests.mli deleted file mode 100644 index 948db8faa8..0000000000 --- a/jscomp/bin/all_ounit_tests.mli +++ /dev/null @@ -1 +0,0 @@ -(* *) diff --git a/jscomp/bin/bspack.mli b/jscomp/bin/bspack.mli deleted file mode 100644 index 8b13789179..0000000000 --- a/jscomp/bin/bspack.mli +++ /dev/null @@ -1 +0,0 @@ - diff --git a/jscomp/core/config_whole_compiler.ml b/jscomp/core/config_whole_compiler.ml index 10f2057498..e2f9f2c891 100644 --- a/jscomp/core/config_whole_compiler.ml +++ b/jscomp/core/config_whole_compiler.ml @@ -15,7 +15,7 @@ (**************************************************************************) (* The main OCaml version string has moved to ../VERSION *) -let version = "4.06.2+BS" +let version = "4.06.1+BS" let standard_library = Filename.concat (Filename.dirname Sys.executable_name) "ocaml" let standard_library_default = standard_library diff --git a/jscomp/depends/ast_extract.ml b/jscomp/depends/ast_extract.ml index f1389fb439..cc7b263f59 100644 --- a/jscomp/depends/ast_extract.ml +++ b/jscomp/depends/ast_extract.ml @@ -39,6 +39,7 @@ type 'a kind = 'a Ml_binary.kind let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> List.iter (fun modname -> #if OCAML_VERSION =~ ">4.03.0" then @@ -50,7 +51,7 @@ let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = | Ml_binary.Ml -> Depend.add_implementation bound_vars ast | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); !Depend.free_structure_names - + end type ('a,'b) ast_info = | Ml of diff --git a/jscomp/envConfig.ninja b/jscomp/envConfig.ninja deleted file mode 100644 index 572f9a6225..0000000000 --- a/jscomp/envConfig.ninja +++ /dev/null @@ -1,3 +0,0 @@ -ocamlopt = ocamlopt.opt -ocamllex = ocamllex.opt -ocamlmklib = ocamlmklib diff --git a/jscomp/main/ounit_tests_main.ml b/jscomp/main/ounit_tests_main.ml index 8a8d39c693..d8c9a6c7ea 100644 --- a/jscomp/main/ounit_tests_main.ml +++ b/jscomp/main/ounit_tests_main.ml @@ -41,7 +41,8 @@ let suites = Ounit_utf8_test.suites; Ounit_unicode_tests.suites; Ounit_bsb_regex_tests.suites; - Ounit_bsb_pkg_tests.suites + Ounit_bsb_pkg_tests.suites; + Ounit_depends_format_test.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/jscomp/ounit_tests/ounit_cmd_util.ml b/jscomp/ounit_tests/ounit_cmd_util.ml index 777ca7ab6f..7c18c01dfd 100644 --- a/jscomp/ounit_tests/ounit_cmd_util.ml +++ b/jscomp/ounit_tests/ounit_cmd_util.ml @@ -12,7 +12,12 @@ let bsc_bin = project_root // "lib" let bsc_exe = bsc_bin // "bsc.exe" let runtime_dir = jscomp // "runtime" let others_dir = jscomp // "others" -let stdlib_dir = jscomp // "stdlib" + +#if OCAML_VERSION =~ ">4.03.0" then +let stdlib_dir = jscomp // "stdlib-406" +#else +let stdlib_dir = jscomp // "stdlib-402" +#end let rec safe_dup fd = let new_fd = Unix.dup fd in diff --git a/jscomp/ounit_tests/ounit_depends_format_test.ml b/jscomp/ounit_tests/ounit_depends_format_test.ml index fab55ee294..6b4888e15d 100644 --- a/jscomp/ounit_tests/ounit_depends_format_test.ml +++ b/jscomp/ounit_tests/ounit_depends_format_test.ml @@ -1,9 +1,20 @@ let ((>::), (>:::)) = OUnit.((>::),(>:::)) -let (=~) = OUnit.assert_equal +let (=~) (xs : string list) (ys : string list) = + OUnit.assert_equal xs ys + ~printer:(fun xs -> String.concat "," xs ) + +let f (x : string) = + let stru = Parse.implementation (Lexing.from_string x) in + Ast_extract.String_set.elements (Ast_extract.read_parse_and_extract Ml_binary.Ml stru) + + let suites = __FILE__ >::: [ - + __LOC__ >:: begin fun _ -> + f {|module X = List|} =~ ["List"]; + f {|module X = List module X0 = List1|} =~ ["List";"List1"] + end ] \ No newline at end of file diff --git a/jscomp/snapshot.ninja b/jscomp/snapshot.ninja index 7897ad9fd7..a238a06acd 100644 --- a/jscomp/snapshot.ninja +++ b/jscomp/snapshot.ninja @@ -16,7 +16,7 @@ OCAML_SRC_TOOLS=$NATIVE_OCAML_PATH/tools includes = -I stubs -I ext -I common -I syntax -I depends -I core -I super_errors -I outcome_printer -I bsb -I ounit -I ounit_tests -I main SNAP=../lib/$snapshot_path -build snapshot: phony $SNAP/whole_compiler.ml $SNAP/bsppx.ml $SNAP/bsdep.ml $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/bspp.ml bin/all_ounit_tests.ml +build snapshot: phony $SNAP/whole_compiler.ml $SNAP/bsppx.ml $SNAP/bsdep.ml $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/bspp.ml $SNAP/unstable/all_ounit_tests.ml build $SNAP/whole_compiler.ml: bspack | ./bin/bspack.exe flags = ${releaseMode} -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER ${includes} @@ -45,24 +45,26 @@ build $SNAP/bspp.ml: bspack | ./bin/bspack.exe flags = -D BS_MIN_LEX_DEPS=true ${releaseMode} -bs-MD -module-alias Config=Config_whole_compiler -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING?parser -I common -I ext -I syntax -I depends -I bspp -I core -I main main = Bspp_main -build ./bin/bsb_native.ml: bspack | ./bin/bspack.exe +build $SNAP/unstable/bsb_native.ml: bspack | ./bin/bspack.exe flags = -D BS_MIN_LEX_DEPS=true -D BS_NATIVE=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I syntax -I depends -I bsb -I ext -I main main = Bsb_main -build ./bin/native_ppx.ml: bspack | ./bin/bspack.exe +build $SNAP/unstable/native_ppx.ml: bspack | ./bin/bspack.exe flags = -D BS_MIN_LEX_DEPS=true -D BS_NATIVE=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I syntax -I depends -I bsb -I ext -I main main = Native_ppx_main -rule bsbnative - command = $ocamlopt -w -a unix.cmxa str.cmxa ./stubs/ext_basic_hash_stubs.c $in -o $out -# only check if it compiles -build ./bin/bsb_native.exe: bsbnative ./bin/bsb_native.ml -build bin/all_ounit_tests.ml: bspack | ./bin/bspack.exe +build $SNAP/unstable/all_ounit_tests.ml: bspack | ./bin/bspack.exe flags = -bs-MD -I ounit -I ounit_tests -I stubs -I bsb -I common -I ext -I syntax -I depends -I bspp -I core -I main main = Ounit_tests_main -build bin/bspack.ml: bspack | ./bin/bspack.exe +build $SNAP/unstable/bspack.ml: bspack | ./bin/bspack.exe flags = -bs-MD -module-alias Config=Config_whole_compiler -I $OCAML_SRC_PARSING -I $OCAML_SRC_UTILS -I stubs -I ext -I common -I depends -I core -I main -bs-main Bspack_main main = Bspack_main +# Check it later +# rule bsbnative +# command = $ocamlopt -w -a unix.cmxa str.cmxa ./stubs/ext_basic_hash_stubs.c $in -o $out +# only check if it compiles +# build $SNAP/unstable/bsb_native.exe: bsbnative ./bin/bsb_native.ml + diff --git a/jscomp/vendorConfig.ninja b/jscomp/vendorConfig.ninja deleted file mode 100644 index c6f0a5470c..0000000000 --- a/jscomp/vendorConfig.ninja +++ /dev/null @@ -1,4 +0,0 @@ - -ocamlopt = ../native/bin/ocamlopt.opt -ocamllex = ../native/bin/ocamllex.opt -ocamlmklib = ../native/bin/ocamlmklib diff --git a/lib/4.02.3+BS/bsb.mli b/lib/4.02.3+BS/bsb.mli deleted file mode 100644 index 03ee5d5f11..0000000000 --- a/lib/4.02.3+BS/bsb.mli +++ /dev/null @@ -1 +0,0 @@ -(**) diff --git a/lib/4.02.3+BS/bsb_helper.mli b/lib/4.02.3+BS/bsb_helper.mli deleted file mode 100644 index 03ee5d5f11..0000000000 --- a/lib/4.02.3+BS/bsb_helper.mli +++ /dev/null @@ -1 +0,0 @@ -(**) diff --git a/lib/4.02.3+BS/bsdep.mli b/lib/4.02.3+BS/bsdep.mli deleted file mode 100644 index 948db8faa8..0000000000 --- a/lib/4.02.3+BS/bsdep.mli +++ /dev/null @@ -1 +0,0 @@ -(* *) diff --git a/lib/4.02.3+BS/bspp.mli b/lib/4.02.3+BS/bspp.mli deleted file mode 100644 index 948db8faa8..0000000000 --- a/lib/4.02.3+BS/bspp.mli +++ /dev/null @@ -1 +0,0 @@ -(* *) diff --git a/lib/4.02.3+BS/bsppx.mli b/lib/4.02.3+BS/bsppx.mli deleted file mode 100644 index 139597f9cb..0000000000 --- a/lib/4.02.3+BS/bsppx.mli +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/lib/4.02.3+BS/whole_compiler.mli b/lib/4.02.3+BS/whole_compiler.mli deleted file mode 100644 index 43bee504f9..0000000000 --- a/lib/4.02.3+BS/whole_compiler.mli +++ /dev/null @@ -1 +0,0 @@ -(** *) diff --git a/lib/4.02.3+BS/bsb.ml b/lib/4.02.3/bsb.ml similarity index 100% rename from lib/4.02.3+BS/bsb.ml rename to lib/4.02.3/bsb.ml diff --git a/lib/4.02.3+BS/bsb.ml.d b/lib/4.02.3/bsb.ml.d similarity index 99% rename from lib/4.02.3+BS/bsb.ml.d rename to lib/4.02.3/bsb.ml.d index 0721542bea..c07707bc52 100644 --- a/lib/4.02.3+BS/bsb.ml.d +++ b/lib/4.02.3/bsb.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/bsb.ml: +../lib/4.02.3/bsb.ml: ./bsb/bsb_build_schemas.ml ./bsb/bsb_build_util.ml ./bsb/bsb_build_util.mli diff --git a/lib/4.02.3+BS/reactjs_jsx_ppx_v2.mli b/lib/4.02.3/bsb.mli similarity index 100% rename from lib/4.02.3+BS/reactjs_jsx_ppx_v2.mli rename to lib/4.02.3/bsb.mli diff --git a/lib/4.02.3+BS/bsb_helper.ml b/lib/4.02.3/bsb_helper.ml similarity index 100% rename from lib/4.02.3+BS/bsb_helper.ml rename to lib/4.02.3/bsb_helper.ml diff --git a/lib/4.02.3+BS/bsb_helper.ml.d b/lib/4.02.3/bsb_helper.ml.d similarity index 96% rename from lib/4.02.3+BS/bsb_helper.ml.d rename to lib/4.02.3/bsb_helper.ml.d index 8a137fc4b0..9765d88c4a 100644 --- a/lib/4.02.3+BS/bsb_helper.ml.d +++ b/lib/4.02.3/bsb_helper.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/bsb_helper.ml: +../lib/4.02.3/bsb_helper.ml: ./bsb/bsb_db.ml ./bsb/bsb_db.mli ./bsb/bsb_db_io.ml diff --git a/lib/4.06.1+BS/reactjs_jsx_ppx_v2.mli b/lib/4.02.3/bsb_helper.mli similarity index 100% rename from lib/4.06.1+BS/reactjs_jsx_ppx_v2.mli rename to lib/4.02.3/bsb_helper.mli diff --git a/lib/4.02.3+BS/bsdep.ml b/lib/4.02.3/bsdep.ml similarity index 100% rename from lib/4.02.3+BS/bsdep.ml rename to lib/4.02.3/bsdep.ml diff --git a/lib/4.02.3+BS/bsdep.ml.d b/lib/4.02.3/bsdep.ml.d similarity index 99% rename from lib/4.02.3+BS/bsdep.ml.d rename to lib/4.02.3/bsdep.ml.d index 859c4a53be..b78e0d6d7e 100644 --- a/lib/4.02.3+BS/bsdep.ml.d +++ b/lib/4.02.3/bsdep.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/bsdep.ml: +../lib/4.02.3/bsdep.ml: ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/pparse.ml diff --git a/lib/4.02.3/bsdep.mli b/lib/4.02.3/bsdep.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.02.3+BS/bspp.ml b/lib/4.02.3/bspp.ml similarity index 100% rename from lib/4.02.3+BS/bspp.ml rename to lib/4.02.3/bspp.ml diff --git a/lib/4.02.3+BS/bspp.ml.d b/lib/4.02.3/bspp.ml.d similarity index 94% rename from lib/4.02.3+BS/bspp.ml.d rename to lib/4.02.3/bspp.ml.d index 3008ae05f3..542bf19aad 100644 --- a/lib/4.02.3+BS/bspp.ml.d +++ b/lib/4.02.3/bspp.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/bspp.ml: +../lib/4.02.3/bspp.ml: ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml diff --git a/lib/4.02.3/bspp.mli b/lib/4.02.3/bspp.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.02.3+BS/bsppx.ml b/lib/4.02.3/bsppx.ml similarity index 100% rename from lib/4.02.3+BS/bsppx.ml rename to lib/4.02.3/bsppx.ml diff --git a/lib/4.02.3+BS/bsppx.ml.d b/lib/4.02.3/bsppx.ml.d similarity index 99% rename from lib/4.02.3+BS/bsppx.ml.d rename to lib/4.02.3/bsppx.ml.d index 23cab2c7e8..12d7f4372c 100644 --- a/lib/4.02.3+BS/bsppx.ml.d +++ b/lib/4.02.3/bsppx.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/bsppx.ml: +../lib/4.02.3/bsppx.ml: ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/asttypes.mli diff --git a/lib/4.02.3/bsppx.mli b/lib/4.02.3/bsppx.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.02.3+BS/reactjs_jsx_ppx_v2.ml b/lib/4.02.3/reactjs_jsx_ppx_v2.ml similarity index 100% rename from lib/4.02.3+BS/reactjs_jsx_ppx_v2.ml rename to lib/4.02.3/reactjs_jsx_ppx_v2.ml diff --git a/lib/4.02.3/reactjs_jsx_ppx_v2.mli b/lib/4.02.3/reactjs_jsx_ppx_v2.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.02.3+BS/refmt_main3.ml b/lib/4.02.3/refmt_main3.ml similarity index 100% rename from lib/4.02.3+BS/refmt_main3.ml rename to lib/4.02.3/refmt_main3.ml diff --git a/lib/4.02.3+BS/refmt_main3.mli b/lib/4.02.3/refmt_main3.mli similarity index 100% rename from lib/4.02.3+BS/refmt_main3.mli rename to lib/4.02.3/refmt_main3.mli diff --git a/jscomp/bin/all_ounit_tests.ml b/lib/4.02.3/unstable/all_ounit_tests.ml similarity index 93% rename from jscomp/bin/all_ounit_tests.ml rename to lib/4.02.3/unstable/all_ounit_tests.ml index 34229c7dd3..d363a0e473 100644 --- a/jscomp/bin/all_ounit_tests.ml +++ b/lib/4.02.3/unstable/all_ounit_tests.ml @@ -7903,7 +7903,10 @@ let bsc_bin = project_root // "lib" let bsc_exe = bsc_bin // "bsc.exe" let runtime_dir = jscomp // "runtime" let others_dir = jscomp // "others" -let stdlib_dir = jscomp // "stdlib" + + +let stdlib_dir = jscomp // "stdlib-402" + let rec safe_dup fd = let new_fd = Unix.dup fd in @@ -8275,91 +8278,8 @@ external ff : end -module Ounit_ffi_error_debug_test -= struct -#1 "ounit_ffi_error_debug_test.ml" -let (//) = Filename.concat - - - - -let ((>::), - (>:::)) = OUnit.((>::),(>:::)) - -let (=~) = OUnit.assert_equal - - - - -let bsc_eval = Ounit_cmd_util.bsc_check_eval - -let debug_output = Ounit_cmd_util.debug_output - - -let suites = - __FILE__ - >::: [ - __LOC__ >:: begin fun _ -> - let output = bsc_eval {| -external err : - hi_should_error:([`a of int | `b of string ] [@bs.string]) -> - unit -> _ = "" [@@bs.obj] - |} in - OUnit.assert_bool __LOC__ - (Ext_string.contain_substring output.stderr "hi_should_error") - end; - __LOC__ >:: begin fun _ -> -let output = bsc_eval {| - external err : - ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> - unit -> _ = "" [@@bs.obj] - |} in - OUnit.assert_bool __LOC__ - (Ext_string.contain_substring output.stderr "hi_should_error") - end; - __LOC__ >:: begin fun _ -> - let output = bsc_eval {| - external err : - ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> - unit -> unit = "" [@@bs.val] - |} in - OUnit.assert_bool __LOC__ - (Ext_string.contain_substring output.stderr "hi_should_error") - end; - - __LOC__ >:: begin fun _ -> - (** - Each [@bs.unwrap] variant constructor requires an argument - *) - let output = - bsc_eval {| - external err : - ?hi_should_error:([`a of int | `b] [@bs.unwrap]) -> unit -> unit = "" [@@bs.val] - |} - in - OUnit.assert_bool __LOC__ - (Ext_string.contain_substring output.stderr "bs.unwrap") - end; - - __LOC__ >:: begin fun _ -> - (** - [@bs.unwrap] args are not supported in [@@bs.obj] functions - *) - let output = - bsc_eval {| - external err : - ?hi_should_error:([`a of int] [@bs.unwrap]) -> unit -> _ = "" [@@bs.obj] - |} - in - OUnit.assert_bool __LOC__ - (Ext_string.contain_substring output.stderr "hi_should_error") - end - - ] - -end -module Ext_util : sig -#1 "ext_util.mli" +module Bs_exception : sig +#1 "bs_exception.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8384,14 +8304,30 @@ module Ext_util : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string +(* +TODO: In the futrue, we should refine dependency [bsb] +should not rely on such exception, it should have its own exception handling +*) - -val power_2_above : int -> int -> int +(* exception Error of error *) +(* val report_error : Format.formatter -> error -> unit *) + +val error : error -> 'a -val stats_to_string : Hashtbl.statistics -> string end = struct -#1 "ext_util.ml" +#1 "bs_exception.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8416,29 +8352,69 @@ end = struct * 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 +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string + (** TODO: we need add location handling *) +exception Error of error + +let error err = raise (Error err) + +let report_error ppf = function + | Dependency_script_module_dependent_not s + -> + Format.fprintf ppf + "%s is compiled in script mode while its dependent is not" + s + | Missing_ml_dependency s -> + Format.fprintf ppf "Missing dependency %s in search path" s + | Cmj_not_found s -> + Format.fprintf ppf "%s not found, it means either the module does not exist or it is a namespace" 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@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_space + Format.pp_print_string) + str + | Bs_duplicate_exports str -> + Format.fprintf ppf "%s are exported as twice" str + | Bs_duplicated_module (a,b) + -> + Format.fprintf ppf "The build system does not support two files with same names yet %s, %s" a b + | Bs_main_not_exist main + -> + Format.fprintf ppf "File %s not found " main + + | Bs_package_not_found package + -> + Format.fprintf ppf "Package %s not found or %s/lib/ocaml does not exist or please set npm_config_prefix correctly" + package package + | Bs_invalid_path path + -> Format.pp_print_string ppf ("Invalid path: " ^ path ) + + +let () = + Location.register_error_of_exn + (function + | Error err + -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) -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 -#1 "hash_set_gen.ml" +module Ext_format : sig +#1 "ext_format.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8464,149 +8440,54 @@ module Hash_set_gen * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. *) -type 'a t = - { mutable size: int; (* number of entries *) - mutable data: 'a list array; (* the buckets *) - initial_size: int; (* initial array size *) - } -let create initial_size = - let s = Ext_util.power_2_above 16 initial_size in - { initial_size = s; size = 0; data = Array.make s [] } -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - Array.unsafe_set h.data i [] - done +(** Simplified wrapper module for the standard library [Format] module. + *) -let reset h = - h.size <- 0; - h.data <- Array.make h.initial_size [ ] +type t = private Format.formatter +val string : t -> string -> unit -let copy h = { h with data = Array.copy h.data } +val break : t -> unit -let length h = h.size +val break1 : t -> unit -let iter h f = - let rec do_bucket = function - | [ ] -> - () - | k :: rest -> - f k ; 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 +val space : t -> unit -let fold h init f = - let rec do_bucket b accu = - match b with - [ ] -> - accu - | k :: rest -> - do_bucket rest (f k accu) in - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket (Array.unsafe_get d i) !accu - done; - !accu +val group : t -> int -> (unit -> 'a) -> 'a +(** [group] will record current indentation + and indent futher + *) -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 [ ] in - h.data <- ndata; (* so that indexfun sees the new bucket count *) - let rec insert_bucket = function - [ ] -> () - | key :: rest -> - let nidx = indexfun h key in - ndata.(nidx) <- key :: ndata.(nidx); - insert_bucket rest - in - for i = 0 to osize - 1 do - insert_bucket (Array.unsafe_get odata i) - done - end +val vgroup : t -> int -> (unit -> 'a) -> 'a -let elements set = - fold set [] (fun k acc -> k :: acc) +val paren : t -> (unit -> 'a) -> 'a +val paren_group : t -> int -> (unit -> 'a) -> 'a +val brace_group : t -> int -> (unit -> 'a) -> 'a +val brace_vgroup : t -> int -> (unit -> 'a) -> 'a -let stats h = - let mbl = - Ext_array.fold_left h.data 0 (fun m b -> max m (List.length b)) in - let histo = Array.make (mbl + 1) 0 in - Ext_array.iter h.data - (fun b -> - let l = List.length b in - histo.(l) <- histo.(l) + 1) - ; - {Hashtbl.num_bindings = h.size; - num_buckets = Array.length h.data; - max_bucket_length = mbl; - bucket_histogram = histo } +val bracket_group : t -> int -> (unit -> 'a) -> 'a -let rec small_bucket_mem eq_key key lst = - match lst with - | [] -> false - | key1::rest -> - eq_key key key1 || - match rest with - | [] -> false - | key2 :: rest -> - eq_key key key2 || - match rest with - | [] -> false - | key3 :: rest -> - eq_key key key3 || - small_bucket_mem eq_key key rest +val newline : t -> unit -let rec remove_bucket eq_key key (h : _ t) buckets = - match buckets with - | [ ] -> - [ ] - | k :: next -> - if eq_key k key - then begin h.size <- h.size - 1; next end - else k :: remove_bucket eq_key key h next +val to_out_channel : out_channel -> t -module type S = -sig - type key - type t - val create: int -> t - val clear : t -> unit - val reset : t -> unit - val copy: t -> t - val remove: t -> key -> unit - val add : t -> key -> unit - val of_array : key array -> t - val check_add : t -> key -> bool - val mem : t -> key -> bool - val iter: t -> (key -> unit) -> unit - val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b - val length: t -> int - val stats: t -> Hashtbl.statistics - val elements : t -> key list -end +val flush : t -> unit -> unit -end -module Hash_set : sig -#1 "hash_set.mli" +val pp_print_queue : + ?pp_sep:(Format.formatter -> unit -> unit) -> + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Queue.t -> unit + +end = struct +#1 "ext_format.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8631,23 +8512,92 @@ module Hash_set : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** Ideas are based on {!Hashtbl}, - however, {!Hashtbl.add} does not really optimize and has a bad semantics for {!Hash_set}, - This module fixes the semantics of [add]. - [remove] is not optimized since it is not used too much -*) -module Make ( H : Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) -(** A naive t implementation on top of [hashtbl], the value is [unit]*) -end = struct -#1 "hash_set.ml" -# 1 "ext/hash_set.cppo.ml" +open Format + +type t = formatter + +let string = pp_print_string + +let break = fun fmt -> pp_print_break fmt 0 0 + +let break1 = + fun fmt -> pp_print_break fmt 0 1 + +let space fmt = + pp_print_break fmt 1 0 + +let vgroup fmt indent u = + pp_open_vbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let group fmt indent u = + pp_open_hovbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let paren fmt u = + string fmt "("; + let v = u () in + string fmt ")"; + v + +let brace fmt u = + string fmt "{"; + (* break1 fmt ; *) + let v = u () in + string fmt "}"; + v + +let bracket fmt u = + string fmt "["; + let v = u () in + string fmt "]"; + v + +let paren_group st n action = + group st n (fun _ -> paren st action) + +let brace_group st n action = + group st n (fun _ -> brace st action ) + +let brace_vgroup st n action = + vgroup st n (fun _ -> + string st "{"; + pp_print_break st 0 2; + let v = vgroup st 0 action in + pp_print_break st 0 0; + string st "}"; + v + ) +let bracket_group st n action = + group st n (fun _ -> bracket st action) + +let newline fmt = pp_print_newline fmt () + +let to_out_channel = formatter_of_out_channel + +(* let non_breaking_space fmt = string fmt " " *) +(* let set_needed_space_function _ _ = () *) +let flush = pp_print_flush + +let list = pp_print_list + +let rec pp_print_queue ?(pp_sep = pp_print_cut) pp_v ppf q = + Queue.iter (fun q -> pp_v ppf q ; pp_sep ppf ()) q + +end +module Ext_ref : sig +#1 "ext_ref.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8671,83 +8621,106 @@ 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. *) -# 43 "ext/hash_set.cppo.ml" -module Make (H: Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) = struct -type key = H.t -let eq_key = H.equal -let key_index (h : _ Hash_set_gen.t ) key = - (H.hash key) land (Array.length h.data - 1) -type t = key Hash_set_gen.t - - - -# 64 "ext/hash_set.cppo.ml" -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 +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - - -let check_add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - 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 +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b +end = struct +#1 "ext_ref.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 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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res -# 124 "ext/hash_set.cppo.ml" -end - +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e end -module Hash_set_poly : sig -#1 "hash_set_poly.mli" +module Js_config : sig +#1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8773,34 +8746,86 @@ module Hash_set_poly : sig * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type 'a t -val create : int -> 'a t -val clear : 'a t -> unit -val reset : 'a t -> unit +(* val get_packages_info : + unit -> Js_packages_info.t *) -val copy : 'a t -> 'a t -val add : 'a t -> 'a -> unit -val remove : 'a t -> 'a -> unit +(** set/get header *) +val no_version_header : bool ref -val mem : 'a t -> 'a -> bool -val iter : 'a t -> ('a -> unit) -> unit +(** return [package_name] and [path] + when in script mode: +*) + +(* val get_current_package_name_and_path : + Js_packages_info.module_system -> + Js_packages_info.info_query *) + + +(* val set_package_name : string -> unit +val get_package_name : unit -> string option *) + +(** cross module inline option *) +val cross_module_inline : bool ref +val set_cross_module_inline : bool -> unit +val get_cross_module_inline : unit -> bool + +(** diagnose option *) +val diagnose : bool ref +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit + + +(** options for builtin ppx *) +val no_builtin_ppx_ml : bool ref +val no_builtin_ppx_mli : bool ref + + + +val no_warn_unimplemented_external : bool ref + +(** check-div-by-zero option *) +val check_div_by_zero : bool ref +val get_check_div_by_zero : unit -> bool -val elements : 'a t -> 'a list -val length : 'a t -> int -val stats: 'a t -> Hashtbl.statistics + +(** Debugging utilies *) +val set_current_file : string -> unit +val get_current_file : unit -> string +val get_module_name : unit -> string + +val iset_debug_file : string -> unit +val set_debug_file : string -> unit +val get_debug_file : unit -> string + +val is_same_file : unit -> bool + +val tool_name : string + + +val sort_imports : bool ref +val dump_js : bool ref +val syntax_only : bool ref +val binary_ast : bool ref + + +val bs_suffix : bool ref +val debug : bool ref + +val cmi_only : bool ref +val force_cmi : bool ref +val force_cmj : bool ref end = struct -#1 "hash_set_poly.ml" -# 1 "ext/hash_set.cppo.ml" +#1 "js_config.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 @@ -8818,113 +8843,103 @@ end = struct * 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. *) -# 51 "ext/hash_set.cppo.ml" -[@@@ocaml.warning "-3"] -(* we used cppo the mixture does not work*) -external seeded_hash_param : - int -> int -> int -> 'a -> int = "caml_hash" "noalloc" -let key_index (h : _ Hash_set_gen.t ) (key : 'a) = - seeded_hash_param 10 100 0 key land (Array.length h.data - 1) -let eq_key = (=) -type 'a t = 'a Hash_set_gen.t -# 64 "ext/hash_set.cppo.ml" -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_npm_package_path s = + match !packages_info with + | Empty -> + Ext_pervasives.bad_argf "please set package name first using -bs-package-name "; + | NonBrowser(name, envs) -> + let env, path = + match Ext_string.split ~keep_empty:false s ':' with + | [ package_name; path] -> + (match Js_packages_info.module_system_of_string package_name with + | Some x -> x + | None -> + Ext_pervasives.bad_argf "invalid module system %s" package_name), path + | [path] -> + NodeJS, path + | _ -> + Ext_pervasives.bad_argf "invalid npm package path: %s" s + in + packages_info := NonBrowser (name, ((env,path) :: envs)) *) +(** Browser is not set via command line only for internal use *) -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end +let no_version_header = ref false -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - - -let check_add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - 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 cross_module_inline = ref false +let get_cross_module_inline () = !cross_module_inline +let set_cross_module_inline b = + cross_module_inline := b -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 diagnose = ref false +let get_diagnose () = !diagnose +let set_diagnose b = diagnose := b -end -module Bs_hash_stubs -= struct -#1 "bs_hash_stubs.ml" +let (//) = Filename.concat - -external hash_string : string -> int = "caml_bs_hash_string" "noalloc";; +(* let get_packages_info () = !packages_info *) -external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" "noalloc";; +let no_builtin_ppx_ml = ref false +let no_builtin_ppx_mli = ref false -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";; +(** TODO: will flip the option when it is ready *) +let no_warn_unimplemented_external = ref false +let current_file = ref "" +let debug_file = ref "" -external hash_small_int : int -> int = "caml_bs_hash_small_int" "noalloc";; +let set_current_file f = current_file := f +let get_current_file () = !current_file +let get_module_name () = + Filename.chop_extension + (Filename.basename (Ext_string.uncapitalize_ascii !current_file)) -external hash_int : int -> int = "caml_bs_hash_int" "noalloc";; +let iset_debug_file _ = () +let set_debug_file f = debug_file := f +let get_debug_file () = !debug_file -external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" "noalloc";; +let is_same_file () = + !debug_file <> "" && !debug_file = !current_file -external - int_unsafe_blit : - int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" "noalloc";; - +let tool_name = "BuckleScript" + +let check_div_by_zero = ref true +let get_check_div_by_zero () = !check_div_by_zero + + + +let sort_imports = ref true +let dump_js = ref false + + + +let syntax_only = ref false +let binary_ast = ref false + +let bs_suffix = ref false + +let debug = ref false + +let cmi_only = ref false +let force_cmi = ref false +let force_cmj = ref false end -module Ordered_hash_set_gen -= struct -#1 "ordered_hash_set_gen.ml" +module Ml_binary : sig +#1 "ml_binary.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -8949,337 +8964,395 @@ module Ordered_hash_set_gen * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -module type S = -sig - type key - type t - val create: int -> t - val clear: t -> unit - val reset: t -> unit - val copy: t -> t - val add: t -> key -> unit - val mem: t -> key -> bool - val rank: t -> key -> int (* -1 if not found*) - val iter: (key -> int -> unit) -> t -> unit - val fold: (key -> int -> 'b -> 'b) -> t -> 'b -> 'b - val length: t -> int - val stats: t -> Hashtbl.statistics - val choose_exn: t -> key - val of_array: key array -> t - val to_sorted_array: t -> key array - val replace: t -> key -> key -> unit - val reset_to_list : t -> key list -> unit - exception Replace_failure of bool -end - -exception Replace_failure of bool - - -(** when it is true, it means the old key does not exist , - when it is false, it means the new key already exist - *) - -(* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. *) -type 'a bucket = - | Empty - | Cons of 'a * int * 'a bucket - -type 'a t = - { mutable size: int; (* number of entries *) - mutable data: 'a bucket array; - mutable data_mask: int ; - initial_size: int; - } -(* Invariant - [data_mask = Array.length data - 1 ] - [Array.length data is power of 2] -*) -let create initial_size = - let initial_size = Ext_util.power_2_above 16 initial_size in - { initial_size ; - size = 0; - data = Array.make initial_size Empty; - data_mask = initial_size - 1 ; - } +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind -let clear h = - h.size <- 0; - let h_data = h.data in - for i = 0 to h.data_mask do - Array.unsafe_set h_data i Empty - done -(** Note this function is only used internally, make sure [h_initial_size] - is a power of 16 *) -let reset_with_size h h_initial_size = - h.size <- 0; - h.data <- Array.make h_initial_size Empty; - h.data_mask <- h_initial_size - 1 +val read_ast : 'a kind -> in_channel -> 'a -let reset h = - reset_with_size h h.initial_size +val write_ast : + 'a kind -> string -> 'a -> out_channel -> unit +end = struct +#1 "ml_binary.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 copy h = { h with data = Array.copy h.data } +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind + +(** [read_ast kind ic] assume [ic] channel is + in the right position *) +let read_ast (type t ) (kind : t kind) ic : t = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + let buffer = really_input_string ic (String.length magic) in + assert(buffer = magic); (* already checked by apply_rewriter *) + Location.input_name := input_value ic; + input_value ic + +let write_ast (type t) (kind : t kind) + (fname : string) + (pt : t) oc = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + output_string oc magic ; + output_value oc fname; + output_value oc pt +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" -let length h = h.size + +external hash_string : string -> int = "caml_bs_hash_string" "noalloc";; +external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" "noalloc";; -let rec insert_bucket nmask ndata hash = function - | Empty -> () - | Cons(key,info,rest) -> - let nidx = hash key land nmask in (* so that indexfun sees the new bucket count *) - Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); - insert_bucket nmask ndata hash rest +external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" "noalloc";; -let resize hash h = - let odata = h.data in - let odata_mask = h.data_mask in - let nsize = (odata_mask + 1) * 2 in - if nsize < Sys.max_array_length then begin - let ndata = Array.make nsize Empty in - h.data <- ndata; - let nmask = nsize - 1 in - h.data_mask <- nmask ; - for i = 0 to odata_mask do - match Array.unsafe_get odata i with - | Empty -> () - | Cons(key,info,rest) -> - let nidx = hash key land nmask in - Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); - insert_bucket nmask ndata hash rest - done - end +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";; -let rec do_bucket f = function - | Empty -> - () - | Cons(k ,i, rest) -> - f k i ; do_bucket f rest +external hash_int : int -> int = "caml_bs_hash_int" "noalloc";; -let iter f h = - let d = h.data in - for i = 0 to h.data_mask do - do_bucket f (Array.unsafe_get d i) - done +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" "noalloc";; -(* find one element *) -let choose_exn h = - let rec aux arr offset last_index = - if offset > last_index then - raise Not_found (* This happens when size is 0, otherwise it is never called *) - else - match Array.unsafe_get arr offset with - | Empty -> aux arr (offset + 1) last_index - | Cons (k,_,rest) -> k - in - let h_data = h.data in - aux h_data 0 h.data_mask -let fold f h init = - let rec do_bucket b accu = - match b with - Empty -> - accu - | Cons( k , i, rest) -> - do_bucket rest (f k i accu) in - let d = h.data in - let accu = ref init in - for i = 0 to h.data_mask do - accu := do_bucket (Array.unsafe_get d i) !accu - done; - !accu +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" "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. *) -let rec set_bucket arr = function - | Empty -> () - | Cons(k,i,rest) -> - Array.unsafe_set arr i k; - set_bucket arr rest -let to_sorted_array h = - if h.size = 0 then [||] - else - let v = choose_exn h in - let arr = Array.make h.size v in - let d = h.data in - for i = 0 to h.data_mask do - set_bucket arr (Array.unsafe_get d i) - done; - arr + +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. *) - -let rec bucket_length acc (x : _ bucket) = - match x with - | Empty -> acc - | Cons(_,_,rest) -> bucket_length (acc + 1) rest - -let stats h = - let mbl = - Ext_array.fold_left h.data 0 (fun m (b : _ bucket) -> max m (bucket_length 0 b)) in - let histo = Array.make (mbl + 1) 0 in - Ext_array.iter h.data - (fun b -> - let l = bucket_length 0 b in - histo.(l) <- histo.(l) + 1) - ; - { Hashtbl.num_bindings = h.size; - num_buckets = h.data_mask + 1 ; - max_bucket_length = mbl; - bucket_histogram = histo } +(** + {[ + (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 Ordered_hash_set_string : sig -#1 "ordered_hash_set_string.mli" +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 *) -include Ordered_hash_set_gen.S with type key = string -end = struct -#1 "ordered_hash_set_string.ml" +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 -# 11 "ext/ordered_hash_set.cppo.ml" - type key = string - type t = key Ordered_hash_set_gen.t - let hash = Bs_hash_stubs.hash_string - let equal_key = Ext_string.equal - -# 24 -open Ordered_hash_set_gen -exception Replace_failure = Replace_failure -let create = create -let clear = clear -let reset = reset -let copy = copy -let iter = iter -let fold = fold -let length = length -let stats = stats -let choose_exn = choose_exn -let to_sorted_array = to_sorted_array - - - -let rec small_bucket_mem key lst = - match lst with - | Empty -> false - | Cons(key1,_, rest) -> - equal_key key key1 || - match rest with - | Empty -> false - | Cons(key2 , _, rest) -> - equal_key key key2 || - match rest with - | Empty -> false - | Cons(key3,_, rest) -> - equal_key key key3 || - small_bucket_mem key rest - -let rec small_bucket_rank key lst = - match lst with - | Empty -> -1 - | Cons(key1,i,rest) -> - if equal_key key key1 then i - else match rest with - | Empty -> -1 - | Cons(key2,i2, rest) -> - if equal_key key key2 then i2 else - match rest with - | Empty -> -1 - | Cons(key3,i3, rest) -> - if equal_key key key3 then i3 else - small_bucket_rank key rest + (** return the key found in the hashtbl. + Use case: when you find the key existed in hashtbl, + you want to use the one stored in the hashtbl. + (they are semantically equivlanent, but may have other information different) + *) + val find_key_opt: 'a t -> key -> key option -let add h key = - let h_data_mask = h.data_mask in - let i = hash key land h_data_mask in - if not (small_bucket_mem key h.data.(i)) then - begin - Array.unsafe_set h.data i (Cons(key,h.size, Array.unsafe_get h.data i)); - h.size <- h.size + 1 ; - if h.size > Array.length h.data lsl 1 then resize hash h - end + val find_default: 'a t -> key -> 'a -> 'a -let old_key_not_exist = Replace_failure false -let new_key_already_exist = Replace_failure true + val replace: 'a t -> key -> 'a -> unit + val mem: 'a t -> key -> bool + val iter: 'a t -> (key -> 'a -> unit) -> 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 -let rec small_bucket_rank_and_delete key lst = - match lst with - | Empty -> raise old_key_not_exist - | Cons(key1,i,rest) -> - if equal_key key key1 then i, rest - else match rest with - | Empty -> raise old_key_not_exist - | Cons(key2,i2, rest) -> - if equal_key key key2 then i2, (Cons (key1,i,rest)) else - match rest with - | Empty -> raise old_key_not_exist - | Cons(key3,i3, rest) -> - if equal_key key key3 then i3, (Cons (key1,i,Cons(key2,i2,rest))) else - let (rank, rest ) = small_bucket_rank_and_delete key rest in - rank, Cons (key1,i, - Cons (key2,i2, - Cons(key3,i3,rest))) +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) -let replace h old_key new_key = - let h_data_mask = h.data_mask in - let i = hash old_key land h_data_mask in - let h_data = h.data in - let bucket = Array.unsafe_get h_data i in - let (rank,new_bucket) = small_bucket_rank_and_delete old_key bucket in - Array.unsafe_set h_data i new_bucket ; +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 *) + } - let j = hash new_key land h_data_mask in - let insert_bucket = Array.unsafe_get h_data j in - let mem = small_bucket_mem new_key insert_bucket in - if mem then raise new_key_already_exist - else - Array.unsafe_set h_data j (Cons (new_key,rank, insert_bucket)) +and ('a, 'b) bucketlist = + | Empty + | Cons of 'a * 'b * ('a, 'b) bucketlist -let of_array arr = - let len = Array.length arr in - let h = create len in - for i = 0 to len - 1 do - add h (Array.unsafe_get arr i) - done; - h -(* clear the Hashset and re-initialize it to [lst] *) -let reset_to_list h lst = - let len = List.length lst in - let () = Ordered_hash_set_gen.reset_with_size h (Ext_util.power_2_above 16 len) in - List.iter (fun x -> add h x ) lst +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 mem h key = - small_bucket_mem key (Array.unsafe_get h.data (hash key land h.data_mask)) +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 rank h key = - small_bucket_rank key (Array.unsafe_get h.data (hash key land h.data_mask)) +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 h f = + 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 = + Ext_array.fold_left h.data 0 (fun m b -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + {Hashtbl. + num_bindings = h.size; + num_buckets = Array.length h.data; + max_bucket_length = mbl; + bucket_histogram = histo } -end -module String_hash_set : sig -#1 "string_hash_set.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. +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_key_opt eq key (lst : _ bucketlist) : _ option = + match lst with + | Empty -> None + | Cons(k1,d1,rest1) -> + if eq key k1 then Some k1 else + match rest1 with + | Empty -> None + | Cons(k2,d2,rest2) -> + if eq key k2 then Some k2 else + match rest2 with + | Empty -> None + | Cons(k3,d3,rest3) -> + if eq key k3 then Some k3 else + small_bucket_key_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 @@ -9304,11 +9377,152 @@ module String_hash_set : sig * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -include Hash_set_gen.S with type key = string +include Hashtbl_gen.S with type key = string + + + end = struct -#1 "string_hash_set.ml" -# 1 "ext/hash_set.cppo.ml" +#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 "ext/hashtbl.cppo.ml" +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 h_data = h.data in + Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); + 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 + let h_data = h.data in + if find_bucket (Array.unsafe_get h_data i) then + begin + Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get 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 rec remove_bucket key (h : _ t) (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 key h next) + +let remove (h : _ t ) key = + let i = key_index h key in + let h_data = h.data in + let old_h_szie = h.size in + let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in + if old_h_szie <> h.size then + Array.unsafe_set h_data i new_bucket + +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 Array.unsafe_get 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_key_opt (h : _ t) key = + Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in + let l = Array.unsafe_get h_data i in + try + Array.unsafe_set h_data i (replace_bucket l) + with Not_found -> + begin + Array.unsafe_set 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; + end + +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 (Array.unsafe_get h.data (key_index h key)) + + +let of_list2 ks vs = + let len = List.length ks in + let map = create len in + List.iter2 (fun k v -> add map k v) ks vs ; + map + + +end +module Ast_extract : sig +#1 "ast_extract.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -9332,246 +9546,91 @@ 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 "ext/hash_set.cppo.ml" -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 -# 64 "ext/hash_set.cppo.ml" -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 - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - - -let check_add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - 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 +module String_set = Depend.StringSet +val read_parse_and_extract : 'a Ml_binary.kind -> 'a -> String_set.t -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)) +type ('a,'b) t - +val sort_files_by_dependencies : + domain:String_set.t -> String_set.t String_map.t -> string Queue.t -end -module Ounit_hash_set_tests -= struct -#1 "ounit_hash_set_tests.ml" -let ((>::), - (>:::)) = OUnit.((>::),(>:::)) -let (=~) = OUnit.assert_equal +val sort : + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + ('a, 'b) t String_map.t -> string Queue.t -type id = { name : string ; stamp : int } -module Id_hash_set = Hash_set.Make(struct - type t = id - let equal x y = x.stamp = y.stamp && x.name = y.name - let hash x = Hashtbl.hash x.stamp - end - ) -let const_tbl = [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "100"; "99"; "98"; - "97"; "96"; "95"; "94"; "93"; "92"; "91"; "90"; "89"; "88"; "87"; "86"; "85"; - "84"; "83"; "82"; "81"; "80"; "79"; "78"; "77"; "76"; "75"; "74"; "73"; "72"; - "71"; "70"; "69"; "68"; "67"; "66"; "65"; "64"; "63"; "62"; "61"; "60"; "59"; - "58"; "57"; "56"; "55"; "54"; "53"; "52"; "51"; "50"; "49"; "48"; "47"; "46"; - "45"; "44"; "43"; "42"; "41"; "40"; "39"; "38"; "37"; "36"; "35"; "34"; "33"; - "32"; "31"; "30"; "29"; "28"; "27"; "26"; "25"; "24"; "23"; "22"; "21"; "20"; - "19"; "18"; "17"; "16"; "15"; "14"; "13"; "12"; "11"|] -let suites = - __FILE__ - >::: - [ - __LOC__ >:: begin fun _ -> - let v = Hash_set_poly.create 31 in - for i = 0 to 1000 do - Hash_set_poly.add v i - done ; - OUnit.assert_equal (Hash_set_poly.length v) 1001 - end ; - __LOC__ >:: begin fun _ -> - let v = Hash_set_poly.create 31 in - for i = 0 to 1_0_000 do - Hash_set_poly.add v 0 - done ; - OUnit.assert_equal (Hash_set_poly.length v) 1 - end ; - __LOC__ >:: begin fun _ -> - let v = Hash_set_poly.create 30 in - for i = 0 to 2_000 do - Hash_set_poly.add v {name = "x" ; stamp = i} - done ; - for i = 0 to 2_000 do - Hash_set_poly.add v {name = "x" ; stamp = i} - done ; - for i = 0 to 2_000 do - assert (Hash_set_poly.mem v {name = "x"; stamp = i}) - done; - OUnit.assert_equal (Hash_set_poly.length v) 2_001; - for i = 1990 to 3_000 do - Hash_set_poly.remove v {name = "x"; stamp = i} - done ; - OUnit.assert_equal (Hash_set_poly.length v) 1990; - (* OUnit.assert_equal (Hash_set.stats v) *) - (* {Hashtbl.num_bindings = 1990; num_buckets = 1024; max_bucket_length = 7; *) - (* bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *) - end ; - __LOC__ >:: begin fun _ -> - let v = Id_hash_set.create 30 in - for i = 0 to 2_000 do - Id_hash_set.add v {name = "x" ; stamp = i} - done ; - for i = 0 to 2_000 do - Id_hash_set.add v {name = "x" ; stamp = i} - done ; - for i = 0 to 2_000 do - assert (Id_hash_set.mem v {name = "x"; stamp = i}) - done; - OUnit.assert_equal (Id_hash_set.length v) 2_001; - for i = 1990 to 3_000 do - Id_hash_set.remove v {name = "x"; stamp = i} - done ; - OUnit.assert_equal (Id_hash_set.length v) 1990; - for i = 1000 to 3990 do - Id_hash_set.remove v { name = "x"; stamp = i } - done; - OUnit.assert_equal (Id_hash_set.length v) 1000; - for i = 1000 to 1100 do - Id_hash_set.add v { name = "x"; stamp = i}; - done; - OUnit.assert_equal (Id_hash_set.length v ) 1101; - for i = 0 to 1100 do - OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i}) - done - (* OUnit.assert_equal (Hash_set.stats v) *) - (* {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *) - (* bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *) +(** + [build fmt files parse_implementation parse_interface] + Given a list of files return an ast table +*) +val collect_ast_map : + Format.formatter -> + string list -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a, 'b) t String_map.t - end - ; - __LOC__ >:: begin fun _ -> - let v = Ordered_hash_set_string.create 3 in - for i = 0 to 10 do - Ordered_hash_set_string.add v (string_of_int i) - done; - for i = 100 downto 2 do - Ordered_hash_set_string.add v (string_of_int i) - done; - OUnit.assert_equal (Ordered_hash_set_string.to_sorted_array v ) - const_tbl - end; - __LOC__ >:: begin fun _ -> - let duplicate arr = - let len = Array.length arr in - let rec aux tbl off = - if off >= len then None - else - let curr = (Array.unsafe_get arr off) in - if String_hash_set.check_add tbl curr then - aux tbl (off + 1) - else Some curr in - aux (String_hash_set.create len) 0 in - let v = [| "if"; "a"; "b"; "c" |] in - OUnit.assert_equal (duplicate v) None; - OUnit.assert_equal (duplicate [|"if"; "a"; "b"; "b"; "c"|]) (Some "b") - end; - __LOC__ >:: begin fun _ -> - let of_array lst = - let len = Array.length lst in - let tbl = String_hash_set.create len in - Ext_array.iter lst (String_hash_set.add tbl) ; tbl in - let hash = of_array const_tbl in - let len = String_hash_set.length hash in - String_hash_set.remove hash "x"; - OUnit.assert_equal len (String_hash_set.length hash); - String_hash_set.remove hash "0"; - OUnit.assert_equal (len - 1 ) (String_hash_set.length hash) - end - ] +type dir_spec = + { dir : string ; + mutable excludes : string list + } -end -module Int_hash_set : sig -#1 "int_hash_set.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. *) +(** If the genereated queue is empty, it means + 1. The main module does not exist (does not exist due to typo) + 2. It does exist but not in search path + The order matters from head to tail +*) +val collect_from_main : + ?extra_dirs:dir_spec list -> + ?excludes : string list -> + ?alias_map: string String_hashtbl.t -> + Format.formatter -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + string -> ('a, 'b) t String_map.t * string Queue.t + +val build_queue : + Format.formatter -> + string Queue.t -> + ('b, 'c) t String_map.t -> + (Format.formatter -> string -> string -> 'b -> unit) -> + (Format.formatter -> string -> string -> 'c -> unit) -> unit + +val handle_queue : + Format.formatter -> + string Queue.t -> + ('a, 'b) t String_map.t -> + (string -> string -> 'a -> unit) -> + (string -> string -> 'b -> unit) -> + (string -> string -> string -> 'b -> 'a -> unit) -> unit + + +val build_lazy_queue : + Format.formatter -> + string Queue.t -> + (Parsetree.structure lazy_t, Parsetree.signature lazy_t) t String_map.t -> + (Format.formatter -> string -> string -> Parsetree.structure -> unit) -> + (Format.formatter -> string -> string -> Parsetree.signature -> unit) -> unit -include Hash_set_gen.S with type key = int end = struct -#1 "int_hash_set.ml" -# 1 "ext/hash_set.cppo.ml" +#1 "ast_extract.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -9595,375 +9654,1554 @@ 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. *) -# 25 "ext/hash_set.cppo.ml" -type key = int -let key_index (h : _ Hash_set_gen.t ) (key : key) = - (Bs_hash_stubs.hash_int key) land (Array.length h.data - 1) -let eq_key = Ext_int.equal -type t = key Hash_set_gen.t - -# 64 "ext/hash_set.cppo.ml" -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 +type module_name = private string +module String_set = Depend.StringSet +(* FIXME: [Clflags.open_modules] seems not to be properly used *) + +let bound_vars = String_set.empty -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 +type 'a kind = 'a Ml_binary.kind -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end +let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = + Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> + List.iter + (fun modname -> + + Depend.open_module bound_vars (Longident.Lident modname)) + (!Clflags.open_modules); + (match k with + | Ml_binary.Ml -> Depend.add_implementation bound_vars ast + | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); + !Depend.free_structure_names + end -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - - -let check_add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (key :: old_bucket); - 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 +type ('a,'b) ast_info = + | Ml of + string * (* sourcefile *) + 'a * + string (* opref *) + | Mli of string * (* sourcefile *) + 'b * + string (* opref *) + | Ml_mli of + string * (* sourcefile *) + 'a * + string * (* opref1 *) + string * (* sourcefile *) + 'b * + string (* opref2*) + +type ('a,'b) t = + { module_name : string ; ast_info : ('a,'b) ast_info } + + +(* only visit nodes that are currently in the domain *) +(* https://en.wikipedia.org/wiki/Topological_sorting *) +(* dfs *) +let sort_files_by_dependencies ~(domain : String_set.t) (dependency_graph : String_set.t String_map.t) : + string Queue.t = + let next current = + String_map.find_exn dependency_graph current in + let worklist = ref domain in + let result = Queue.create () in + let rec visit (visiting : String_set.t) path (current : string) = + let next_path = current :: path in + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends next_path) + else if String_set.mem current !worklist then + begin + let next_set = String_set.add current visiting in + next current |> + String_set.iter + (fun node -> + if String_map.mem dependency_graph node then + visit next_set next_path node) + ; + worklist := String_set.remove current !worklist; + Queue.push current result ; + end in + while not (String_set.is_empty !worklist) do + visit String_set.empty [] (String_set.choose !worklist) + done; + if Js_config.get_diagnose () then + Format.fprintf Format.err_formatter + "Order: @[%a@]@." + (Ext_format.pp_print_queue + ~pp_sep:Format.pp_print_space + Format.pp_print_string) + result ; + result +;; -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 sort project_ml project_mli (ast_table : _ t String_map.t) = + let domain = + String_map.fold ast_table String_set.empty + (fun k _ acc -> String_set.add k acc) + in + let h = + String_map.map ast_table + (fun + ({ast_info}) + -> + match ast_info with + | Ml (_, ast, _) + -> + read_parse_and_extract Ml (project_ml ast) + | Mli (_, ast, _) + -> + read_parse_and_extract Mli (project_mli ast) + | Ml_mli (_, impl, _, _, intf, _) + -> + String_set.union + (read_parse_and_extract Ml (project_ml impl)) + (read_parse_and_extract Mli (project_mli intf)) + ) in + sort_files_by_dependencies ~domain h + +(** same as {!Ocaml_parse.check_suffix} but does not care with [-c -o] option*) +let check_suffix name = + if Ext_path.check_suffix_case name ".ml" + || Ext_path.check_suffix_case name ".mlt" then + `Ml, + Ext_path.chop_extension_if_any name + else if Ext_path.check_suffix_case name !Config.interface_suffix then + `Mli, Ext_path.chop_extension_if_any name + else + raise(Arg.Bad("don't know what to do with " ^ name)) + + +let collect_ast_map ppf files parse_implementation parse_interface = + Ext_list.fold_left files String_map.empty + (fun acc source_file -> + match check_suffix source_file with + | `Ml, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = + (Ml (source_file, parse_implementation + ppf source_file, opref)); + module_name ; + } + | {ast_info = (Ml (source_file2, _, _) + | Ml_mli(source_file2, _, _,_,_,_))} -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Mli (source_file2, intf, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli (source_file, + parse_implementation ppf source_file, + opref, + source_file2, + intf, + opref2 + ); + module_name} + end + | `Mli, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = (Mli (source_file, parse_interface + ppf source_file, opref)); + module_name } + | {ast_info = + (Mli (source_file2, _, _) | + Ml_mli(_,_,_,source_file2,_,_)) } -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Ml (source_file2, impl, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli + (source_file2, + impl, + opref2, + source_file, + parse_interface ppf source_file, + opref + ); + module_name} + end + ) +;; +type dir_spec = + { dir : string ; + mutable excludes : string list + } -end -module Ounit_hash_stubs_test +let collect_from_main + ?(extra_dirs=[]) + ?(excludes=[]) + ?alias_map + (ppf : Format.formatter) + parse_implementation + parse_interface + project_impl + project_intf + main_module = + let files = + Ext_list.fold_left extra_dirs [] (fun acc dir_spec -> + let dirname, excludes = + match dir_spec with + | { dir = dirname; excludes = dir_excludes} -> + (* dirname, excludes *) + (* | `Dir_with_excludes (dirname, dir_excludes) -> *) + dirname, + (Ext_list.flat_map_append + dir_excludes excludes + (fun x -> [x ^ ".ml" ; x ^ ".mli" ]) + ) + in + Ext_array.fold_left (Sys.readdir dirname) acc (fun acc source_file -> + if (Ext_string.ends_with source_file ".ml" || + Ext_string.ends_with source_file ".mli" ) + && (* not_excluded source_file *) (not (List.mem source_file excludes)) + then + (Filename.concat dirname source_file) :: acc else acc + ) ) + in + let ast_table = collect_ast_map ppf files parse_implementation parse_interface in + let visited = String_hashtbl.create 31 in + let result = Queue.create () in + let next module_name : String_set.t = + let module_set = + match String_map.find_exn ast_table module_name with + | exception _ -> String_set.empty + | {ast_info = Ml (_, impl, _)} -> + read_parse_and_extract Ml (project_impl impl) + | {ast_info = Mli (_, intf,_)} -> + read_parse_and_extract Mli (project_intf intf) + | {ast_info = Ml_mli(_, impl, _, _, intf, _)} + -> + String_set.union + (read_parse_and_extract Ml (project_impl impl)) + (read_parse_and_extract Mli (project_intf intf)) + in + match alias_map with + | None -> module_set + | Some map -> + String_set.fold (fun x acc -> String_set.add (String_hashtbl.find_default map x x) acc ) module_set String_set.empty + in + let rec visit visiting path current = + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends (current::path)) + else + if not (String_hashtbl.mem visited current) + && String_map.mem ast_table current then + begin + String_set.iter + (visit + (String_set.add current visiting) + (current::path)) + (next current) ; + Queue.push current result; + String_hashtbl.add visited current (); + end in + visit (String_set.empty) [] main_module ; + ast_table, result + + +let build_queue ppf queue + (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue + |> Queue.iter + (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,ast, opref)} + -> + after_parsing_impl ppf source_file + opref ast + | {ast_info = Mli (source_file,ast,opref) ; } + -> + after_parsing_sig ppf source_file + opref ast + | {ast_info = Ml_mli(source_file1,impl,opref1,source_file2,intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +let handle_queue + ppf + queue ast_table + decorate_module_only + decorate_interface_only + decorate_module = + queue + |> Queue.iter + (fun base -> + match (String_map.find_exn ast_table base ).ast_info with + | exception Not_found -> assert false + | Ml (ml_name, ml_content, _) + -> + decorate_module_only base ml_name ml_content + | Mli (mli_name , mli_content, _) -> + decorate_interface_only base mli_name mli_content + | Ml_mli (ml_name, ml_content, _, mli_name, mli_content, _) + -> + decorate_module base mli_name ml_name mli_content ml_content + + ) + + + +let build_lazy_queue ppf queue (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue |> Queue.iter (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,lazy ast, opref)} + -> + after_parsing_impl ppf source_file opref ast + | {ast_info = Mli (source_file,lazy ast,opref) ; } + -> + after_parsing_sig ppf source_file opref ast + | {ast_info = Ml_mli(source_file1,lazy impl,opref1,source_file2,lazy intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +end +module Ounit_depends_format_test = struct -#1 "ounit_hash_stubs_test.ml" +#1 "ounit_depends_format_test.ml" let ((>::), - (>:::)) = OUnit.((>::),(>:::)) - -let (=~) = OUnit.assert_equal + (>:::)) = OUnit.((>::),(>:::)) -let count = 2_000_000 +let (=~) (xs : string list) (ys : string list) = + OUnit.assert_equal xs ys + ~printer:(fun xs -> String.concat "," xs ) -let bench () = - Ounit_tests_util.time "int hash set" begin fun _ -> - let v = Int_hash_set.create 2_000_000 in - for i = 0 to count do - Int_hash_set.add v i - done ; - for i = 0 to 3 do - for i = 0 to count do - assert (Int_hash_set.mem v i) - done - done - end; - Ounit_tests_util.time "int hash set" begin fun _ -> - let v = Hash_set_poly.create 2_000_000 in - for i = 0 to count do - Hash_set_poly.add v i - done ; - for i = 0 to 3 do - for i = 0 to count do - assert (Hash_set_poly.mem v i) - done - done - end +let f (x : string) = + let stru = Parse.implementation (Lexing.from_string x) in + Ast_extract.String_set.elements (Ast_extract.read_parse_and_extract Ml_binary.Ml stru) -type id (* = Ident.t *) = { stamp : int; name : string; mutable flags : int; } -let hash id = Bs_hash_stubs.hash_stamp_and_name id.stamp id.name let suites = - __FILE__ - >::: - [ - __LOC__ >:: begin fun _ -> - Bs_hash_stubs.hash_int 0 =~ Hashtbl.hash 0 - end; - __LOC__ >:: begin fun _ -> - Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int - end; - __LOC__ >:: begin fun _ -> - Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int - end; - __LOC__ >:: begin fun _ -> - Bs_hash_stubs.hash_string "The quick brown fox jumps over the lazy dog" =~ - Hashtbl.hash "The quick brown fox jumps over the lazy dog" - end; - __LOC__ >:: begin fun _ -> - Array.init 100 (fun i -> String.make i 'a' ) - |> Array.iter (fun x -> - Bs_hash_stubs.hash_string x =~ Hashtbl.hash x) - end; - __LOC__ >:: begin fun _ -> - (** only stamp matters here *) - hash {stamp = 1 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 1 ; - hash {stamp = 11 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 11; - end; - __LOC__ >:: begin fun _ -> - (* only string matters here *) - hash {stamp = 0 ; name = "Pervasives"; flags = 0} =~ Bs_hash_stubs.hash_string "Pervasives"; - hash {stamp = 0 ; name = "UU"; flags = 0} =~ Bs_hash_stubs.hash_string "UU"; - end; - __LOC__ >:: begin fun _ -> - let v = Array.init 20 (fun i -> i) in - let u = Array.init 30 (fun i -> (0-i) ) in - Bs_hash_stubs.int_unsafe_blit - v 0 u 10 20 ; - OUnit.assert_equal u (Array.init 30 (fun i -> if i < 10 then -i else i - 10)) - end - ] - + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + f {|module X = List|} =~ ["List"]; + f {|module X = List module X0 = List1|} =~ ["List";"List1"] + end + ] end -module Hashtbl_gen +module Ounit_ffi_error_debug_test = 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. *) -(* *) -(***********************************************************************) +#1 "ounit_ffi_error_debug_test.ml" +let (//) = Filename.concat -(* 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 - - (** return the key found in the hashtbl. - Use case: when you find the key existed in hashtbl, - you want to use the one stored in the hashtbl. - (they are semantically equivlanent, but may have other information different) - *) - val find_key_opt: 'a t -> key -> key option +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) - val find_default: 'a t -> key -> 'a -> 'a +let (=~) = OUnit.assert_equal + + + + +let bsc_eval = Ounit_cmd_util.bsc_check_eval + +let debug_output = Ounit_cmd_util.debug_output + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + let output = bsc_eval {| +external err : + hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> _ = "" [@@bs.obj] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + __LOC__ >:: begin fun _ -> +let output = bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> _ = "" [@@bs.obj] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + __LOC__ >:: begin fun _ -> + let output = bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> unit = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + + __LOC__ >:: begin fun _ -> + (** + Each [@bs.unwrap] variant constructor requires an argument + *) + let output = + bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b] [@bs.unwrap]) -> unit -> unit = "" [@@bs.val] + |} + in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "bs.unwrap") + end; + + __LOC__ >:: begin fun _ -> + (** + [@bs.unwrap] args are not supported in [@@bs.obj] functions + *) + let output = + bsc_eval {| + external err : + ?hi_should_error:([`a of int] [@bs.unwrap]) -> unit -> _ = "" [@@bs.obj] + |} + in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end + + ] - val replace: 'a t -> key -> 'a -> unit - val mem: 'a t -> key -> bool - val iter: 'a t -> (key -> 'a -> unit) -> 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 +module Hash_set_gen += struct +#1 "hash_set_gen.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. *) + (* We do dynamic hashing, and resize the table and rehash the elements when buckets become too long. *) -type ('a, 'b) t = +type 'a t = { mutable size: int; (* number of entries *) - mutable data: ('a, 'b) bucketlist array; (* the buckets *) - mutable seed: int; (* for randomization *) + mutable data: 'a list array; (* the buckets *) 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 } + { initial_size = s; size = 0; data = Array.make s [] } let clear h = h.size <- 0; let len = Array.length h.data in for i = 0 to len - 1 do - h.data.(i) <- Empty + Array.unsafe_set h.data i [] done let reset h = h.size <- 0; - h.data <- Array.make h.initial_size Empty + h.data <- Array.make h.initial_size [ ] 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 h f = let rec do_bucket = function - | Empty -> + | [ ] -> () - | Cons(k, d, rest) -> - f k d; do_bucket rest in + | k :: rest -> + f k ; 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 fold h init f = let rec do_bucket b accu = match b with - Empty -> + [ ] -> accu - | Cons(k, d, rest) -> - do_bucket rest (f k d accu) in + | k :: rest -> + do_bucket rest (f k 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 + accu := do_bucket (Array.unsafe_get d i) !accu done; !accu -let rec bucket_length accu = function - | Empty -> accu - | Cons(_, _, rest) -> bucket_length (accu + 1) rest +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 [ ] in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + [ ] -> () + | key :: rest -> + let nidx = indexfun h key in + ndata.(nidx) <- key :: ndata.(nidx); + insert_bucket rest + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + +let elements set = + fold set [] (fun k acc -> k :: acc) + + + let stats h = let mbl = - Ext_array.fold_left h.data 0 (fun m b -> max m (bucket_length 0 b)) in + Ext_array.fold_left h.data 0 (fun m b -> max m (List.length b)) in let histo = Array.make (mbl + 1) 0 in Ext_array.iter h.data (fun b -> - let l = bucket_length 0 b in + let l = List.length b in histo.(l) <- histo.(l) + 1) ; - {Hashtbl. - num_bindings = h.size; - num_buckets = Array.length h.data; - max_bucket_length = mbl; - bucket_histogram = histo } + {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 key lst = + match lst with + | [] -> false + | key1::rest -> + eq_key key key1 || + match rest with + | [] -> false + | key2 :: rest -> + eq_key key key2 || + match rest with + | [] -> false + | key3 :: rest -> + eq_key key key3 || + small_bucket_mem eq_key key rest +let rec remove_bucket eq_key key (h : _ t) buckets = + match buckets with + | [ ] -> + [ ] + | k :: next -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else k :: remove_bucket eq_key key h next -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 +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + val copy: t -> t + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val elements : t -> key list +end +end +module Hash_set : sig +#1 "hash_set.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. *) -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 +(** Ideas are based on {!Hashtbl}, + however, {!Hashtbl.add} does not really optimize and has a bad semantics for {!Hash_set}, + This module fixes the semantics of [add]. + [remove] is not optimized since it is not used too much +*) -let rec small_bucket_key_opt eq key (lst : _ bucketlist) : _ option = - match lst with - | Empty -> None - | Cons(k1,d1,rest1) -> - if eq key k1 then Some k1 else - match rest1 with - | Empty -> None - | Cons(k2,d2,rest2) -> - if eq key k2 then Some k2 else - match rest2 with - | Empty -> None - | Cons(k3,d3,rest3) -> - if eq key k3 then Some k3 else - small_bucket_key_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" +module Make ( H : Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) +(** A naive t implementation on top of [hashtbl], the value is [unit]*) + + +end = struct +#1 "hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 43 "ext/hash_set.cppo.ml" +module Make (H: Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) = struct +type key = H.t +let eq_key = H.equal +let key_index (h : _ Hash_set_gen.t ) key = + (H.hash key) land (Array.length h.data - 1) +type t = key Hash_set_gen.t + + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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)) + +# 124 "ext/hash_set.cppo.ml" +end + + +end +module Hash_set_poly : sig +#1 "hash_set_poly.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. *) + + +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 -> 'a -> unit +val remove : 'a t -> 'a -> unit + +val mem : 'a t -> 'a -> bool + +val iter : 'a t -> ('a -> unit) -> unit + +val elements : 'a t -> 'a list + +val length : 'a t -> int + +val stats: 'a t -> Hashtbl.statistics + +end = struct +#1 "hash_set_poly.ml" +# 1 "ext/hash_set.cppo.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. *) +# 51 "ext/hash_set.cppo.ml" +[@@@ocaml.warning "-3"] +(* we used cppo the mixture does not work*) +external seeded_hash_param : + int -> int -> int -> 'a -> int = "caml_hash" "noalloc" +let key_index (h : _ Hash_set_gen.t ) (key : 'a) = + seeded_hash_param 10 100 0 key land (Array.length h.data - 1) +let eq_key = (=) +type 'a t = 'a Hash_set_gen.t + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Ordered_hash_set_gen += struct +#1 "ordered_hash_set_gen.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. *) + +module type S = +sig + type key + type t + val create: int -> t + val clear: t -> unit + val reset: t -> unit + val copy: t -> t + val add: t -> key -> unit + val mem: t -> key -> bool + val rank: t -> key -> int (* -1 if not found*) + val iter: (key -> int -> unit) -> t -> unit + val fold: (key -> int -> 'b -> 'b) -> t -> 'b -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val choose_exn: t -> key + val of_array: key array -> t + val to_sorted_array: t -> key array + val replace: t -> key -> key -> unit + val reset_to_list : t -> key list -> unit + exception Replace_failure of bool +end + +exception Replace_failure of bool + + +(** when it is true, it means the old key does not exist , + when it is false, it means the new key already exist + *) + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) +type 'a bucket = + | Empty + | Cons of 'a * int * 'a bucket + +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a bucket array; + mutable data_mask: int ; + initial_size: int; + } +(* Invariant + [data_mask = Array.length data - 1 ] + [Array.length data is power of 2] +*) + + +let create initial_size = + let initial_size = Ext_util.power_2_above 16 initial_size in + { initial_size ; + size = 0; + data = Array.make initial_size Empty; + data_mask = initial_size - 1 ; + } + +let clear h = + h.size <- 0; + let h_data = h.data in + for i = 0 to h.data_mask do + Array.unsafe_set h_data i Empty + done + +(** Note this function is only used internally, make sure [h_initial_size] + is a power of 16 *) +let reset_with_size h h_initial_size = + h.size <- 0; + h.data <- Array.make h_initial_size Empty; + h.data_mask <- h_initial_size - 1 + +let reset h = + reset_with_size h h.initial_size + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + + +let rec insert_bucket nmask ndata hash = function + | Empty -> () + | Cons(key,info,rest) -> + let nidx = hash key land nmask in (* so that indexfun sees the new bucket count *) + Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); + insert_bucket nmask ndata hash rest + +let resize hash h = + let odata = h.data in + let odata_mask = h.data_mask in + let nsize = (odata_mask + 1) * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + h.data <- ndata; + let nmask = nsize - 1 in + h.data_mask <- nmask ; + for i = 0 to odata_mask do + match Array.unsafe_get odata i with + | Empty -> () + | Cons(key,info,rest) -> + let nidx = hash key land nmask in + Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); + insert_bucket nmask ndata hash rest + done + end + + +let rec do_bucket f = function + | Empty -> + () + | Cons(k ,i, rest) -> + f k i ; do_bucket f rest + +let iter f h = + let d = h.data in + for i = 0 to h.data_mask do + do_bucket f (Array.unsafe_get d i) + done + +(* find one element *) +let choose_exn h = + let rec aux arr offset last_index = + if offset > last_index then + raise Not_found (* This happens when size is 0, otherwise it is never called *) + else + match Array.unsafe_get arr offset with + | Empty -> aux arr (offset + 1) last_index + | Cons (k,_,rest) -> k + in + let h_data = h.data in + aux h_data 0 h.data_mask + +let fold f h init = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons( k , i, rest) -> + do_bucket rest (f k i accu) in + let d = h.data in + let accu = ref init in + for i = 0 to h.data_mask do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu + + +let rec set_bucket arr = function + | Empty -> () + | Cons(k,i,rest) -> + Array.unsafe_set arr i k; + set_bucket arr rest + +let to_sorted_array h = + if h.size = 0 then [||] + else + let v = choose_exn h in + let arr = Array.make h.size v in + let d = h.data in + for i = 0 to h.data_mask do + set_bucket arr (Array.unsafe_get d i) + done; + arr + + + + +let rec bucket_length acc (x : _ bucket) = + match x with + | Empty -> acc + | Cons(_,_,rest) -> bucket_length (acc + 1) rest + +let stats h = + let mbl = + Ext_array.fold_left h.data 0 (fun m (b : _ bucket) -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + { Hashtbl.num_bindings = h.size; + num_buckets = h.data_mask + 1 ; + max_bucket_length = mbl; + bucket_histogram = histo } + + +end +module Ordered_hash_set_string : sig +#1 "ordered_hash_set_string.mli" + + + + +include Ordered_hash_set_gen.S with type key = string +end = struct +#1 "ordered_hash_set_string.ml" + +# 11 "ext/ordered_hash_set.cppo.ml" + type key = string + type t = key Ordered_hash_set_gen.t + let hash = Bs_hash_stubs.hash_string + let equal_key = Ext_string.equal + +# 24 +open Ordered_hash_set_gen +exception Replace_failure = Replace_failure +let create = create +let clear = clear +let reset = reset +let copy = copy +let iter = iter +let fold = fold +let length = length +let stats = stats +let choose_exn = choose_exn +let to_sorted_array = to_sorted_array + + + +let rec small_bucket_mem key lst = + match lst with + | Empty -> false + | Cons(key1,_, rest) -> + equal_key key key1 || + match rest with + | Empty -> false + | Cons(key2 , _, rest) -> + equal_key key key2 || + match rest with + | Empty -> false + | Cons(key3,_, rest) -> + equal_key key key3 || + small_bucket_mem key rest + +let rec small_bucket_rank key lst = + match lst with + | Empty -> -1 + | Cons(key1,i,rest) -> + if equal_key key key1 then i + else match rest with + | Empty -> -1 + | Cons(key2,i2, rest) -> + if equal_key key key2 then i2 else + match rest with + | Empty -> -1 + | Cons(key3,i3, rest) -> + if equal_key key key3 then i3 else + small_bucket_rank key rest + +let add h key = + let h_data_mask = h.data_mask in + let i = hash key land h_data_mask in + if not (small_bucket_mem key h.data.(i)) then + begin + Array.unsafe_set h.data i (Cons(key,h.size, Array.unsafe_get h.data i)); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then resize hash h + end + +let old_key_not_exist = Replace_failure false +let new_key_already_exist = Replace_failure true + +let rec small_bucket_rank_and_delete key lst = + match lst with + | Empty -> raise old_key_not_exist + | Cons(key1,i,rest) -> + if equal_key key key1 then i, rest + else match rest with + | Empty -> raise old_key_not_exist + | Cons(key2,i2, rest) -> + if equal_key key key2 then i2, (Cons (key1,i,rest)) else + match rest with + | Empty -> raise old_key_not_exist + | Cons(key3,i3, rest) -> + if equal_key key key3 then i3, (Cons (key1,i,Cons(key2,i2,rest))) else + let (rank, rest ) = small_bucket_rank_and_delete key rest in + rank, Cons (key1,i, + Cons (key2,i2, + Cons(key3,i3,rest))) + +let replace h old_key new_key = + let h_data_mask = h.data_mask in + let i = hash old_key land h_data_mask in + let h_data = h.data in + let bucket = Array.unsafe_get h_data i in + let (rank,new_bucket) = small_bucket_rank_and_delete old_key bucket in + Array.unsafe_set h_data i new_bucket ; + + let j = hash new_key land h_data_mask in + let insert_bucket = Array.unsafe_get h_data j in + let mem = small_bucket_mem new_key insert_bucket in + if mem then raise new_key_already_exist + else + Array.unsafe_set h_data j (Cons (new_key,rank, insert_bucket)) + +let of_array arr = + let len = Array.length arr in + let h = create len in + for i = 0 to len - 1 do + add h (Array.unsafe_get arr i) + done; + h + +(* clear the Hashset and re-initialize it to [lst] *) +let reset_to_list h lst = + let len = List.length lst in + let () = Ordered_hash_set_gen.reset_with_size h (Ext_util.power_2_above 16 len) in + List.iter (fun x -> add h x ) lst + +let mem h key = + small_bucket_mem key (Array.unsafe_get h.data (hash key land h.data_mask)) + +let rank h key = + small_bucket_rank key (Array.unsafe_get h.data (hash key land h.data_mask)) + + + + + + + + + + + + + +end +module String_hash_set : sig +#1 "string_hash_set.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 Hash_set_gen.S with type key = string + +end = struct +#1 "string_hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 31 "ext/hash_set.cppo.ml" +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 + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Ounit_hash_set_tests += struct +#1 "ounit_hash_set_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +type id = { name : string ; stamp : int } + +module Id_hash_set = Hash_set.Make(struct + type t = id + let equal x y = x.stamp = y.stamp && x.name = y.name + let hash x = Hashtbl.hash x.stamp + end + ) + +let const_tbl = [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "100"; "99"; "98"; + "97"; "96"; "95"; "94"; "93"; "92"; "91"; "90"; "89"; "88"; "87"; "86"; "85"; + "84"; "83"; "82"; "81"; "80"; "79"; "78"; "77"; "76"; "75"; "74"; "73"; "72"; + "71"; "70"; "69"; "68"; "67"; "66"; "65"; "64"; "63"; "62"; "61"; "60"; "59"; + "58"; "57"; "56"; "55"; "54"; "53"; "52"; "51"; "50"; "49"; "48"; "47"; "46"; + "45"; "44"; "43"; "42"; "41"; "40"; "39"; "38"; "37"; "36"; "35"; "34"; "33"; + "32"; "31"; "30"; "29"; "28"; "27"; "26"; "25"; "24"; "23"; "22"; "21"; "20"; + "19"; "18"; "17"; "16"; "15"; "14"; "13"; "12"; "11"|] +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 31 in + for i = 0 to 1000 do + Hash_set_poly.add v i + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1001 + end ; + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 31 in + for i = 0 to 1_0_000 do + Hash_set_poly.add v 0 + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1 + end ; + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 30 in + for i = 0 to 2_000 do + Hash_set_poly.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + Hash_set_poly.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + assert (Hash_set_poly.mem v {name = "x"; stamp = i}) + done; + OUnit.assert_equal (Hash_set_poly.length v) 2_001; + for i = 1990 to 3_000 do + Hash_set_poly.remove v {name = "x"; stamp = i} + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1990; + (* OUnit.assert_equal (Hash_set.stats v) *) + (* {Hashtbl.num_bindings = 1990; num_buckets = 1024; max_bucket_length = 7; *) + (* bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *) + end ; + __LOC__ >:: begin fun _ -> + let v = Id_hash_set.create 30 in + for i = 0 to 2_000 do + Id_hash_set.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + Id_hash_set.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + assert (Id_hash_set.mem v {name = "x"; stamp = i}) + done; + OUnit.assert_equal (Id_hash_set.length v) 2_001; + for i = 1990 to 3_000 do + Id_hash_set.remove v {name = "x"; stamp = i} + done ; + OUnit.assert_equal (Id_hash_set.length v) 1990; + for i = 1000 to 3990 do + Id_hash_set.remove v { name = "x"; stamp = i } + done; + OUnit.assert_equal (Id_hash_set.length v) 1000; + for i = 1000 to 1100 do + Id_hash_set.add v { name = "x"; stamp = i}; + done; + OUnit.assert_equal (Id_hash_set.length v ) 1101; + for i = 0 to 1100 do + OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i}) + done + (* OUnit.assert_equal (Hash_set.stats v) *) + (* {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *) + (* bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *) + + end + ; + __LOC__ >:: begin fun _ -> + let v = Ordered_hash_set_string.create 3 in + for i = 0 to 10 do + Ordered_hash_set_string.add v (string_of_int i) + done; + for i = 100 downto 2 do + Ordered_hash_set_string.add v (string_of_int i) + done; + OUnit.assert_equal (Ordered_hash_set_string.to_sorted_array v ) + const_tbl + end; + __LOC__ >:: begin fun _ -> + let duplicate arr = + let len = Array.length arr in + let rec aux tbl off = + if off >= len then None + else + let curr = (Array.unsafe_get arr off) in + if String_hash_set.check_add tbl curr then + aux tbl (off + 1) + else Some curr in + aux (String_hash_set.create len) 0 in + let v = [| "if"; "a"; "b"; "c" |] in + OUnit.assert_equal (duplicate v) None; + OUnit.assert_equal (duplicate [|"if"; "a"; "b"; "b"; "c"|]) (Some "b") + end; + __LOC__ >:: begin fun _ -> + let of_array lst = + let len = Array.length lst in + let tbl = String_hash_set.create len in + Ext_array.iter lst (String_hash_set.add tbl) ; tbl in + let hash = of_array const_tbl in + let len = String_hash_set.length hash in + String_hash_set.remove hash "x"; + OUnit.assert_equal len (String_hash_set.length hash); + String_hash_set.remove hash "0"; + OUnit.assert_equal (len - 1 ) (String_hash_set.length hash) + end + ] + +end +module Int_hash_set : sig +#1 "int_hash_set.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 Hash_set_gen.S with type key = int + +end = struct +#1 "int_hash_set.ml" +# 1 "ext/hash_set.cppo.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -9987,150 +11225,154 @@ module String_hashtbl : sig * 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. *) +# 25 "ext/hash_set.cppo.ml" +type key = int +let key_index (h : _ Hash_set_gen.t ) (key : key) = + (Bs_hash_stubs.hash_int key) land (Array.length h.data - 1) +let eq_key = Ext_int.equal +type t = key Hash_set_gen.t -include Hashtbl_gen.S with type key = string - - - +# 64 "ext/hash_set.cppo.ml" +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 -# 33 "ext/hashtbl.cppo.ml" -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 h_data = h.data in - Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); - 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 +let add (h : _ Hash_set_gen.t) key = + let i = key_index h key in let h_data = h.data in - if find_bucket (Array.unsafe_get h_data i) then + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then begin - Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get h_data i)); + Array.unsafe_set h_data i (key :: old_bucket); 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 of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 rec remove_bucket key (h : _ t) (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 key h next) - -let remove (h : _ t ) key = - let i = key_index h key in - let h_data = h.data in - let old_h_szie = h.size in - let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in - if old_h_szie <> h.size then - Array.unsafe_set h_data i new_bucket - -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 Array.unsafe_get 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 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 find_key_opt (h : _ t) key = - Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in - let l = Array.unsafe_get h_data i in - try - Array.unsafe_set h_data i (replace_bucket l) - with Not_found -> - begin - Array.unsafe_set 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; - end +end +module Ounit_hash_stubs_test += struct +#1 "ounit_hash_stubs_test.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) -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 (Array.unsafe_get h.data (key_index h key)) +let (=~) = OUnit.assert_equal +let count = 2_000_000 + +let bench () = + Ounit_tests_util.time "int hash set" begin fun _ -> + let v = Int_hash_set.create 2_000_000 in + for i = 0 to count do + Int_hash_set.add v i + done ; + for i = 0 to 3 do + for i = 0 to count do + assert (Int_hash_set.mem v i) + done + done + end; + Ounit_tests_util.time "int hash set" begin fun _ -> + let v = Hash_set_poly.create 2_000_000 in + for i = 0 to count do + Hash_set_poly.add v i + done ; + for i = 0 to 3 do + for i = 0 to count do + assert (Hash_set_poly.mem v i) + done + done + end -let of_list2 ks vs = - let len = List.length ks in - let map = create len in - List.iter2 (fun k v -> add map k v) ks vs ; - map +type id (* = Ident.t *) = { stamp : int; name : string; mutable flags : int; } +let hash id = Bs_hash_stubs.hash_stamp_and_name id.stamp id.name +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int 0 =~ Hashtbl.hash 0 + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_string "The quick brown fox jumps over the lazy dog" =~ + Hashtbl.hash "The quick brown fox jumps over the lazy dog" + end; + __LOC__ >:: begin fun _ -> + Array.init 100 (fun i -> String.make i 'a' ) + |> Array.iter (fun x -> + Bs_hash_stubs.hash_string x =~ Hashtbl.hash x) + end; + __LOC__ >:: begin fun _ -> + (** only stamp matters here *) + hash {stamp = 1 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 1 ; + hash {stamp = 11 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 11; + end; + __LOC__ >:: begin fun _ -> + (* only string matters here *) + hash {stamp = 0 ; name = "Pervasives"; flags = 0} =~ Bs_hash_stubs.hash_string "Pervasives"; + hash {stamp = 0 ; name = "UU"; flags = 0} =~ Bs_hash_stubs.hash_string "UU"; + end; + __LOC__ >:: begin fun _ -> + let v = Array.init 20 (fun i -> i) in + let u = Array.init 30 (fun i -> (0-i) ) in + Bs_hash_stubs.int_unsafe_blit + v 0 u 10 20 ; + OUnit.assert_equal u (Array.init 30 (fun i -> if i < 10 then -i else i - 10)) + end + ] end module Ounit_hashtbl_tests @@ -19338,7 +20580,8 @@ let suites = Ounit_utf8_test.suites; Ounit_unicode_tests.suites; Ounit_bsb_regex_tests.suites; - Ounit_bsb_pkg_tests.suites + Ounit_bsb_pkg_tests.suites; + Ounit_depends_format_test.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/lib/4.02.3/unstable/all_ounit_tests.ml.d b/lib/4.02.3/unstable/all_ounit_tests.ml.d new file mode 100644 index 0000000000..1347634823 --- /dev/null +++ b/lib/4.02.3/unstable/all_ounit_tests.ml.d @@ -0,0 +1,156 @@ +../lib/4.02.3/unstable/all_ounit_tests.ml: +./bsb/bsb_db.ml +./bsb/bsb_db.mli +./bsb/bsb_db_io.ml +./bsb/bsb_db_io.mli +./bsb/bsb_exception.ml +./bsb/bsb_exception.mli +./bsb/bsb_pkg_types.ml +./bsb/bsb_pkg_types.mli +./bsb/bsb_regex.ml +./bsb/bsb_regex.mli +./common/bs_loc.ml +./common/bs_loc.mli +./common/bs_version.ml +./common/bs_version.mli +./common/js_config.ml +./common/js_config.mli +./common/ml_binary.ml +./common/ml_binary.mli +./depends/ast_extract.ml +./depends/ast_extract.mli +./depends/bs_exception.ml +./depends/bs_exception.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_format.ml +./ext/ext_format.mli +./ext/ext_ident.ml +./ext/ext_ident.mli +./ext/ext_int.ml +./ext/ext_int.mli +./ext/ext_js_regex.ml +./ext/ext_js_regex.mli +./ext/ext_json.ml +./ext/ext_json.mli +./ext/ext_json_noloc.ml +./ext/ext_json_noloc.mli +./ext/ext_json_parse.ml +./ext/ext_json_parse.mli +./ext/ext_json_types.ml +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_modulename.ml +./ext/ext_modulename.mli +./ext/ext_namespace.ml +./ext/ext_namespace.mli +./ext/ext_obj.ml +./ext/ext_obj.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_position.ml +./ext/ext_position.mli +./ext/ext_ref.ml +./ext/ext_ref.mli +./ext/ext_scc.ml +./ext/ext_scc.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_topsort.ml +./ext/ext_topsort.mli +./ext/ext_utf8.ml +./ext/ext_utf8.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hash_set.ml +./ext/hash_set.mli +./ext/hash_set_gen.ml +./ext/hash_set_ident_mask.ml +./ext/hash_set_ident_mask.mli +./ext/hash_set_poly.ml +./ext/hash_set_poly.mli +./ext/hashtbl_gen.ml +./ext/int_hash_set.ml +./ext/int_hash_set.mli +./ext/int_map.ml +./ext/int_map.mli +./ext/int_vec.ml +./ext/int_vec.mli +./ext/int_vec_util.ml +./ext/int_vec_util.mli +./ext/int_vec_vec.ml +./ext/int_vec_vec.mli +./ext/js_reserved_map.ml +./ext/js_reserved_map.mli +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/ordered_hash_set_gen.ml +./ext/ordered_hash_set_string.ml +./ext/ordered_hash_set_string.mli +./ext/resize_array.ml +./ext/resize_array.mli +./ext/set_gen.ml +./ext/set_int.ml +./ext/set_int.mli +./ext/string_hash_set.ml +./ext/string_hash_set.mli +./ext/string_hashtbl.ml +./ext/string_hashtbl.mli +./ext/string_map.ml +./ext/string_map.mli +./ext/union_find.ml +./ext/union_find.mli +./ext/vec_gen.ml +./main/ounit_tests_main.ml +./main/ounit_tests_main.mli +./ounit/oUnit.ml +./ounit/oUnit.mli +./ounit/oUnitChooser.ml +./ounit/oUnitLogger.ml +./ounit/oUnitTypes.ml +./ounit/oUnitUtils.ml +./ounit_tests/ounit_array_tests.ml +./ounit_tests/ounit_bal_tree_tests.ml +./ounit_tests/ounit_bsb_pkg_tests.ml +./ounit_tests/ounit_bsb_regex_tests.ml +./ounit_tests/ounit_cmd_tests.ml +./ounit_tests/ounit_cmd_util.ml +./ounit_tests/ounit_cmd_util.mli +./ounit_tests/ounit_data_random.ml +./ounit_tests/ounit_depends_format_test.ml +./ounit_tests/ounit_ffi_error_debug_test.ml +./ounit_tests/ounit_hash_set_tests.ml +./ounit_tests/ounit_hash_stubs_test.ml +./ounit_tests/ounit_hashtbl_tests.ml +./ounit_tests/ounit_ident_mask_tests.ml +./ounit_tests/ounit_int_vec_tests.ml +./ounit_tests/ounit_js_regex_checker_tests.ml +./ounit_tests/ounit_json_tests.ml +./ounit_tests/ounit_list_test.ml +./ounit_tests/ounit_map_tests.ml +./ounit_tests/ounit_ordered_hash_set_tests.ml +./ounit_tests/ounit_path_tests.ml +./ounit_tests/ounit_scc_tests.ml +./ounit_tests/ounit_string_tests.ml +./ounit_tests/ounit_tests_util.ml +./ounit_tests/ounit_topsort_tests.ml +./ounit_tests/ounit_unicode_tests.ml +./ounit_tests/ounit_union_find_tests.ml +./ounit_tests/ounit_utf8_test.ml +./ounit_tests/ounit_vec_test.ml +./stubs/bs_hash_stubs.ml +./syntax/ast_compatible.ml +./syntax/ast_compatible.mli +./syntax/ast_utf8_string.ml +./syntax/ast_utf8_string.mli +./syntax/ast_utf8_string_interp.ml +./syntax/ast_utf8_string_interp.mli diff --git a/jscomp/bin/bsb_native.ml b/lib/4.02.3/unstable/bsb_native.ml similarity index 100% rename from jscomp/bin/bsb_native.ml rename to lib/4.02.3/unstable/bsb_native.ml diff --git a/lib/4.02.3/unstable/bsb_native.ml.d b/lib/4.02.3/unstable/bsb_native.ml.d new file mode 100644 index 0000000000..5eb6fb8f2d --- /dev/null +++ b/lib/4.02.3/unstable/bsb_native.ml.d @@ -0,0 +1,135 @@ +../lib/4.02.3/unstable/bsb_native.ml: +./bsb/bsb_build_schemas.ml +./bsb/bsb_build_util.ml +./bsb/bsb_build_util.mli +./bsb/bsb_clean.ml +./bsb/bsb_clean.mli +./bsb/bsb_config.ml +./bsb/bsb_config.mli +./bsb/bsb_config_parse.ml +./bsb/bsb_config_parse.mli +./bsb/bsb_config_types.ml +./bsb/bsb_db.ml +./bsb/bsb_db.mli +./bsb/bsb_db_io.ml +./bsb/bsb_db_io.mli +./bsb/bsb_default.ml +./bsb/bsb_default.mli +./bsb/bsb_dir_index.ml +./bsb/bsb_dir_index.mli +./bsb/bsb_exception.ml +./bsb/bsb_exception.mli +./bsb/bsb_file.ml +./bsb/bsb_file.mli +./bsb/bsb_file_groups.ml +./bsb/bsb_log.ml +./bsb/bsb_log.mli +./bsb/bsb_merlin_gen.ml +./bsb/bsb_merlin_gen.mli +./bsb/bsb_namespace_map_gen.ml +./bsb/bsb_namespace_map_gen.mli +./bsb/bsb_ninja_check.ml +./bsb/bsb_ninja_check.mli +./bsb/bsb_ninja_file_groups.ml +./bsb/bsb_ninja_file_groups.mli +./bsb/bsb_ninja_gen.ml +./bsb/bsb_ninja_gen.mli +./bsb/bsb_ninja_global_vars.ml +./bsb/bsb_ninja_regen.ml +./bsb/bsb_ninja_regen.mli +./bsb/bsb_ninja_rule.ml +./bsb/bsb_ninja_rule.mli +./bsb/bsb_ninja_util.ml +./bsb/bsb_ninja_util.mli +./bsb/bsb_package_specs.ml +./bsb/bsb_package_specs.mli +./bsb/bsb_parse_sources.ml +./bsb/bsb_parse_sources.mli +./bsb/bsb_pkg.ml +./bsb/bsb_pkg.mli +./bsb/bsb_pkg_types.ml +./bsb/bsb_pkg_types.mli +./bsb/bsb_query.ml +./bsb/bsb_query.mli +./bsb/bsb_regex.ml +./bsb/bsb_regex.mli +./bsb/bsb_templates.ml +./bsb/bsb_templates.mli +./bsb/bsb_theme_init.ml +./bsb/bsb_theme_init.mli +./bsb/bsb_unix.ml +./bsb/bsb_unix.mli +./bsb/bsb_warning.ml +./bsb/bsb_warning.mli +./bsb/bsb_watcher_gen.ml +./bsb/bsb_watcher_gen.mli +./bsb/bsb_world.ml +./bsb/bsb_world.mli +./bsb/oCamlRes.ml +./common/bs_version.ml +./common/bs_version.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_color.ml +./ext/ext_color.mli +./ext/ext_file_pp.ml +./ext/ext_file_pp.mli +./ext/ext_filename.ml +./ext/ext_filename.mli +./ext/ext_io.ml +./ext/ext_io.mli +./ext/ext_json.ml +./ext/ext_json.mli +./ext/ext_json_noloc.ml +./ext/ext_json_noloc.mli +./ext/ext_json_parse.ml +./ext/ext_json_parse.mli +./ext/ext_json_types.ml +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_modulename.ml +./ext/ext_modulename.mli +./ext/ext_namespace.ml +./ext/ext_namespace.mli +./ext/ext_option.ml +./ext/ext_option.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_position.ml +./ext/ext_position.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hash_set_gen.ml +./ext/hashtbl_gen.ml +./ext/hashtbl_make.ml +./ext/hashtbl_make.mli +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/resize_array.ml +./ext/resize_array.mli +./ext/set_gen.ml +./ext/string_hash_set.ml +./ext/string_hash_set.mli +./ext/string_hashtbl.ml +./ext/string_hashtbl.mli +./ext/string_map.ml +./ext/string_map.mli +./ext/string_set.ml +./ext/string_set.mli +./ext/string_vec.ml +./ext/string_vec.mli +./ext/vec_gen.ml +./main/bsb_main.ml +./main/bsb_main.mli +./stubs/bs_hash_stubs.ml diff --git a/jscomp/bin/bspack.ml b/lib/4.02.3/unstable/bspack.ml similarity index 99% rename from jscomp/bin/bspack.ml rename to lib/4.02.3/unstable/bspack.ml index 7d20e2fe60..5d69db9dc6 100644 --- a/jscomp/bin/bspack.ml +++ b/lib/4.02.3/unstable/bspack.ml @@ -7669,6 +7669,129 @@ let js_id_name_of_hint_name module_name = if Ext_string.is_empty res then module_name else res +end +module Ext_ref : sig +#1 "ext_ref.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. *) + +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) + +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b + +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b + +end = struct +#1 "ext_ref.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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res + +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e + end module Js_config : sig #1 "js_config.mli" @@ -9217,6 +9340,7 @@ type 'a kind = 'a Ml_binary.kind let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> List.iter (fun modname -> @@ -9226,7 +9350,7 @@ let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = | Ml_binary.Ml -> Depend.add_implementation bound_vars ast | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); !Depend.free_structure_names - + end type ('a,'b) ast_info = | Ml of diff --git a/jscomp/bin/bspack.ml.d b/lib/4.02.3/unstable/bspack.ml.d similarity index 96% rename from jscomp/bin/bspack.ml.d rename to lib/4.02.3/unstable/bspack.ml.d index 4577cf9251..9523f12ee6 100644 --- a/jscomp/bin/bspack.ml.d +++ b/lib/4.02.3/unstable/bspack.ml.d @@ -1,4 +1,4 @@ -bin/bspack.ml: +../lib/4.02.3/unstable/bspack.ml: ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/asttypes.mli @@ -55,6 +55,8 @@ bin/bspack.ml: ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli +./ext/ext_ref.ml +./ext/ext_ref.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml diff --git a/jscomp/bin/native_ppx.ml b/lib/4.02.3/unstable/native_ppx.ml similarity index 99% rename from jscomp/bin/native_ppx.ml rename to lib/4.02.3/unstable/native_ppx.ml index a6ba637da5..95c44824d5 100644 --- a/jscomp/bin/native_ppx.ml +++ b/lib/4.02.3/unstable/native_ppx.ml @@ -157,7 +157,7 @@ end = struct (* The main OCaml version string has moved to ../VERSION *) let version = Sys.ocaml_version -let standard_library_default = "/Users/hongbozhang/git/bucklescript/native/lib/ocaml" +let standard_library_default = "/Users/hongbozhang/git/bucklescript/native/4.02.3/lib/ocaml" let standard_library = @@ -167,9 +167,9 @@ let standard_library = standard_library_default -let standard_runtime = "/Users/hongbozhang/git/bucklescript/native/bin/ocamlrun" +let standard_runtime = "/Users/hongbozhang/git/bucklescript/native/4.02.3/bin/ocamlrun" let ccomp_type = "cc" -let bytecomp_c_compiler = "gcc -O -Wall -D_FILE_OFFSET_BITS=64 -O " +let bytecomp_c_compiler = "gcc -O -Wall -D_FILE_OFFSET_BITS=64 -O " let bytecomp_c_libraries = "" let native_c_compiler = "gcc -O -D_FILE_OFFSET_BITS=64" let native_c_libraries = "" @@ -177,9 +177,9 @@ let native_pack_linker = "ld -r -arch x86_64 -o " let ranlib = "ranlib" let ar = "ar" let cc_profile = "-pg" -let mkdll = "" +let mkdll = "gcc -bundle -flat_namespace -undefined suppress -Wl,-no_compact_unwind" let mkexe = "gcc -Wl,-no_compact_unwind" -let mkmaindll = "" +let mkmaindll = "gcc -bundle -flat_namespace -undefined suppress -Wl,-no_compact_unwind" let exec_magic_number = "Caml1999X011" and cmi_magic_number = "Caml1999I017" diff --git a/jscomp/bin/native_ppx.ml.d b/lib/4.02.3/unstable/native_ppx.ml.d similarity index 98% rename from jscomp/bin/native_ppx.ml.d rename to lib/4.02.3/unstable/native_ppx.ml.d index 1625b6f921..2ac901dfdb 100644 --- a/jscomp/bin/native_ppx.ml.d +++ b/lib/4.02.3/unstable/native_ppx.ml.d @@ -1,4 +1,4 @@ -bin/native_ppx.ml: +../lib/4.02.3/unstable/native_ppx.ml: ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/asttypes.mli diff --git a/lib/4.02.3+BS/whole_compiler.ml b/lib/4.02.3/whole_compiler.ml similarity index 99% rename from lib/4.02.3+BS/whole_compiler.ml rename to lib/4.02.3/whole_compiler.ml index 9c3cf7f442..30e589580c 100644 --- a/lib/4.02.3+BS/whole_compiler.ml +++ b/lib/4.02.3/whole_compiler.ml @@ -26592,6 +26592,129 @@ let js_id_name_of_hint_name module_name = if Ext_string.is_empty res then module_name else res +end +module Ext_ref : sig +#1 "ext_ref.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. *) + +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) + +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b + +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b + +end = struct +#1 "ext_ref.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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res + +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e + end module Ml_binary : sig #1 "ml_binary.mli" @@ -27921,6 +28044,7 @@ type 'a kind = 'a Ml_binary.kind let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> List.iter (fun modname -> @@ -27930,7 +28054,7 @@ let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = | Ml_binary.Ml -> Depend.add_implementation bound_vars ast | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); !Depend.free_structure_names - + end type ('a,'b) ast_info = | Ml of @@ -108263,129 +108387,6 @@ let record_as_js_object args -end -module Ext_ref : sig -#1 "ext_ref.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. *) - -(** [non_exn_protect ref value f] assusme [f()] - would not raise -*) - -val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b -val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b - -val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c - -(** [non_exn_protect2 refa refb va vb f ] - assume [f ()] would not raise -*) -val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c - -val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b - -end = struct -#1 "ext_ref.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 non_exn_protect r v body = - let old = !r in - r := v; - let res = body() in - r := old; - res - -let protect r v body = - let old = !r in - try - r := v; - let res = body() in - r := old; - res - with x -> - r := old; - raise x - -let non_exn_protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - r1 := v1; - r2 := v2; - let res = body() in - r1 := old1; - r2 := old2; - res - -let protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - try - r1 := v1; - r2 := v2; - let res = body() in - r1 := old1; - r2 := old2; - res - with x -> - r1 := old1; - r2 := old2; - raise x - -let protect_list rvs body = - let olds = Ext_list.map rvs (fun (x,y) -> !x) in - let () = List.iter (fun (x,y) -> x:=y) rvs in - try - let res = body () in - List.iter2 (fun (x,_) old -> x := old) rvs olds; - res - with e -> - List.iter2 (fun (x,_) old -> x := old) rvs olds; - raise e - end module Ast_exp_extension : sig #1 "ast_exp_extension.mli" diff --git a/lib/4.02.3+BS/whole_compiler.ml.d b/lib/4.02.3/whole_compiler.ml.d similarity index 99% rename from lib/4.02.3+BS/whole_compiler.ml.d rename to lib/4.02.3/whole_compiler.ml.d index cfe4422229..fbc34bd0a4 100644 --- a/lib/4.02.3+BS/whole_compiler.ml.d +++ b/lib/4.02.3/whole_compiler.ml.d @@ -1,4 +1,4 @@ -../lib/4.02.3+BS/whole_compiler.ml: +../lib/4.02.3/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml diff --git a/lib/4.02.3/whole_compiler.mli b/lib/4.02.3/whole_compiler.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1+BS/bsb.mli b/lib/4.06.1+BS/bsb.mli deleted file mode 100644 index 03ee5d5f11..0000000000 --- a/lib/4.06.1+BS/bsb.mli +++ /dev/null @@ -1 +0,0 @@ -(**) diff --git a/lib/4.06.1+BS/bsb_helper.mli b/lib/4.06.1+BS/bsb_helper.mli deleted file mode 100644 index 03ee5d5f11..0000000000 --- a/lib/4.06.1+BS/bsb_helper.mli +++ /dev/null @@ -1 +0,0 @@ -(**) diff --git a/lib/4.06.1+BS/bsdep.mli b/lib/4.06.1+BS/bsdep.mli deleted file mode 100644 index 948db8faa8..0000000000 --- a/lib/4.06.1+BS/bsdep.mli +++ /dev/null @@ -1 +0,0 @@ -(* *) diff --git a/lib/4.06.1+BS/bspp.mli b/lib/4.06.1+BS/bspp.mli deleted file mode 100644 index 948db8faa8..0000000000 --- a/lib/4.06.1+BS/bspp.mli +++ /dev/null @@ -1 +0,0 @@ -(* *) diff --git a/lib/4.06.1+BS/bsppx.mli b/lib/4.06.1+BS/bsppx.mli deleted file mode 100644 index 139597f9cb..0000000000 --- a/lib/4.06.1+BS/bsppx.mli +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/lib/4.06.1+BS/refmt_main3.mli b/lib/4.06.1+BS/refmt_main3.mli deleted file mode 100644 index 52b6c9be71..0000000000 --- a/lib/4.06.1+BS/refmt_main3.mli +++ /dev/null @@ -1 +0,0 @@ -(** *) \ No newline at end of file diff --git a/lib/4.06.1+BS/whole_compiler.mli b/lib/4.06.1+BS/whole_compiler.mli deleted file mode 100644 index 43bee504f9..0000000000 --- a/lib/4.06.1+BS/whole_compiler.mli +++ /dev/null @@ -1 +0,0 @@ -(** *) diff --git a/lib/4.06.1+BS/bsb.ml b/lib/4.06.1/bsb.ml similarity index 100% rename from lib/4.06.1+BS/bsb.ml rename to lib/4.06.1/bsb.ml diff --git a/lib/4.06.1+BS/bsb.ml.d b/lib/4.06.1/bsb.ml.d similarity index 99% rename from lib/4.06.1+BS/bsb.ml.d rename to lib/4.06.1/bsb.ml.d index 5b63b672b0..ab66e2720d 100644 --- a/lib/4.06.1+BS/bsb.ml.d +++ b/lib/4.06.1/bsb.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/bsb.ml: +../lib/4.06.1/bsb.ml: ./bsb/bsb_build_schemas.ml ./bsb/bsb_build_util.ml ./bsb/bsb_build_util.mli diff --git a/lib/4.06.1/bsb.mli b/lib/4.06.1/bsb.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1+BS/bsb_helper.ml b/lib/4.06.1/bsb_helper.ml similarity index 100% rename from lib/4.06.1+BS/bsb_helper.ml rename to lib/4.06.1/bsb_helper.ml diff --git a/lib/4.06.1+BS/bsb_helper.ml.d b/lib/4.06.1/bsb_helper.ml.d similarity index 96% rename from lib/4.06.1+BS/bsb_helper.ml.d rename to lib/4.06.1/bsb_helper.ml.d index 0edd1ba04a..3315fa122a 100644 --- a/lib/4.06.1+BS/bsb_helper.ml.d +++ b/lib/4.06.1/bsb_helper.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/bsb_helper.ml: +../lib/4.06.1/bsb_helper.ml: ./bsb/bsb_db.ml ./bsb/bsb_db.mli ./bsb/bsb_db_io.ml diff --git a/lib/4.06.1/bsb_helper.mli b/lib/4.06.1/bsb_helper.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1+BS/bsdep.ml b/lib/4.06.1/bsdep.ml similarity index 99% rename from lib/4.06.1+BS/bsdep.ml rename to lib/4.06.1/bsdep.ml index 8270875142..fced07e3bb 100644 --- a/lib/4.06.1+BS/bsdep.ml +++ b/lib/4.06.1/bsdep.ml @@ -269,7 +269,7 @@ end = struct (**************************************************************************) (* The main OCaml version string has moved to ../VERSION *) -let version = "4.06.2+BS" +let version = "4.06.1+BS" let standard_library = Filename.concat (Filename.dirname Sys.executable_name) "ocaml" let standard_library_default = standard_library diff --git a/lib/4.06.1+BS/bsdep.ml.d b/lib/4.06.1/bsdep.ml.d similarity index 99% rename from lib/4.06.1+BS/bsdep.ml.d rename to lib/4.06.1/bsdep.ml.d index 75d16e02d7..a3d3bb3d00 100644 --- a/lib/4.06.1+BS/bsdep.ml.d +++ b/lib/4.06.1/bsdep.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/bsdep.ml: +../lib/4.06.1/bsdep.ml: ../ocaml/driver/compdynlink.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli diff --git a/lib/4.06.1/bsdep.mli b/lib/4.06.1/bsdep.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1+BS/bspp.ml b/lib/4.06.1/bspp.ml similarity index 99% rename from lib/4.06.1+BS/bspp.ml rename to lib/4.06.1/bspp.ml index 0c8e5ec5f1..e5603f673f 100644 --- a/lib/4.06.1+BS/bspp.ml +++ b/lib/4.06.1/bspp.ml @@ -206,7 +206,7 @@ end = struct (**************************************************************************) (* The main OCaml version string has moved to ../VERSION *) -let version = "4.06.2+BS" +let version = "4.06.1+BS" let standard_library = Filename.concat (Filename.dirname Sys.executable_name) "ocaml" let standard_library_default = standard_library diff --git a/lib/4.06.1+BS/bspp.ml.d b/lib/4.06.1/bspp.ml.d similarity index 97% rename from lib/4.06.1+BS/bspp.ml.d rename to lib/4.06.1/bspp.ml.d index 7c1b9162a5..a501a62db1 100644 --- a/lib/4.06.1+BS/bspp.ml.d +++ b/lib/4.06.1/bspp.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/bspp.ml: +../lib/4.06.1/bspp.ml: ../ocaml/parsing/asttypes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli diff --git a/lib/4.06.1/bspp.mli b/lib/4.06.1/bspp.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1+BS/bsppx.ml b/lib/4.06.1/bsppx.ml similarity index 99% rename from lib/4.06.1+BS/bsppx.ml rename to lib/4.06.1/bsppx.ml index fb908828c5..1394c6b9f7 100644 --- a/lib/4.06.1+BS/bsppx.ml +++ b/lib/4.06.1/bsppx.ml @@ -206,7 +206,7 @@ end = struct (**************************************************************************) (* The main OCaml version string has moved to ../VERSION *) -let version = "4.06.2+BS" +let version = "4.06.1+BS" let standard_library = Filename.concat (Filename.dirname Sys.executable_name) "ocaml" let standard_library_default = standard_library diff --git a/lib/4.06.1+BS/bsppx.ml.d b/lib/4.06.1/bsppx.ml.d similarity index 99% rename from lib/4.06.1+BS/bsppx.ml.d rename to lib/4.06.1/bsppx.ml.d index 6bf89e8e04..f1c420a00f 100644 --- a/lib/4.06.1+BS/bsppx.ml.d +++ b/lib/4.06.1/bsppx.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/bsppx.ml: +../lib/4.06.1/bsppx.ml: ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml diff --git a/lib/4.06.1/bsppx.mli b/lib/4.06.1/bsppx.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/4.06.1/unstable/all_ounit_tests.ml b/lib/4.06.1/unstable/all_ounit_tests.ml new file mode 100644 index 0000000000..32d997e562 --- /dev/null +++ b/lib/4.06.1/unstable/all_ounit_tests.ml @@ -0,0 +1,20568 @@ +module OUnitTypes += struct +#1 "oUnitTypes.ml" + +(** + * Commont types for OUnit + * + * @author Sylvain Le Gall + * + *) + +(** See OUnit.mli. *) +type node = ListItem of int | Label of string + +(** See OUnit.mli. *) +type path = node list + +(** See OUnit.mli. *) +type log_severity = + | LError + | LWarning + | LInfo + +(** See OUnit.mli. *) +type test_result = + | RSuccess of path + | RFailure of path * string + | RError of path * string + | RSkip of path * string + | RTodo of path * string + +(** See OUnit.mli. *) +type test_event = + | EStart of path + | EEnd of path + | EResult of test_result + | ELog of log_severity * string + | ELogRaw of string + +(** Events which occur at the global level. *) +type global_event = + | GStart (** Start running the tests. *) + | GEnd (** Finish running the tests. *) + | GResults of (float * test_result list * int) + +(* The type of test function *) +type test_fun = unit -> unit + +(* The type of tests *) +type test = + | TestCase of test_fun + | TestList of test list + | TestLabel of string * test + +type state = + { + tests_planned : (path * (unit -> unit)) list; + results : test_result list; + } + + +end +module OUnitChooser += struct +#1 "oUnitChooser.ml" + + +(** + Heuristic to pick a test to run. + + @author Sylvain Le Gall + *) + +open OUnitTypes + +(** Most simple heuristic, just pick the first test. *) +let simple state = + List.hd state.tests_planned + +end +module OUnitUtils += struct +#1 "oUnitUtils.ml" + +(** + * Utilities for OUnit + * + * @author Sylvain Le Gall + *) + +open OUnitTypes + +let is_success = + function + | RSuccess _ -> true + | RFailure _ | RError _ | RSkip _ | RTodo _ -> false + +let is_failure = + function + | RFailure _ -> true + | RSuccess _ | RError _ | RSkip _ | RTodo _ -> false + +let is_error = + function + | RError _ -> true + | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> false + +let is_skip = + function + | RSkip _ -> true + | RSuccess _ | RFailure _ | RError _ | RTodo _ -> false + +let is_todo = + function + | RTodo _ -> true + | RSuccess _ | RFailure _ | RError _ | RSkip _ -> false + +let result_flavour = + function + | RError _ -> "Error" + | RFailure _ -> "Failure" + | RSuccess _ -> "Success" + | RSkip _ -> "Skip" + | RTodo _ -> "Todo" + +let result_path = + function + | RSuccess path + | RError (path, _) + | RFailure (path, _) + | RSkip (path, _) + | RTodo (path, _) -> path + +let result_msg = + function + | RSuccess _ -> "Success" + | RError (_, msg) + | RFailure (_, msg) + | RSkip (_, msg) + | RTodo (_, msg) -> msg + +(* Returns true if the result list contains successes only. *) +let rec was_successful = + function + | [] -> true + | RSuccess _::t + | RSkip _::t -> + was_successful t + + | RFailure _::_ + | RError _::_ + | RTodo _::_ -> + false + +let string_of_node = + function + | ListItem n -> + string_of_int n + | Label s -> + s + +(* Return the number of available tests *) +let rec test_case_count = + function + | TestCase _ -> 1 + | TestLabel (_, t) -> test_case_count t + | TestList l -> + List.fold_left + (fun c t -> c + test_case_count t) + 0 l + +let string_of_path path = + String.concat ":" (List.rev_map string_of_node path) + +let buff_format_printf f = + let buff = Buffer.create 13 in + let fmt = Format.formatter_of_buffer buff in + f fmt; + Format.pp_print_flush fmt (); + Buffer.contents buff + +(* Applies function f in turn to each element in list. Function f takes + one element, and integer indicating its location in the list *) +let mapi f l = + let rec rmapi cnt l = + match l with + | [] -> + [] + + | h :: t -> + (f h cnt) :: (rmapi (cnt + 1) t) + in + rmapi 0 l + +let fold_lefti f accu l = + let rec rfold_lefti cnt accup l = + match l with + | [] -> + accup + + | h::t -> + rfold_lefti (cnt + 1) (f accup h cnt) t + in + rfold_lefti 0 accu l + +end +module OUnitLogger += struct +#1 "oUnitLogger.ml" +(* + * Logger for information and various OUnit events. + *) + +open OUnitTypes +open OUnitUtils + +type event_type = GlobalEvent of global_event | TestEvent of test_event + +let format_event verbose event_type = + match event_type with + | GlobalEvent e -> + begin + match e with + | GStart -> + "" + | GEnd -> + "" + | GResults (running_time, results, test_case_count) -> + let separator1 = String.make (Format.get_margin ()) '=' in + let separator2 = String.make (Format.get_margin ()) '-' in + let buf = Buffer.create 1024 in + let bprintf fmt = Printf.bprintf buf fmt in + let print_results = + List.iter + (fun result -> + bprintf "%s\n%s: %s\n\n%s\n%s\n" + separator1 + (result_flavour result) + (string_of_path (result_path result)) + (result_msg result) + separator2) + in + let errors = List.filter is_error results in + let failures = List.filter is_failure results in + let skips = List.filter is_skip results in + let todos = List.filter is_todo results in + + if not verbose then + bprintf "\n"; + + print_results errors; + print_results failures; + bprintf "Ran: %d tests in: %.2f seconds.\n" + (List.length results) running_time; + + (* Print final verdict *) + if was_successful results then + begin + if skips = [] then + bprintf "OK" + else + bprintf "OK: Cases: %d Skip: %d" + test_case_count (List.length skips) + end + else + begin + bprintf + "FAILED: Cases: %d Tried: %d Errors: %d \ + Failures: %d Skip:%d Todo:%d" + test_case_count (List.length results) + (List.length errors) (List.length failures) + (List.length skips) (List.length todos); + end; + bprintf "\n"; + Buffer.contents buf + end + + | TestEvent e -> + begin + let string_of_result = + if verbose then + function + | RSuccess _ -> "ok\n" + | RFailure (_, _) -> "FAIL\n" + | RError (_, _) -> "ERROR\n" + | RSkip (_, _) -> "SKIP\n" + | RTodo (_, _) -> "TODO\n" + else + function + | RSuccess _ -> "." + | RFailure (_, _) -> "F" + | RError (_, _) -> "E" + | RSkip (_, _) -> "S" + | RTodo (_, _) -> "T" + in + if verbose then + match e with + | EStart p -> + Printf.sprintf "%s start\n" (string_of_path p) + | EEnd p -> + Printf.sprintf "%s end\n" (string_of_path p) + | EResult result -> + string_of_result result + | ELog (lvl, str) -> + let prefix = + match lvl with + | LError -> "E" + | LWarning -> "W" + | LInfo -> "I" + in + prefix^": "^str + | ELogRaw str -> + str + else + match e with + | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> "" + | EResult result -> string_of_result result + end + +let file_logger fn = + let chn = open_out fn in + (fun ev -> + output_string chn (format_event true ev); + flush chn), + (fun () -> close_out chn) + +let std_logger verbose = + (fun ev -> + print_string (format_event verbose ev); + flush stdout), + (fun () -> ()) + +let null_logger = + ignore, ignore + +let create output_file_opt verbose (log,close) = + let std_log, std_close = std_logger verbose in + let file_log, file_close = + match output_file_opt with + | Some fn -> + file_logger fn + | None -> + null_logger + in + (fun ev -> + std_log ev; file_log ev; log ev), + (fun () -> + std_close (); file_close (); close ()) + +let printf log fmt = + Printf.ksprintf + (fun s -> + log (TestEvent (ELogRaw s))) + fmt + +end +module OUnit : sig +#1 "oUnit.mli" +(***********************************************************************) +(* The OUnit library *) +(* *) +(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) +(* Copyright (C) 2010 OCamlCore SARL *) +(* *) +(* See LICENSE for details. *) +(***********************************************************************) + +(** Unit test building blocks + + @author Maas-Maarten Zeeman + @author Sylvain Le Gall + *) + +(** {2 Assertions} + + Assertions are the basic building blocks of unittests. *) + +(** Signals a failure. This will raise an exception with the specified + string. + + @raise Failure signal a failure *) +val assert_failure : string -> 'a + +(** Signals a failure when bool is false. The string identifies the + failure. + + @raise Failure signal a failure *) +val assert_bool : string -> bool -> unit + +(** Shorthand for assert_bool + + @raise Failure to signal a failure *) +val ( @? ) : string -> bool -> unit + +(** Signals a failure when the string is non-empty. The string identifies the + failure. + + @raise Failure signal a failure *) +val assert_string : string -> unit + +(** [assert_command prg args] Run the command provided. + + @param exit_code expected exit code + @param sinput provide this [char Stream.t] as input of the process + @param foutput run this function on output, it can contains an + [assert_equal] to check it + @param use_stderr redirect [stderr] to [stdout] + @param env Unix environment + @param verbose if a failure arise, dump stdout/stderr of the process to stderr + + @since 1.1.0 + *) +val assert_command : + ?exit_code:Unix.process_status -> + ?sinput:char Stream.t -> + ?foutput:(char Stream.t -> unit) -> + ?use_stderr:bool -> + ?env:string array -> + ?verbose:bool -> + string -> string list -> unit + +(** [assert_equal expected real] Compares two values, when they are not equal a + failure is signaled. + + @param cmp customize function to compare, default is [=] + @param printer value printer, don't print value otherwise + @param pp_diff if not equal, ask a custom display of the difference + using [diff fmt exp real] where [fmt] is the formatter to use + @param msg custom message to identify the failure + + @raise Failure signal a failure + + @version 1.1.0 + *) +val assert_equal : + ?cmp:('a -> 'a -> bool) -> + ?printer:('a -> string) -> + ?pp_diff:(Format.formatter -> ('a * 'a) -> unit) -> + ?msg:string -> 'a -> 'a -> unit + +(** Asserts if the expected exception was raised. + + @param msg identify the failure + + @raise Failure description *) +val assert_raises : ?msg:string -> exn -> (unit -> 'a) -> unit + +val assert_raise_any : ?msg:string -> (unit -> 'a) -> unit + +(** {2 Skipping tests } + + In certain condition test can be written but there is no point running it, because they + are not significant (missing OS features for example). In this case this is not a failure + nor a success. Following functions allow you to escape test, just as assertion but without + the same error status. + + A test skipped is counted as success. A test todo is counted as failure. + *) + +(** [skip cond msg] If [cond] is true, skip the test for the reason explain in [msg]. + For example [skip_if (Sys.os_type = "Win32") "Test a doesn't run on windows"]. + + @since 1.0.3 + *) +val skip_if : bool -> string -> unit + +(** The associated test is still to be done, for the reason given. + + @since 1.0.3 + *) +val todo : string -> unit + +(** {2 Compare Functions} *) + +(** Compare floats up to a given relative error. + + @param epsilon if the difference is smaller [epsilon] values are equal + *) +val cmp_float : ?epsilon:float -> float -> float -> bool + +(** {2 Bracket} + + A bracket is a functional implementation of the commonly used + setUp and tearDown feature in unittests. It can be used like this: + + ["MyTestCase" >:: (bracket test_set_up test_fun test_tear_down)] + + *) + +(** [bracket set_up test tear_down] The [set_up] function runs first, then + the [test] function runs and at the end [tear_down] runs. The + [tear_down] function runs even if the [test] failed and help to clean + the environment. + *) +val bracket: (unit -> 'a) -> ('a -> unit) -> ('a -> unit) -> unit -> unit + +(** [bracket_tmpfile test] The [test] function takes a temporary filename + and matching output channel as arguments. The temporary file is created + before the test and removed after the test. + + @param prefix see [Filename.open_temp_file] + @param suffix see [Filename.open_temp_file] + @param mode see [Filename.open_temp_file] + + @since 1.1.0 + *) +val bracket_tmpfile: + ?prefix:string -> + ?suffix:string -> + ?mode:open_flag list -> + ((string * out_channel) -> unit) -> unit -> unit + +(** {2 Constructing Tests} *) + +(** The type of test function *) +type test_fun = unit -> unit + +(** The type of tests *) +type test = + TestCase of test_fun + | TestList of test list + | TestLabel of string * test + +(** Create a TestLabel for a test *) +val (>:) : string -> test -> test + +(** Create a TestLabel for a TestCase *) +val (>::) : string -> test_fun -> test + +(** Create a TestLabel for a TestList *) +val (>:::) : string -> test list -> test + +(** Some shorthands which allows easy test construction. + + Examples: + + - ["test1" >: TestCase((fun _ -> ()))] => + [TestLabel("test2", TestCase((fun _ -> ())))] + - ["test2" >:: (fun _ -> ())] => + [TestLabel("test2", TestCase((fun _ -> ())))] + - ["test-suite" >::: ["test2" >:: (fun _ -> ());]] => + [TestLabel("test-suite", TestSuite([TestLabel("test2", TestCase((fun _ -> ())))]))] +*) + +(** [test_decorate g tst] Apply [g] to test function contains in [tst] tree. + + @since 1.0.3 + *) +val test_decorate : (test_fun -> test_fun) -> test -> test + +(** [test_filter paths tst] Filter test based on their path string representation. + + @param skip] if set, just use [skip_if] for the matching tests. + @since 1.0.3 + *) +val test_filter : ?skip:bool -> string list -> test -> test option + +(** {2 Retrieve Information from Tests} *) + +(** Returns the number of available test cases *) +val test_case_count : test -> int + +(** Types which represent the path of a test *) +type node = ListItem of int | Label of string +type path = node list (** The path to the test (in reverse order). *) + +(** Make a string from a node *) +val string_of_node : node -> string + +(** Make a string from a path. The path will be reversed before it is + tranlated into a string *) +val string_of_path : path -> string + +(** Returns a list with paths of the test *) +val test_case_paths : test -> path list + +(** {2 Performing Tests} *) + +(** Severity level for log. *) +type log_severity = + | LError + | LWarning + | LInfo + +(** The possible results of a test *) +type test_result = + RSuccess of path + | RFailure of path * string + | RError of path * string + | RSkip of path * string + | RTodo of path * string + +(** Events which occur during a test run. *) +type test_event = + EStart of path (** A test start. *) + | EEnd of path (** A test end. *) + | EResult of test_result (** Result of a test. *) + | ELog of log_severity * string (** An event is logged in a test. *) + | ELogRaw of string (** Print raw data in the log. *) + +(** Perform the test, allows you to build your own test runner *) +val perform_test : (test_event -> 'a) -> test -> test_result list + +(** A simple text based test runner. It prints out information + during the test. + + @param verbose print verbose message + *) +val run_test_tt : ?verbose:bool -> test -> test_result list + +(** Main version of the text based test runner. It reads the supplied command + line arguments to set the verbose level and limit the number of test to + run. + + @param arg_specs add extra command line arguments + @param set_verbose call a function to set verbosity + + @version 1.1.0 + *) +val run_test_tt_main : + ?arg_specs:(Arg.key * Arg.spec * Arg.doc) list -> + ?set_verbose:(bool -> unit) -> + test -> test_result list + +end = struct +#1 "oUnit.ml" +(***********************************************************************) +(* The OUnit library *) +(* *) +(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) +(* Copyright (C) 2010 OCamlCore SARL *) +(* *) +(* See LICENSE for details. *) +(***********************************************************************) + +open OUnitUtils +include OUnitTypes + +(* + * Types and global states. + *) + +let global_verbose = ref false + +let global_output_file = + let pwd = Sys.getcwd () in + let ocamlbuild_dir = Filename.concat pwd "_build" in + let dir = + if Sys.file_exists ocamlbuild_dir && Sys.is_directory ocamlbuild_dir then + ocamlbuild_dir + else + pwd + in + ref (Some (Filename.concat dir "oUnit.log")) + +let global_logger = ref (fst OUnitLogger.null_logger) + +let global_chooser = ref OUnitChooser.simple + +let bracket set_up f tear_down () = + let fixture = + set_up () + in + let () = + try + let () = f fixture in + tear_down fixture + with e -> + let () = + tear_down fixture + in + raise e + in + () + +let bracket_tmpfile ?(prefix="ounit-") ?(suffix=".txt") ?mode f = + bracket + (fun () -> + Filename.open_temp_file ?mode prefix suffix) + f + (fun (fn, chn) -> + begin + try + close_out chn + with _ -> + () + end; + begin + try + Sys.remove fn + with _ -> + () + end) + +exception Skip of string +let skip_if b msg = + if b then + raise (Skip msg) + +exception Todo of string +let todo msg = + raise (Todo msg) + +let assert_failure msg = + failwith ("OUnit: " ^ msg) + +let assert_bool msg b = + if not b then assert_failure msg + +let assert_string str = + if not (str = "") then assert_failure str + +let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual = + let get_error_string () = + let res = + buff_format_printf + (fun fmt -> + Format.pp_open_vbox fmt 0; + begin + match msg with + | Some s -> + Format.pp_open_box fmt 0; + Format.pp_print_string fmt s; + Format.pp_close_box fmt (); + Format.pp_print_cut fmt () + | None -> + () + end; + + begin + match printer with + | Some p -> + Format.fprintf fmt + "@[expected: @[%s@]@ but got: @[%s@]@]@," + (p expected) + (p actual) + + | None -> + Format.fprintf fmt "@[not equal@]@," + end; + + begin + match pp_diff with + | Some d -> + Format.fprintf fmt + "@[differences: %a@]@," + d (expected, actual) + + | None -> + () + end; + Format.pp_close_box fmt ()) + in + let len = + String.length res + in + if len > 0 && res.[len - 1] = '\n' then + String.sub res 0 (len - 1) + else + res + in + if not (cmp expected actual) then + assert_failure (get_error_string ()) + +let assert_command + ?(exit_code=Unix.WEXITED 0) + ?(sinput=Stream.of_list []) + ?(foutput=ignore) + ?(use_stderr=true) + ?env + ?verbose + prg args = + + bracket_tmpfile + (fun (fn_out, chn_out) -> + let cmd_print fmt = + let () = + match env with + | Some e -> + begin + Format.pp_print_string fmt "env"; + Array.iter (Format.fprintf fmt "@ %s") e; + Format.pp_print_space fmt () + end + + | None -> + () + in + Format.pp_print_string fmt prg; + List.iter (Format.fprintf fmt "@ %s") args + in + + (* Start the process *) + let in_write = + Unix.dup (Unix.descr_of_out_channel chn_out) + in + let (out_read, out_write) = + Unix.pipe () + in + let err = + if use_stderr then + in_write + else + Unix.stderr + in + let args = + Array.of_list (prg :: args) + in + let pid = + OUnitLogger.printf !global_logger "%s" + (buff_format_printf + (fun fmt -> + Format.fprintf fmt "@[Starting command '%t'@]\n" cmd_print)); + Unix.set_close_on_exec out_write; + match env with + | Some e -> + Unix.create_process_env prg args e out_read in_write err + | None -> + Unix.create_process prg args out_read in_write err + in + let () = + Unix.close out_read; + Unix.close in_write + in + let () = + (* Dump sinput into the process stdin *) + let buff = Bytes.of_string " " in + Stream.iter + (fun c -> + let _i : int = + Bytes.set buff 0 c; + Unix.write out_write buff 0 1 + in + ()) + sinput; + Unix.close out_write + in + let _, real_exit_code = + let rec wait_intr () = + try + Unix.waitpid [] pid + with Unix.Unix_error (Unix.EINTR, _, _) -> + wait_intr () + in + wait_intr () + in + let exit_code_printer = + function + | Unix.WEXITED n -> + Printf.sprintf "exit code %d" n + | Unix.WSTOPPED n -> + Printf.sprintf "stopped by signal %d" n + | Unix.WSIGNALED n -> + Printf.sprintf "killed by signal %d" n + in + + (* Dump process output to stderr *) + begin + let chn = open_in fn_out in + let buff = Bytes.make 4096 'X' in + let len = ref (-1) in + while !len <> 0 do + len := input chn buff 0 (Bytes.length buff); + OUnitLogger.printf !global_logger "%s" (Bytes.to_string @@ Bytes.sub buff 0 !len); + done; + close_in chn + end; + + (* Check process status *) + assert_equal + ~msg:(buff_format_printf + (fun fmt -> + Format.fprintf fmt + "@[Exit status of command '%t'@]" cmd_print)) + ~printer:exit_code_printer + exit_code + real_exit_code; + + begin + let chn = open_in fn_out in + try + foutput (Stream.of_channel chn) + with e -> + close_in chn; + raise e + end) + () + +let raises f = + try + f (); + None + with e -> + Some e + +let assert_raises ?msg exn (f: unit -> 'a) = + let pexn = + Printexc.to_string + in + let get_error_string () = + let str = + Format.sprintf + "expected exception %s, but no exception was raised." + (pexn exn) + in + match msg with + | None -> + assert_failure str + + | Some s -> + assert_failure (s^"\n"^str) + in + match raises f with + | None -> + assert_failure (get_error_string ()) + + | Some e -> + assert_equal ?msg ~printer:pexn exn e + + +let assert_raise_any ?msg (f: unit -> 'a) = + let pexn = + Printexc.to_string + in + let get_error_string () = + let str = + Format.sprintf + "expected exception , but no exception was raised." + + in + match msg with + | None -> + assert_failure str + + | Some s -> + assert_failure (s^"\n"^str) + in + match raises f with + | None -> + assert_failure (get_error_string ()) + + | Some exn -> + assert_bool (pexn exn) true +(* Compare floats up to a given relative error *) +let cmp_float ?(epsilon = 0.00001) a b = + abs_float (a -. b) <= epsilon *. (abs_float a) || + abs_float (a -. b) <= epsilon *. (abs_float b) + +(* Now some handy shorthands *) +let (@?) = assert_bool + +(* Some shorthands which allows easy test construction *) +let (>:) s t = TestLabel(s, t) (* infix *) +let (>::) s f = TestLabel(s, TestCase(f)) (* infix *) +let (>:::) s l = TestLabel(s, TestList(l)) (* infix *) + +(* Utility function to manipulate test *) +let rec test_decorate g = + function + | TestCase f -> + TestCase (g f) + | TestList tst_lst -> + TestList (List.map (test_decorate g) tst_lst) + | TestLabel (str, tst) -> + TestLabel (str, test_decorate g tst) + +let test_case_count = OUnitUtils.test_case_count +let string_of_node = OUnitUtils.string_of_node +let string_of_path = OUnitUtils.string_of_path + +(* Returns all possible paths in the test. The order is from test case + to root + *) +let test_case_paths test = + let rec tcps path test = + match test with + | TestCase _ -> + [path] + + | TestList tests -> + List.concat + (mapi (fun t i -> tcps ((ListItem i)::path) t) tests) + + | TestLabel (l, t) -> + tcps ((Label l)::path) t + in + tcps [] test + +(* Test filtering with their path *) +module SetTestPath = Set.Make(String) + +let test_filter ?(skip=false) only test = + let set_test = + List.fold_left + (fun st str -> SetTestPath.add str st) + SetTestPath.empty + only + in + let rec filter_test path tst = + if SetTestPath.mem (string_of_path path) set_test then + begin + Some tst + end + + else + begin + match tst with + | TestCase f -> + begin + if skip then + Some + (TestCase + (fun () -> + skip_if true "Test disabled"; + f ())) + else + None + end + + | TestList tst_lst -> + begin + let ntst_lst = + fold_lefti + (fun ntst_lst tst i -> + let nntst_lst = + match filter_test ((ListItem i) :: path) tst with + | Some tst -> + tst :: ntst_lst + | None -> + ntst_lst + in + nntst_lst) + [] + tst_lst + in + if not skip && ntst_lst = [] then + None + else + Some (TestList (List.rev ntst_lst)) + end + + | TestLabel (lbl, tst) -> + begin + let ntst_opt = + filter_test + ((Label lbl) :: path) + tst + in + match ntst_opt with + | Some ntst -> + Some (TestLabel (lbl, ntst)) + | None -> + if skip then + Some (TestLabel (lbl, tst)) + else + None + end + end + in + filter_test [] test + + +(* The possible test results *) +let is_success = OUnitUtils.is_success +let is_failure = OUnitUtils.is_failure +let is_error = OUnitUtils.is_error +let is_skip = OUnitUtils.is_skip +let is_todo = OUnitUtils.is_todo + +(* TODO: backtrace is not correct *) +let maybe_backtrace = "" + (* Printexc.get_backtrace () *) + (* (if Printexc.backtrace_status () then *) + (* "\n" ^ Printexc.get_backtrace () *) + (* else "") *) +(* Events which can happen during testing *) + +(* DEFINE MAYBE_BACKTRACE = *) +(* IFDEF BACKTRACE THEN *) +(* (if Printexc.backtrace_status () then *) +(* "\n" ^ Printexc.get_backtrace () *) +(* else "") *) +(* ELSE *) +(* "" *) +(* ENDIF *) + +(* Run all tests, report starts, errors, failures, and return the results *) +let perform_test report test = + let run_test_case f path = + try + f (); + RSuccess path + with + | Failure s -> + RFailure (path, s ^ maybe_backtrace) + + | Skip s -> + RSkip (path, s) + + | Todo s -> + RTodo (path, s) + + | s -> + RError (path, (Printexc.to_string s) ^ maybe_backtrace) + in + let rec flatten_test path acc = + function + | TestCase(f) -> + (path, f) :: acc + + | TestList (tests) -> + fold_lefti + (fun acc t cnt -> + flatten_test + ((ListItem cnt)::path) + acc t) + acc tests + + | TestLabel (label, t) -> + flatten_test ((Label label)::path) acc t + in + let test_cases = List.rev (flatten_test [] [] test) in + let runner (path, f) = + let result = + report (EStart path); + run_test_case f path + in + report (EResult result); + report (EEnd path); + result + in + let rec iter state = + match state.tests_planned with + | [] -> + state.results + | _ -> + let (path, f) = !global_chooser state in + let result = runner (path, f) in + iter + { + results = result :: state.results; + tests_planned = + List.filter + (fun (path', _) -> path <> path') state.tests_planned + } + in + iter {results = []; tests_planned = test_cases} + +(* Function which runs the given function and returns the running time + of the function, and the original result in a tuple *) +let time_fun f x y = + let begin_time = Unix.gettimeofday () in + let result = f x y in + let end_time = Unix.gettimeofday () in + (end_time -. begin_time, result) + +(* A simple (currently too simple) text based test runner *) +let run_test_tt ?verbose test = + let log, log_close = + OUnitLogger.create + !global_output_file + !global_verbose + OUnitLogger.null_logger + in + let () = + global_logger := log + in + + (* Now start the test *) + let running_time, results = + time_fun + perform_test + (fun ev -> + log (OUnitLogger.TestEvent ev)) + test + in + + (* Print test report *) + log (OUnitLogger.GlobalEvent (GResults (running_time, results, test_case_count test))); + + (* Reset logger. *) + log_close (); + global_logger := fst OUnitLogger.null_logger; + + (* Return the results possibly for further processing *) + results + +(* Call this one from you test suites *) +let run_test_tt_main ?(arg_specs=[]) ?(set_verbose=ignore) suite = + let only_test = ref [] in + let () = + Arg.parse + (Arg.align + [ + "-verbose", + Arg.Set global_verbose, + " Run the test in verbose mode."; + + "-only-test", + Arg.String (fun str -> only_test := str :: !only_test), + "path Run only the selected test"; + + "-output-file", + Arg.String (fun s -> global_output_file := Some s), + "fn Output verbose log in this file."; + + "-no-output-file", + Arg.Unit (fun () -> global_output_file := None), + " Prevent to write log in a file."; + + "-list-test", + Arg.Unit + (fun () -> + List.iter + (fun pth -> + print_endline (string_of_path pth)) + (test_case_paths suite); + exit 0), + " List tests"; + ] @ arg_specs + ) + (fun x -> raise (Arg.Bad ("Bad argument : " ^ x))) + ("usage: " ^ Sys.argv.(0) ^ " [-verbose] [-only-test path]*") + in + let nsuite = + if !only_test = [] then + suite + else + begin + match test_filter ~skip:true !only_test suite with + | Some test -> + test + | None -> + failwith ("Filtering test "^ + (String.concat ", " !only_test)^ + " lead to no test") + end + in + + let result = + set_verbose !global_verbose; + run_test_tt ~verbose:!global_verbose nsuite + in + if not (was_successful result) then + exit 1 + else + result + +end +module Ext_array : sig +#1 "ext_array.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. *) + + + + + + +(** Some utilities for {!Array} operations *) +val reverse_range : 'a array -> int -> int -> unit +val reverse_in_place : 'a array -> unit +val reverse : 'a array -> 'a array +val reverse_of_list : 'a list -> 'a array + +val filter : ('a -> bool) -> 'a array -> 'a array + +val filter_map : ('a -> 'b option) -> 'a array -> 'b array + +val range : int -> int -> int array + +val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array + +val to_list_f : ('a -> 'b) -> 'a array -> 'b list +val to_list_map : ('a -> 'b option) -> 'a array -> 'b list + +val to_list_map_acc : + 'a array -> + 'b list -> + ('a -> 'b option) -> + 'b list + +val of_list_map : + 'a list -> + ('a -> 'b) -> + 'b array + +val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int + + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] + +val rfind_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val find_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val exists : ('a -> bool) -> 'a array -> bool + +val is_empty : 'a array -> bool + +val for_all2_no_exn : + 'a array -> + 'b array -> + ('a -> 'b -> bool) -> + bool + +val map : + 'a array -> + ('a -> 'b) -> + 'b array + +val iter : + 'a array -> + ('a -> unit) -> + unit + +val fold_left : + 'b array -> + 'a -> + ('a -> 'b -> 'a) -> + 'a +end = struct +#1 "ext_array.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 reverse_range a i len = + if len = 0 then () + else + for k = 0 to (len-1)/2 do + let t = Array.unsafe_get a (i+k) in + Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k)); + Array.unsafe_set a (i+len-1-k) t; + done + + +let reverse_in_place a = + reverse_range a 0 (Array.length a) + +let reverse a = + let b_len = Array.length a in + if b_len = 0 then [||] else + let b = Array.copy a in + for i = 0 to b_len - 1 do + Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) + done; + b + +let reverse_of_list = function + | [] -> [||] + | hd::tl as l -> + let len = List.length l in + let a = Array.make len hd in + let rec fill i = function + | [] -> a + | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in + fill 0 tl + +let filter f a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + if f v then + aux (v::acc) (i+1) + else aux acc (i + 1) + in aux [] 0 + + +let filter_map (f : _ -> _ option) a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + match f v with + | Some v -> + aux (v::acc) (i+1) + | None -> + aux acc (i + 1) + in aux [] 0 + +let range from to_ = + if from > to_ then invalid_arg "Ext_array.range" + else Array.init (to_ - from + 1) (fun i -> i + from) + +let map2i f a b = + let len = Array.length a in + if len <> Array.length b then + invalid_arg "Ext_array.map2i" + else + Array.mapi (fun i a -> f i a ( Array.unsafe_get b i )) a + +let rec tolist_f_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_f_aux a f (i - 1) + (f v :: res) + +let to_list_f f a = tolist_f_aux a f (Array.length a - 1) [] + +let rec tolist_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_aux a f (i - 1) + (match f v with + | Some v -> v :: res + | None -> res) + +let to_list_map f a = + tolist_aux a f (Array.length a - 1) [] + +let to_list_map_acc a acc f = + tolist_aux a f (Array.length a - 1) acc + + +let of_list_map a f = + match a with + | [] -> [||] + | [a0] -> + let b0 = f a0 in + [|b0|] + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + [|b0;b1|] + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + [|b0;b1;b2|] + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + [|b0;b1;b2;b3|] + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + [|b0;b1;b2;b3;b4|] + + | a0::a1::a2::a3::a4::tl -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + let len = List.length tl + 5 in + let arr = Array.make len b0 in + Array.unsafe_set arr 1 b1 ; + Array.unsafe_set arr 2 b2 ; + Array.unsafe_set arr 3 b3 ; + Array.unsafe_set arr 4 b4 ; + let rec fill i = function + | [] -> arr + | hd :: tl -> + Array.unsafe_set arr i (f hd); + fill (i + 1) tl in + fill 5 tl + +(** + {[ + # rfind_with_index [|1;2;3|] (=) 2;; + - : int = 1 + # rfind_with_index [|1;2;3|] (=) 1;; + - : int = 0 + # rfind_with_index [|1;2;3|] (=) 3;; + - : int = 2 + # rfind_with_index [|1;2;3|] (=) 4;; + - : int = -1 + ]} +*) +let rfind_with_index arr cmp v = + let len = Array.length arr in + let rec aux i = + if i < 0 then i + else if cmp (Array.unsafe_get arr i) v then i + else aux (i - 1) in + aux (len - 1) + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] +let rfind_and_split arr cmp v : _ split = + let i = rfind_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i , Array.sub arr (i + 1 ) (Array.length arr - i - 1 )) + + +let find_with_index arr cmp v = + let len = Array.length arr in + let rec aux i len = + if i >= len then -1 + else if cmp (Array.unsafe_get arr i ) v then i + else aux (i + 1) len in + aux 0 len + +let find_and_split arr cmp v : _ split = + let i = find_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1)) + +(** TODO: available since 4.03, use {!Array.exists} *) + +let exists p a = + let n = Array.length a in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + + +let is_empty arr = + Array.length arr = 0 + + +let rec unsafe_loop index len p xs ys = + if index >= len then true + else + p + (Array.unsafe_get xs index) + (Array.unsafe_get ys index) && + unsafe_loop (succ index) len p xs ys + +let for_all2_no_exn xs ys p = + let len_xs = Array.length xs in + let len_ys = Array.length ys in + len_xs = len_ys && + unsafe_loop 0 len_xs p xs ys + + +let map a f = + let open Array in + let l = length a in + if l = 0 then [||] else begin + let r = make l (f(unsafe_get a 0)) in + for i = 1 to l - 1 do + unsafe_set r i (f(unsafe_get a i)) + done; + r + end + +let iter a f = + let open Array in + for i = 0 to length a - 1 do f(unsafe_get a i) done + + + let fold_left a x f = + let open Array in + let r = ref x in + for i = 0 to length a - 1 do + r := f !r (unsafe_get a i) + done; + !r + +end +module Ext_bytes : sig +#1 "ext_bytes.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. *) + + + + + + + +(** Port the {!Bytes.escaped} from trunk to make it not locale sensitive *) + +val escaped : bytes -> bytes + +end = struct +#1 "ext_bytes.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. *) + + + + + + + + +external char_code: char -> int = "%identity" +external char_chr: int -> char = "%identity" + +let escaped s = + let n = Pervasives.ref 0 in + for i = 0 to Bytes.length s - 1 do + n := !n + + (match Bytes.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | ' ' .. '~' -> 1 + | _ -> 4) + done; + if !n = Bytes.length s then Bytes.copy s else begin + let s' = Bytes.create !n in + n := 0; + for i = 0 to Bytes.length s - 1 do + begin match Bytes.unsafe_get s i with + | ('"' | '\\') as c -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c + | '\n' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' + | '\t' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' + | '\r' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' + | '\b' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' + | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c + | c -> + let a = char_code c in + Bytes.unsafe_set s' !n '\\'; + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a / 100)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a mod 10)); + end; + incr n + done; + s' + end + +end +module Ext_pervasives : sig +#1 "ext_pervasives.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. *) + + + + + + + + +(** Extension to standard library [Pervavives] module, safe to open + *) + +external reraise: exn -> 'a = "%reraise" + +val finally : 'a -> ('a -> 'c) -> ('a -> 'b) -> 'b + +val try_it : (unit -> 'a) -> unit + +val with_file_as_chan : string -> (out_channel -> 'a) -> 'a + +val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a + +val is_pos_pow : Int32.t -> int + +val failwithf : loc:string -> ('a, unit, string, 'b) format4 -> 'a + +val invalid_argf : ('a, unit, string, 'b) format4 -> 'a + +val bad_argf : ('a, unit, string, 'b) format4 -> 'a + + + + +external id : 'a -> 'a = "%identity" + +(** Copied from {!Btype.hash_variant}: + need sync up and add test case + *) +val hash_variant : string -> int + +val todo : string -> 'a +end = struct +#1 "ext_pervasives.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. *) + + + + + + +external reraise: exn -> 'a = "%reraise" + +let finally v action f = + match f v with + | exception e -> + action v ; + reraise e + | e -> action v ; e + +let try_it f = + try ignore (f ()) with _ -> () + +let with_file_as_chan filename f = + finally (open_out_bin filename) close_out f + +let with_file_as_pp filename f = + finally (open_out_bin filename) close_out + (fun chan -> + let fmt = Format.formatter_of_out_channel chan in + let v = f fmt in + Format.pp_print_flush fmt (); + v + ) + + +let is_pos_pow n = + let module M = struct exception E end in + let rec aux c (n : Int32.t) = + if n <= 0l then -2 + else if n = 1l then c + else if Int32.logand n 1l = 0l then + aux (c + 1) (Int32.shift_right n 1 ) + else raise M.E in + try aux 0 n with M.E -> -1 + +let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s)) + fmt + +let invalid_argf fmt = Format.ksprintf invalid_arg fmt + +let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt + +external id : 'a -> 'a = "%identity" + + +let hash_variant s = + let accu = ref 0 in + for i = 0 to String.length s - 1 do + accu := 223 * !accu + Char.code s.[i] + done; + (* reduce to 31 bits *) + accu := !accu land (1 lsl 31 - 1); + (* make it signed for 64 bits architectures *) + if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu + +let todo loc = + failwith (loc ^ " Not supported yet") +end +module Ext_string : sig +#1 "ext_string.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. *) + + + + + + + + +(** Extension to the standard library [String] module, fixed some bugs like + avoiding locale sensitivity *) + +(** default is false *) +val split_by : ?keep_empty:bool -> (char -> bool) -> string -> string list + + +(** remove whitespace letters ('\t', '\n', ' ') on both side*) +val trim : string -> string + + +(** default is false *) +val split : ?keep_empty:bool -> string -> char -> string list + +(** split by space chars for quick scripting *) +val quick_split_by_ws : string -> string list + + + +val starts_with : string -> string -> bool + +(** + return [-1] when not found, the returned index is useful + see [ends_with_then_chop] +*) +val ends_with_index : string -> string -> int + +val ends_with : string -> string -> bool + +(** + [ends_with_then_chop name ext] + @example: + {[ + ends_with_then_chop "a.cmj" ".cmj" + "a" + ]} + This is useful in controlled or file case sensitve system +*) +val ends_with_then_chop : string -> string -> string option + + +val escaped : string -> string + +(** + [for_all_from s start p] + if [start] is negative, it raises, + if [start] is too large, it returns true +*) +val for_all_from: + string -> + int -> + (char -> bool) -> + bool + +val for_all : + string -> + (char -> bool) -> + bool + +val is_empty : string -> bool + +val repeat : int -> string -> string + +val equal : string -> string -> bool + +(** + [extract_until s cursor sep] + When [sep] not found, the cursor is updated to -1, + otherwise cursor is increased to 1 + [sep_position] + User can not determine whether it is found or not by + telling the return string is empty since + "\n\n" would result in an empty string too. +*) +val extract_until: + string -> + int ref -> (* cursor to be updated *) + char -> + string + +val index_count: + string -> + int -> + char -> + int -> + int + +(** + [find ~start ~sub s] + returns [-1] if not found +*) +val find : ?start:int -> sub:string -> string -> int + +val contain_substring : string -> string -> bool + +val non_overlap_count : sub:string -> string -> int + +val rfind : sub:string -> string -> int + +(** [tail_from s 1] + return a substring from offset 1 (inclusive) +*) +val tail_from : string -> int -> string + + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option + +type check_result = + | Good | Invalid_module_name | Suffix_mismatch + +val is_valid_source_name : + string -> check_result + + + + + +val no_char : string -> char -> int -> int -> bool + + +val no_slash : string -> bool + +(** return negative means no slash, otherwise [i] means the place for first slash *) +val no_slash_idx : string -> int + +val no_slash_idx_from : string -> int -> int + +(** if no conversion happens, reference equality holds *) +val replace_slash_backward : string -> string + +(** if no conversion happens, reference equality holds *) +val replace_backward_slash : string -> string + +val empty : string + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +val single_space : string + +val concat3 : string -> string -> string -> string +val concat4 : string -> string -> string -> string -> string +val concat5 : string -> string -> string -> string -> string -> string +val inter2 : string -> string -> string +val inter3 : string -> string -> string -> string +val inter4 : string -> string -> string -> string -> string +val concat_array : string -> string array -> string + +val single_colon : string + +val parent_dir_lit : string +val current_dir_lit : string + +val capitalize_ascii : string -> string + +val uncapitalize_ascii : string -> string + +val lowercase_ascii : string -> string +end = struct +#1 "ext_string.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. *) + + + + + + + +(* + {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} +*) +let split_by ?(keep_empty=false) is_delim str = + let len = String.length str in + let rec loop acc last_pos pos = + if pos = -1 then + if last_pos = 0 && not keep_empty then + + acc + else + String.sub str 0 last_pos :: acc + else + if is_delim str.[pos] then + let new_len = (last_pos - pos - 1) in + if new_len <> 0 || keep_empty then + let v = String.sub str (pos + 1) new_len in + loop ( v :: acc) + pos (pos - 1) + else loop acc pos (pos - 1) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) + +let trim s = + let i = ref 0 in + let j = String.length s in + while !i < j && + let u = String.unsafe_get s !i in + u = '\t' || u = '\n' || u = ' ' + do + incr i; + done; + let k = ref (j - 1) in + while !k >= !i && + let u = String.unsafe_get s !k in + u = '\t' || u = '\n' || u = ' ' do + decr k ; + done; + String.sub s !i (!k - !i + 1) + +let split ?keep_empty str on = + if str = "" then [] else + split_by ?keep_empty (fun x -> (x : char) = on) str ;; + +let quick_split_by_ws str : string list = + split_by ~keep_empty:false (fun x -> x = '\t' || x = '\n' || x = ' ') str + +let starts_with s beg = + let beg_len = String.length beg in + let s_len = String.length s in + beg_len <= s_len && + (let i = ref 0 in + while !i < beg_len + && String.unsafe_get s !i = + String.unsafe_get beg !i do + incr i + done; + !i = beg_len + ) + +let rec ends_aux s end_ j k = + if k < 0 then (j + 1) + else if String.unsafe_get s j = String.unsafe_get end_ k then + ends_aux s end_ (j - 1) (k - 1) + else -1 + +(** return an index which is minus when [s] does not + end with [beg] +*) +let ends_with_index s end_ = + let s_finish = String.length s - 1 in + let s_beg = String.length end_ - 1 in + if s_beg > s_finish then -1 + else + ends_aux s end_ s_finish s_beg + +let ends_with s end_ = ends_with_index s end_ >= 0 + +let ends_with_then_chop s beg = + let i = ends_with_index s beg in + if i >= 0 then Some (String.sub s 0 i) + else None + +let check_suffix_case = ends_with +let check_suffix_case_then_chop = ends_with_then_chop + +let check_any_suffix_case s suffixes = + List.exists (fun x -> check_suffix_case s x) suffixes + +let check_any_suffix_case_then_chop s suffixes = + let rec aux suffixes = + match suffixes with + | [] -> None + | x::xs -> + let id = ends_with_index s x in + if id >= 0 then Some (String.sub s 0 id) + else aux xs in + aux suffixes + + + +(** In OCaml 4.02.3, {!String.escaped} is locale senstive, + this version try to make it not locale senstive, this bug is fixed + in the compiler trunk +*) +let escaped s = + let rec needs_escape i = + if i >= String.length s then false else + match String.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true + | ' ' .. '~' -> needs_escape (i+1) + | _ -> true + in + if needs_escape 0 then + Bytes.unsafe_to_string (Ext_bytes.escaped (Bytes.unsafe_of_string s)) + else + s + +(* it is unsafe to expose such API as unsafe since + user can provide bad input range + +*) +let rec unsafe_for_all_range s ~start ~finish p = + start > finish || + p (String.unsafe_get s start) && + unsafe_for_all_range s ~start:(start + 1) ~finish p + +let for_all_from s start p = + let len = String.length s in + if start < 0 then invalid_arg "Ext_string.for_all_from" + else unsafe_for_all_range s ~start ~finish:(len - 1) p + + +let for_all s (p : char -> bool) = + unsafe_for_all_range s ~start:0 ~finish:(String.length s - 1) p + +let is_empty s = String.length s = 0 + + +let repeat n s = + let len = String.length s in + let res = Bytes.create(n * len) in + for i = 0 to pred n do + String.blit s 0 res (i * len) len + done; + Bytes.to_string res + +let equal (x : string) y = x = y + + + +let unsafe_is_sub ~sub i s j ~len = + let rec check k = + if k = len + then true + else + String.unsafe_get sub (i+k) = + String.unsafe_get s (j+k) && check (k+1) + in + j+len <= String.length s && check 0 + + +exception Local_exit +let find ?(start=0) ~sub s = + let n = String.length sub in + let s_len = String.length s in + let i = ref start in + try + while !i + n <= s_len do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + incr i + done; + -1 + with Local_exit -> + !i + +let contain_substring s sub = + find s ~sub >= 0 + +(** TODO: optimize + avoid nonterminating when string is empty +*) +let non_overlap_count ~sub s = + let sub_len = String.length sub in + let rec aux acc off = + let i = find ~start:off ~sub s in + if i < 0 then acc + else aux (acc + 1) (i + sub_len) in + if String.length sub = 0 then invalid_arg "Ext_string.non_overlap_count" + else aux 0 0 + + +let rfind ~sub s = + let n = String.length sub in + let i = ref (String.length s - n) in + let module M = struct exception Exit end in + try + while !i >= 0 do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + decr i + done; + -1 + with Local_exit -> + !i + +let tail_from s x = + let len = String.length s in + if x > len then invalid_arg ("Ext_string.tail_from " ^s ^ " : "^ string_of_int x ) + else String.sub s x (len - x) + +let equal (x : string) y = x = y + +let rec index_rec s lim i c = + if i >= lim then -1 else + if String.unsafe_get s i = c then i + else index_rec s lim (i + 1) c + +let rec index_rec_count s lim i c count = + if i >= lim then -1 else + if String.unsafe_get s i = c then + if count = 1 then i + else index_rec_count s lim (i + 1) c (count - 1) + else index_rec_count s lim (i + 1) c count + +let index_count s i c count = + let lim = String.length s in + if i < 0 || i >= lim || count < 1 then + Ext_pervasives.invalid_argf "index_count: (%d,%d)" i count; + + index_rec_count s lim i c count +let extract_until s cursor c = + let len = String.length s in + let start = !cursor in + if start < 0 || start >= len then ( + cursor := -1; + "" + ) + else + let i = index_rec s len start c in + let finish = + if i < 0 then ( + cursor := -1 ; + len + ) + else ( + cursor := i + 1; + i + ) in + String.sub s start (finish - start) + +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;; + +let is_valid_module_file (s : string) = + let len = String.length s in + len > 0 && + match String.unsafe_get s 0 with + | 'A' .. 'Z' + | 'a' .. 'z' -> + unsafe_for_all_range s ~start:1 ~finish:(len - 1) + (fun x -> + match x with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> true + | _ -> false ) + | _ -> false + + + + +type check_result = + | Good + | Invalid_module_name + | Suffix_mismatch + (** + TODO: move to another module + Make {!Ext_filename} not stateful + *) +let is_valid_source_name name : check_result = + match check_any_suffix_case_then_chop name [ + ".ml"; + ".re"; + ".mli"; + ".rei" + ] with + | None -> Suffix_mismatch + | Some x -> + if is_valid_module_file x then + Good + else Invalid_module_name + +(** TODO: can be improved to return a positive integer instead *) +let rec unsafe_no_char x ch i last_idx = + i > last_idx || + (String.unsafe_get x i <> ch && unsafe_no_char x ch (i + 1) last_idx) + +let rec unsafe_no_char_idx x ch i last_idx = + if i > last_idx then -1 + else + if String.unsafe_get x i <> ch then + unsafe_no_char_idx x ch (i + 1) last_idx + else i + +let no_char x ch i len : bool = + let str_len = String.length x in + if i < 0 || i >= str_len || len >= str_len then invalid_arg "Ext_string.no_char" + else unsafe_no_char x ch i len + + +let no_slash x = + unsafe_no_char x '/' 0 (String.length x - 1) + +let no_slash_idx x = + unsafe_no_char_idx x '/' 0 (String.length x - 1) + +let no_slash_idx_from x from = + let last_idx = String.length x - 1 in + assert (from >= 0); + unsafe_no_char_idx x '/' from last_idx + +let replace_slash_backward (x : string ) = + let len = String.length x in + if unsafe_no_char x '/' 0 (len - 1) then x + else + String.map (function + | '/' -> '\\' + | x -> x ) x + +let replace_backward_slash (x : string)= + let len = String.length x in + if unsafe_no_char x '\\' 0 (len -1) then x + else + String.map (function + |'\\'-> '/' + | x -> x) x + +let empty = "" + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +let single_space = " " +let single_colon = ":" + +let concat_array sep (s : string array) = + let s_len = Array.length s in + match s_len with + | 0 -> empty + | 1 -> Array.unsafe_get s 0 + | _ -> + let sep_len = String.length sep in + let len = ref 0 in + for i = 0 to s_len - 1 do + len := !len + String.length (Array.unsafe_get s i) + done; + let target = + Bytes.create + (!len + (s_len - 1) * sep_len ) in + let hd = (Array.unsafe_get s 0) in + let hd_len = String.length hd in + String.unsafe_blit hd 0 target 0 hd_len; + let current_offset = ref hd_len in + for i = 1 to s_len - 1 do + String.unsafe_blit sep 0 target !current_offset sep_len; + let cur = Array.unsafe_get s i in + let cur_len = String.length cur in + let new_off_set = (!current_offset + sep_len ) in + String.unsafe_blit cur 0 target new_off_set cur_len; + current_offset := + new_off_set + cur_len ; + done; + Bytes.unsafe_to_string target + +let concat3 a b c = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let len = a_len + b_len + c_len in + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + Bytes.unsafe_to_string target + +let concat4 a b c d = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let len = a_len + b_len + c_len + d_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + Bytes.unsafe_to_string target + + +let concat5 a b c d e = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let e_len = String.length e in + let len = a_len + b_len + c_len + d_len + e_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + String.unsafe_blit e 0 target (a_len + b_len + c_len + d_len) e_len; + Bytes.unsafe_to_string target + + + +let inter2 a b = + concat3 a single_space b + + +let inter3 a b c = + concat5 a single_space b single_space c + + + + + +let inter4 a b c d = + concat_array single_space [| a; b ; c; d|] + + +let parent_dir_lit = ".." +let current_dir_lit = "." + + +(* reference {!Bytes.unppercase} *) +let capitalize_ascii (s : string) : string = + if String.length s = 0 then s + else + begin + let c = String.unsafe_get s 0 in + if (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') then + let uc = Char.unsafe_chr (Char.code c - 32) in + let bytes = Bytes.of_string s in + Bytes.unsafe_set bytes 0 uc; + Bytes.unsafe_to_string bytes + else s + end + +let uncapitalize_ascii = + + String.uncapitalize_ascii + + + + +let lowercase_ascii = String.lowercase_ascii + + + + + +end +module Ounit_array_tests += struct +#1 "ounit_array_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +let printer_int_array = fun xs -> + String.concat "," + (List.map string_of_int @@ Array.to_list xs ) + +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Ext_array.find_and_split + [|"a"; "b";"c"|] + Ext_string.equal "--" =~ `No_split + end; + __LOC__ >:: begin fun _ -> + Ext_array.find_and_split + [|"a"; "b";"c";"--"|] + Ext_string.equal "--" =~ `Split ([|"a";"b";"c"|],[||]) + end; + __LOC__ >:: begin fun _ -> + Ext_array.find_and_split + [|"--"; "a"; "b";"c";"--"|] + Ext_string.equal "--" =~ `Split ([||], [|"a";"b";"c";"--"|]) + end; + __LOC__ >:: begin fun _ -> + Ext_array.find_and_split + [| "u"; "g"; "--"; "a"; "b";"c";"--"|] + Ext_string.equal "--" =~ `Split ([|"u";"g"|], [|"a";"b";"c";"--"|]) + end; + __LOC__ >:: begin fun _ -> + Ext_array.reverse [|1;2|] =~ [|2;1|]; + Ext_array.reverse [||] =~ [||] + end ; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:printer_int_array in + let k x y = Ext_array.of_list_map y x in + k succ [] =~ [||]; + k succ [1] =~ [|2|]; + k succ [1;2;3] =~ [|2;3;4|]; + k succ [1;2;3;4] =~ [|2;3;4;5|]; + k succ [1;2;3;4;5] =~ [|2;3;4;5;6|]; + k succ [1;2;3;4;5;6] =~ [|2;3;4;5;6;7|]; + k succ [1;2;3;4;5;6;7] =~ [|2;3;4;5;6;7;8|]; + end; + __LOC__ >:: begin fun _ -> + Ext_array.to_list_map_acc + [|1;2;3;4;5;6|] [1;2;3] + (fun x -> if x mod 2 = 0 then Some x else None ) + =~ [2;4;6;1;2;3] + end; + __LOC__ >:: begin fun _ -> + Ext_array.to_list_map_acc + [|1;2;3;4;5;6|] [] + (fun x -> if x mod 2 = 0 then Some x else None ) + =~ [2;4;6] + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_array.for_all2_no_exn + [|1;2;3|] + [|1;2;3|] + (=) + ) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_array.for_all2_no_exn + [||] [||] (=) + ); + OUnit.assert_bool __LOC__ + (not @@ Ext_array.for_all2_no_exn + [||] [|1|] (=) + ) + end + ; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (not (Ext_array.for_all2_no_exn + [|1;2;3|] + [|1;2;33|] + (=) + )) + end + ] +end +module Ounit_tests_util += struct +#1 "ounit_tests_util.ml" + + + +let time ?nums description f = + match nums with + | None -> + begin + let start = Unix.gettimeofday () in + ignore @@ f (); + let finish = Unix.gettimeofday () in + Printf.printf "\n%s elapsed %f\n" description (finish -. start) ; + flush stdout; + end + + | Some nums -> + begin + let start = Unix.gettimeofday () in + for i = 0 to nums - 1 do + ignore @@ f (); + done ; + let finish = Unix.gettimeofday () in + Printf.printf "\n%s elapsed %f\n" description (finish -. start) ; + flush stdout; + end + +end +module Set_gen += struct +#1 "set_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. *) +(* *) +(***********************************************************************) + +(** balanced tree based on stdlib distribution *) + +type ('a, 'id) t0 = + | Empty + | Node of ('a, 'id) t0 * 'a * ('a, 'id) t0 * int + +type ('a, 'id) enumeration0 = + | End | More of 'a * ('a, 'id) t0 * ('a, 'id) enumeration0 + + +let rec cons_enum s e = + match s with + | Empty -> e + | Node(l,v,r,_) -> cons_enum l (More(v,r,e)) + +let rec height = function + | Empty -> 0 + | Node(_,_,_,h) -> h + +(* Smallest and greatest element of a set *) + +let rec min_elt = function + Empty -> raise Not_found + | Node(Empty, v, r, _) -> v + | Node(l, v, r, _) -> min_elt l + +let rec max_elt = function + Empty -> raise Not_found + | Node(l, v, Empty, _) -> v + | Node(l, v, r, _) -> max_elt r + + + + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec elements_aux accu = function + | Empty -> accu + | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l + +let elements s = + elements_aux [] s + +let choose = min_elt + +let rec iter x f = match x with + | Empty -> () + | Node(l, v, r, _) -> iter l f ; f v; iter r f + +let rec fold s accu f = + match s with + | Empty -> accu + | Node(l, v, r, _) -> fold r (f v (fold l accu f)) f + +let rec for_all x p = match x with + | Empty -> true + | Node(l, v, r, _) -> p v && for_all l p && for_all r p + +let rec exists x p = match x with + | Empty -> false + | Node(l, v, r, _) -> p v || exists l p || exists r p + + +let max_int3 (a : int) b c = + if a >= b then + if a >= c then a + else c + else + if b >=c then b + else c +let max_int_2 (a : int) b = + if a >= b then a else b + + + +exception Height_invariant_broken +exception Height_diff_borken + +let rec check_height_and_diff = + function + | Empty -> 0 + | Node(l,_,r,h) -> + let hl = check_height_and_diff l in + let hr = check_height_and_diff r in + if h <> max_int_2 hl hr + 1 then raise Height_invariant_broken + else + let diff = (abs (hl - hr)) in + if diff > 2 then raise Height_diff_borken + else h + +let check tree = + ignore (check_height_and_diff tree) +(* + Invariants: + 1. {[ l < v < r]} + 2. l and r balanced + 3. [height l] - [height r] <= 2 +*) +let create l v r = + let hl = match l with Empty -> 0 | Node (_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node (_,_,_,h) -> h in + Node(l,v,r, if hl >= hr then hl + 1 else hr + 1) + +(* Same as create, but performs one step of rebalancing if necessary. + Invariants: + 1. {[ l < v < r ]} + 2. l and r balanced + 3. | height l - height r | <= 3. + + Proof by indunction + + Lemma: the height of [bal l v r] will bounded by [max l r] + 1 +*) +let internal_bal l v r = + let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> assert false + | Node(ll, lv, lr, _) -> + if height ll >= height lr then + (* [ll] >~ [lr] + [ll] >~ [r] + [ll] ~~ [ lr ^ r] + *) + create ll lv (create lr v r) + else begin + match lr with + Empty -> assert false + | Node(lrl, lrv, lrr, _)-> + (* [lr] >~ [ll] + [lr] >~ [r] + [ll ^ lrl] ~~ [lrr ^ r] + *) + create (create ll lv lrl) lrv (create lrr v r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> assert false + | Node(rl, rv, rr, _) -> + if height rr >= height rl then + create (create l v rl) rv rr + else begin + match rl with + Empty -> assert false + | Node(rll, rlv, rlr, _) -> + create (create l v rll) rlv (create rlr rv rr) + end + end else + Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1)) + +let rec remove_min_elt = function + Empty -> invalid_arg "Set.remove_min_elt" + | Node(Empty, v, r, _) -> r + | Node(l, v, r, _) -> internal_bal (remove_min_elt l) v r + +let singleton x = Node(Empty, x, Empty, 1) + +(* + All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. + weak form of [concat] +*) + +let internal_merge l r = + match (l, r) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> internal_bal l (min_elt r) (remove_min_elt r) + +(* Beware: those two functions assume that the added v is *strictly* + smaller (or bigger) than all the present elements in the tree; it + does not test for equality with the current min (or max) element. + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_element v = function + | Empty -> singleton v + | Node (l, x, r, h) -> + internal_bal (add_min_element v l) x r + +let rec add_max_element v = function + | Empty -> singleton v + | Node (l, x, r, h) -> + internal_bal l x (add_max_element v r) + +(** + Invariants: + 1. l < v < r + 2. l and r are balanced + + Proof by induction + The height of output will be ~~ (max (height l) (height r) + 2) + Also use the lemma from [bal] +*) +let rec internal_join l v r = + match (l, r) with + (Empty, _) -> add_min_element v r + | (_, Empty) -> add_max_element v l + | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) -> + if lh > rh + 2 then + (* proof by induction: + now [height of ll] is [lh - 1] + *) + internal_bal ll lv (internal_join lr v r) + else + if rh > lh + 2 then internal_bal (internal_join l v rl) rv rr + else create l v r + + +(* + Required Invariants: + [t1] < [t2] +*) +let internal_concat t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> internal_join t1 (min_elt t2) (remove_min_elt t2) + +let rec filter x p = match x with + | Empty -> Empty + | Node(l, v, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pv = p v in + let r' = filter r p in + if pv then internal_join l' v r' else internal_concat l' r' + + +let rec partition x p = match x with + | Empty -> (Empty, Empty) + | Node(l, v, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pv = p v in + let (rt, rf) = partition r p in + if pv + then (internal_join lt v rt, internal_concat lf rf) + else (internal_concat lt rt, internal_join lf v rf) + +let of_sorted_list l = + let rec sub n l = + match n, l with + | 0, l -> Empty, l + | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l + | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l + | 3, x0 :: x1 :: x2 :: l -> + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l + | n, l -> + let nl = n / 2 in + let left, l = sub nl l in + match l with + | [] -> assert false + | mid :: l -> + let right, l = sub (n - nl - 1) l in + create left mid right, l + in + fst (sub (List.length l) l) + +let of_sorted_array l = + let rec sub start n l = + if n = 0 then Empty else + if n = 1 then + let x0 = Array.unsafe_get l start in + Node (Empty, x0, Empty, 1) + else if n = 2 then + let x0 = Array.unsafe_get l start in + let x1 = Array.unsafe_get l (start + 1) in + Node (Node(Empty, x0, Empty, 1), x1, Empty, 2) else + if n = 3 then + let x0 = Array.unsafe_get l start in + let x1 = Array.unsafe_get l (start + 1) in + let x2 = Array.unsafe_get l (start + 2) in + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2) + else + let nl = n / 2 in + let left = sub start nl l in + let mid = start + nl in + let v = Array.unsafe_get l mid in + let right = sub (mid + 1) (n - nl - 1) l in + create left v right + in + sub 0 (Array.length l) l + +let is_ordered ~cmp tree = + let rec is_ordered_min_max tree = + match tree with + | Empty -> `Empty + | Node(l,v,r,_) -> + begin match is_ordered_min_max l with + | `No -> `No + | `Empty -> + begin match is_ordered_min_max r with + | `No -> `No + | `Empty -> `V (v,v) + | `V(l,r) -> + if cmp v l < 0 then + `V(v,r) + else + `No + end + | `V(min_v,max_v)-> + begin match is_ordered_min_max r with + | `No -> `No + | `Empty -> + if cmp max_v v < 0 then + `V(min_v,v) + else + `No + | `V(min_v_r, max_v_r) -> + if cmp max_v min_v_r < 0 then + `V(min_v,max_v_r) + else `No + end + end in + is_ordered_min_max tree <> `No + +let invariant ~cmp t = + check t ; + is_ordered ~cmp t + +let rec compare_aux ~cmp e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, r1, e1), More(v2, r2, e2)) -> + let c = cmp v1 v2 in + if c <> 0 + then c + else compare_aux ~cmp (cons_enum r1 e1) (cons_enum r2 e2) + +let compare ~cmp s1 s2 = + compare_aux ~cmp (cons_enum s1 End) (cons_enum s2 End) + + +module type S = sig + type elt + type t + val empty: t + val is_empty: t -> bool + val iter: t -> (elt -> unit) -> unit + val fold: t -> 'a -> (elt -> 'a -> 'a) -> 'a + val for_all: t -> (elt -> bool) -> bool + val exists: t -> (elt -> bool) -> bool + val singleton: elt -> t + val cardinal: t -> int + val elements: t -> elt list + val min_elt: t -> elt + val max_elt: t -> elt + val choose: t -> elt + val of_sorted_list : elt list -> t + val of_sorted_array : elt array -> t + val partition: t -> (elt -> bool) -> t * t + + val mem: t -> elt -> bool + val add: t -> elt -> t + val remove: t -> elt -> t + val union: t -> t -> t + val inter: t -> t -> t + val diff: t -> t -> t + val compare: t -> t -> int + val equal: t -> t -> bool + val subset: t -> t -> bool + val filter: t -> (elt -> bool) -> t + + val split: t -> elt -> t * bool * t + val find: t -> elt -> elt + val of_list: elt list -> t + val of_sorted_list : elt list -> t + val of_sorted_array : elt array -> t + val of_array : elt array -> t + val invariant : t -> bool + val print : Format.formatter -> t -> unit +end + +end +module Ext_int : sig +#1 "ext_int.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. *) + + +type t = int +val compare : t -> t -> int +val equal : t -> t -> bool + +end = struct +#1 "ext_int.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. *) + + +type t = int + +let compare (x : t) (y : t) = Pervasives.compare x y + +let equal (x : t) (y : t) = x = y + +end +module Set_int : sig +#1 "set_int.mli" + + +include Set_gen.S with type elt = int +end = struct +#1 "set_int.ml" +# 1 "ext/set.cppo.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. *) + + +# 42 "ext/set.cppo.ml" +type elt = int +let compare_elt = Ext_int.compare +let print_elt = Format.pp_print_int + +# 49 "ext/set.cppo.ml" +type ('a, 'id) t0 = ('a, 'id) Set_gen.t0 = + | Empty + | Node of ('a, 'id) t0 * 'a * ('a, 'id) t0 * int + +type ('a, 'id) enumeration0 = ('a, 'id) Set_gen.enumeration0 = + | End + | More of 'a * ('a, 'id) t0 * ('a, 'id) enumeration0 + +type t = (elt, unit) t0 +type enumeration = (elt, unit) Set_gen.enumeration0 +let empty = Set_gen.empty +let is_empty = Set_gen.is_empty +let iter = Set_gen.iter +let fold = Set_gen.fold +let for_all = Set_gen.for_all +let exists = Set_gen.exists +let singleton = Set_gen.singleton +let cardinal = Set_gen.cardinal +let elements = Set_gen.elements +let min_elt = Set_gen.min_elt +let max_elt = Set_gen.max_elt +let choose = Set_gen.choose +let of_sorted_list = Set_gen.of_sorted_list +let of_sorted_array = Set_gen.of_sorted_array +let partition = Set_gen.partition +let filter = Set_gen.filter +let of_sorted_list = Set_gen.of_sorted_list +let of_sorted_array = Set_gen.of_sorted_array + +let rec split (tree : t) x : t * bool * t = match tree with + | Empty -> + (Empty, false, Empty) + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then (l, true, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Set_gen.internal_join rl v r) + else + let (lr, pres, rr) = split r x in (Set_gen.internal_join l v lr, pres, rr) +let rec add (tree : t) x : t = match tree with + | Empty -> Node(Empty, x, Empty, 1) + | Node(l, v, r, _) as t -> + let c = compare_elt x v in + if c = 0 then t else + if c < 0 then Set_gen.internal_bal (add l x ) v r else Set_gen.internal_bal l v (add r x ) + +let rec union (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> t2 + | (t1, Empty) -> t1 + | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> + if h1 >= h2 then + if h2 = 1 then add s1 v2 else begin + let (l2, _, r2) = split s2 v1 in + Set_gen.internal_join (union l1 l2) v1 (union r1 r2) + end + else + if h1 = 1 then add s2 v1 else begin + let (l1, _, r1) = split s1 v2 in + Set_gen.internal_join (union l1 l2) v2 (union r1 r2) + end + +let rec inter (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> Empty + | (t1, Empty) -> Empty + | (Node(l1, v1, r1, _), t2) -> + begin match split t2 v1 with + | (l2, false, r2) -> + Set_gen.internal_concat (inter l1 l2) (inter r1 r2) + | (l2, true, r2) -> + Set_gen.internal_join (inter l1 l2) v1 (inter r1 r2) + end + +let rec diff (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> Empty + | (t1, Empty) -> t1 + | (Node(l1, v1, r1, _), t2) -> + begin match split t2 v1 with + | (l2, false, r2) -> + Set_gen.internal_join (diff l1 l2) v1 (diff r1 r2) + | (l2, true, r2) -> + Set_gen.internal_concat (diff l1 l2) (diff r1 r2) + end + + +let rec mem (tree : t) x = match tree with + | Empty -> false + | Node(l, v, r, _) -> + let c = compare_elt x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : t) x : t = match tree with + | Empty -> Empty + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then Set_gen.internal_merge l r else + if c < 0 then Set_gen.internal_bal (remove l x) v r else Set_gen.internal_bal l v (remove r x ) + +let compare s1 s2 = Set_gen.compare ~cmp:compare_elt s1 s2 + + +let equal s1 s2 = + compare s1 s2 = 0 + +let rec subset (s1 : t) (s2 : t) = + match (s1, s2) with + | Empty, _ -> + true + | _, Empty -> + false + | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) -> + let c = compare_elt v1 v2 in + if c = 0 then + subset l1 l2 && subset r1 r2 + else if c < 0 then + subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2 + else + subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2 + + + + +let rec find (tree : t) x = match tree with + | Empty -> raise Not_found + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then v + else find (if c < 0 then l else r) x + + + +let of_list l = + match l with + | [] -> empty + | [x0] -> singleton x0 + | [x0; x1] -> add (singleton x0) x1 + | [x0; x1; x2] -> add (add (singleton x0) x1) x2 + | [x0; x1; x2; x3] -> add (add (add (singleton x0) x1 ) x2 ) x3 + | [x0; x1; x2; x3; x4] -> add (add (add (add (singleton x0) x1) x2 ) x3 ) x4 + | _ -> of_sorted_list (List.sort_uniq compare_elt l) + +let of_array l = + Ext_array.fold_left l empty (fun acc x -> add acc x ) + +(* also check order *) +let invariant t = + Set_gen.check t ; + Set_gen.is_ordered ~cmp:compare_elt t + +let print fmt s = + Format.fprintf + fmt "@[{%a}@]@." + (fun fmt s -> + iter s + (fun e -> Format.fprintf fmt "@[%a@],@ " + print_elt e) + ) + s + + + + + + +end +module Ounit_bal_tree_tests += struct +#1 "ounit_bal_tree_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +module Set_poly = Set_int +let suites = + __FILE__ >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Set_poly.invariant + (Set_poly.of_array (Array.init 1000 (fun n -> n)))) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Set_poly.invariant + (Set_poly.of_array (Array.init 1000 (fun n -> 1000-n)))) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Set_poly.invariant + (Set_poly.of_array (Array.init 1000 (fun n -> Random.int 1000)))) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Set_poly.invariant + (Set_poly.of_sorted_list (Array.to_list (Array.init 1000 (fun n -> n))))) + end; + __LOC__ >:: begin fun _ -> + let arr = Array.init 1000 (fun n -> n) in + let set = (Set_poly.of_sorted_array arr) in + OUnit.assert_bool __LOC__ + (Set_poly.invariant set ); + OUnit.assert_equal 1000 (Set_poly.cardinal set) + end; + __LOC__ >:: begin fun _ -> + for i = 0 to 200 do + let arr = Array.init i (fun n -> n) in + let set = (Set_poly.of_sorted_array arr) in + OUnit.assert_bool __LOC__ + (Set_poly.invariant set ); + OUnit.assert_equal i (Set_poly.cardinal set) + done + end; + __LOC__ >:: begin fun _ -> + let arr_size = 200 in + let arr_sets = Array.make 200 Set_poly.empty in + for i = 0 to arr_size - 1 do + let size = Random.int 1000 in + let arr = Array.init size (fun n -> n) in + arr_sets.(i)<- (Set_poly.of_sorted_array arr) + done; + let large = Array.fold_left Set_poly.union Set_poly.empty arr_sets in + OUnit.assert_bool __LOC__ (Set_poly.invariant large) + end; + + __LOC__ >:: begin fun _ -> + let arr_size = 1_00_000 in + let v = ref Set_int.empty in + for i = 0 to arr_size - 1 do + let size = Random.int 0x3FFFFFFF in + v := Set_int.add !v size + done; + OUnit.assert_bool __LOC__ (Set_int.invariant !v) + end; + + ] + + +type ident = { stamp : int ; name : string ; mutable flags : int} + +module Ident_set = Set.Make(struct type t = ident + let compare = Pervasives.compare end) + +let compare_ident x y = + let a = compare (x.stamp : int) y.stamp in + if a <> 0 then a + else + let b = compare (x.name : string) y.name in + if b <> 0 then b + else compare (x.flags : int) y.flags + +let rec add x (tree : _ Set_gen.t0) : _ Set_gen.t0 = + match tree with + | Empty -> Node(Empty, x, Empty, 1) + | Node(l, v, r, _) as t -> + let c = compare_ident x v in + if c = 0 then t else + if c < 0 then Set_gen.internal_bal (add x l) v r else Set_gen.internal_bal l v (add x r) + +let rec mem x (tree : _ Set_gen.t0) = + match tree with + | Empty -> false + | Node(l, v, r, _) -> + let c = compare_ident x v in + c = 0 || mem x (if c < 0 then l else r) + +module Ident_set2 = Set.Make(struct type t = ident + let compare = compare_ident + end) + +let bench () = + let times = 1_000_000 in + Ounit_tests_util.time "functor set" begin fun _ -> + let v = ref Ident_set.empty in + for i = 0 to times do + v := Ident_set.add {stamp = i ; name = "name"; flags = -1 } !v + done; + for i = 0 to times do + ignore @@ Ident_set.mem {stamp = i; name = "name" ; flags = -1} !v + done + end ; + Ounit_tests_util.time "functor set (specialized)" begin fun _ -> + let v = ref Ident_set2.empty in + for i = 0 to times do + v := Ident_set2.add {stamp = i ; name = "name"; flags = -1 } !v + done; + for i = 0 to times do + ignore @@ Ident_set2.mem {stamp = i; name = "name" ; flags = -1} !v + done + end ; + + Ounit_tests_util.time "poly set" begin fun _ -> + let module Set_poly = Ident_set in + let v = ref Set_poly.empty in + for i = 0 to times do + v := Set_poly.add {stamp = i ; name = "name"; flags = -1 } !v + done; + for i = 0 to times do + ignore @@ Set_poly.mem {stamp = i; name = "name" ; flags = -1} !v + done; + end; + Ounit_tests_util.time "poly set (specialized)" begin fun _ -> + let v = ref Set_gen.empty in + for i = 0 to times do + v := add {stamp = i ; name = "name"; flags = -1 } !v + done; + for i = 0 to times do + ignore @@ mem {stamp = i; name = "name" ; flags = -1} !v + done + + end ; + +end +module Bs_version : sig +#1 "bs_version.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 version : string + +val header : string + +val package_name : string +end = struct +#1 "bs_version.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 version = "5.0.1" +let header = + "// Generated by BUCKLESCRIPT VERSION 5.0.1, PLEASE EDIT WITH CARE" +let package_name = "bs-platform" + +end +module Bsb_pkg_types : sig +#1 "bsb_pkg_types.mli" +(* Copyright (C) 2019- Authors of BuckleScript + * + * 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. *) + + +type t = + | Global of string + | Scope of string * scope +and scope = string + +val to_string : t -> string +val print : Format.formatter -> t -> unit +val equal : t -> t -> bool + +(* The second element could be empty or dropped +*) +val extract_pkg_name_and_file : string -> t * string +val string_as_package : string -> t +end = struct +#1 "bsb_pkg_types.ml" + +(* Copyright (C) 2018- Authors of BuckleScript + * + * 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 (//) = Filename.concat + +type t = + | Global of string + | Scope of string * scope +and scope = string + +let to_string (x : t) = + match x with + | Global s -> s + | Scope (s,scope) -> scope // s + +let print fmt (x : t) = + match x with + | Global s -> Format.pp_print_string fmt s + | Scope(name,scope) -> + Format.fprintf fmt "%s/%s" scope name + +let equal (x : t) y = + match x, y with + | Scope(a0,a1), Scope(b0,b1) + -> a0 = b0 && a1 = b1 + | Global a0, Global b0 -> a0 = b0 + | Scope _, Global _ + | Global _, Scope _ -> false + +(** + input: {[ + @hello/yy/xx + hello/yy + ]} + FIXME: fix invalid input + {[ + hello//xh//helo + ]} +*) +let extract_pkg_name_and_file (s : string) = + let len = String.length s in + assert (len > 0 ); + let v = String.unsafe_get s 0 in + if v = '@' then + let scope_id = + Ext_string.no_slash_idx s in + assert (scope_id > 0); + let pkg_id = + Ext_string.no_slash_idx_from + s (scope_id + 1) in + let scope = + String.sub s 0 scope_id in + + if pkg_id < 0 then + (Scope(String.sub s (scope_id + 1) (len - scope_id - 1), scope),"") + else + (Scope( + String.sub s (scope_id + 1) (pkg_id - scope_id - 1), scope), + String.sub s (pkg_id + 1) (len - pkg_id - 1)) + else + let pkg_id = Ext_string.no_slash_idx s in + if pkg_id < 0 then + Global s , "" + else + Global (String.sub s 0 pkg_id), + (String.sub s (pkg_id + 1) (len - pkg_id - 1)) + + +let string_as_package (s : string) : t = + let len = String.length s in + assert (len > 0); + let v = String.unsafe_get s 0 in + if v = '@' then + let scope_id = + Ext_string.no_slash_idx s in + assert (scope_id > 0); + Scope( + String.sub s (scope_id + 1) (len - scope_id - 1), + String.sub s 0 scope_id + ) + else Global s +end +module Ext_list : sig +#1 "ext_list.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 map : + 'a list -> + ('a -> 'b) -> + 'b list + +val has_string : + string list -> + string -> + bool +val map_split_opt : + 'a list -> + ('a -> 'b option * 'c option) -> + 'b list * 'c list + +val mapi : + 'a list -> + (int -> 'a -> 'b) -> + 'b list + +val map_snd : ('a * 'b) list -> ('b -> 'c) -> ('a * 'c) list + +(** [map_last f xs ] + will pass [true] to [f] for the last element, + [false] otherwise. + For empty list, it returns empty +*) +val map_last : + 'a list -> + (bool -> 'a -> 'b) -> 'b list + +(** [last l] + return the last element + raise if the list is empty +*) +val last : 'a list -> 'a + +val append : + 'a list -> + 'a list -> + 'a list + +val append_one : + 'a list -> + 'a -> + 'a list + +val map_append : + 'b list -> + 'a list -> + ('b -> 'a) -> + 'a list + +val fold_right : + 'a list -> + 'b -> + ('a -> 'b -> 'b) -> + 'b + +val fold_right2 : + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) -> 'c + +val map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c) -> + 'c list + +val fold_left_with_offset : + 'a list -> + 'acc -> + int -> + ('a -> 'acc -> int -> 'acc) -> + 'acc + + +(** @unused *) +val filter_map : + 'a list -> + ('a -> 'b option) -> + 'b list + +(** [exclude p l] is the opposite of [filter p l] *) +val exclude : + 'a list -> + ('a -> bool) -> + 'a list + +(** [excludes p l] + return a tuple [excluded,newl] + where [exluded] is true indicates that at least one + element is removed,[newl] is the new list where all [p x] for [x] is false + +*) +val exclude_with_val : + 'a list -> + ('a -> bool) -> + 'a list option + + +val same_length : 'a list -> 'b list -> bool + +val init : int -> (int -> 'a) -> 'a list + +(** [split_at n l] + will split [l] into two lists [a,b], [a] will be of length [n], + otherwise, it will raise +*) +val split_at : + 'a list -> + int -> + 'a list * 'a list + + +(** [split_at_last l] + It is equivalent to [split_at (List.length l - 1) l ] +*) +val split_at_last : 'a list -> 'a list * 'a + +val filter_mapi : + 'a list -> + ('a -> int -> 'b option) -> + 'b list + +val filter_map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c option) -> + 'c list + + +val length_compare : 'a list -> int -> [`Gt | `Eq | `Lt ] + +val length_ge : 'a list -> int -> bool + +(** + + {[length xs = length ys + n ]} + input n should be positive + TODO: input checking +*) + +val length_larger_than_n : + 'a list -> + 'a list -> + int -> + bool + + +(** + [rev_map_append f l1 l2] + [map f l1] and reverse it to append [l2] + This weird semantics is due to it is the most efficient operation + we can do +*) +val rev_map_append : + 'a list -> + 'b list -> + ('a -> 'b) -> + 'b list + + +val flat_map : + 'a list -> + ('a -> 'b list) -> + 'b list + +val flat_map_append : + 'a list -> + 'b list -> + ('a -> 'b list) -> + 'b list + + +(** + [stable_group eq lst] + Example: + Input: + {[ + stable_group (=) [1;2;3;4;3] + ]} + Output: + {[ + [[1];[2];[4];[3;3]] + ]} + TODO: this is O(n^2) behavior + which could be improved later +*) +val stable_group : + 'a list -> + ('a -> 'a -> bool) -> + 'a list list + +(** [drop n list] + raise when [n] is negative + raise when list's length is less than [n] +*) +val drop : + 'a list -> + int -> + 'a list + +val find_first : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_first_not p lst ] + if all elements in [lst] pass, return [None] + otherwise return the first element [e] as [Some e] which + fails the predicate +*) +val find_first_not : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_opt f l] returns [None] if all return [None], + otherwise returns the first one. +*) + +val find_opt : + 'a list -> + ('a -> 'b option) -> + 'b option + + +val rev_iter : + 'a list -> + ('a -> unit) -> + unit + +val iter: + 'a list -> + ('a -> unit) -> + unit + +val for_all: + 'a list -> + ('a -> bool) -> + bool +val for_all_snd: + ('a * 'b) list -> + ('b -> bool) -> + bool + +(** [for_all2_no_exn p xs ys] + return [true] if all satisfied, + [false] otherwise or length not equal +*) +val for_all2_no_exn : + 'a list -> + 'b list -> + ('a -> 'b -> bool) -> + bool + + + +(** [f] is applied follow the list order *) +val split_map : + 'a list -> + ('a -> 'b * 'c) -> + 'b list * 'c list + +(** [fn] is applied from left to right *) +val reduce_from_left : + 'a list -> + ('a -> 'a -> 'a) -> + 'a + +val sort_via_array : + 'a list -> + ('a -> 'a -> int) -> + 'a list + + + + +(** [assoc_by_string default key lst] + if [key] is found in the list return that val, + other unbox the [default], + otherwise [assert false ] +*) +val assoc_by_string : + (string * 'a) list -> + string -> + 'a option -> + 'a + +val assoc_by_int : + (int * 'a) list -> + int -> + 'a option -> + 'a + + +val nth_opt : 'a list -> int -> 'a option + +val iter_snd : ('a * 'b) list -> ('b -> unit) -> unit + +val iter_fst : ('a * 'b) list -> ('a -> unit) -> unit + +val exists : 'a list -> ('a -> bool) -> bool +val exists_snd : ('a * 'b) list -> ('b -> bool) -> bool + +val concat_append: + 'a list list -> + 'a list -> + 'a list + +val fold_left2: + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) + -> 'c + +val fold_left: + 'a list -> + 'b -> + ('b -> 'a -> 'b) -> + 'b + +val singleton_exn: + 'a list -> 'a +end = struct +#1 "ext_list.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 rec map l f = + match l with + | [] -> + [] + | [x1] -> + let y1 = f x1 in + [y1] + | [x1; x2] -> + let y1 = f x1 in + let y2 = f x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::x5::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + y1::y2::y3::y4::y5::(map tail f) + +let rec has_string l f = + match l with + | [] -> + false + | [x1] -> + x1 = f + | [x1; x2] -> + x1 = f || x2 = f + | [x1; x2; x3] -> + x1 = f || x2 = f || x3 = f + | x1 :: x2 :: x3 :: x4 -> + x1 = f || x2 = f || x3 = f || has_string x4 f + + +let rec map_split_opt + (xs : 'a list) (f : 'a -> 'b option * 'c option) + : 'b list * 'c list = + match xs with + | [] -> [], [] + | x::xs -> + let c,d = f x in + let cs,ds = map_split_opt xs f in + (match c with Some c -> c::cs | None -> cs), + (match d with Some d -> d::ds | None -> ds) + +let rec map_snd l f = + match l with + | [] -> + [] + | [ v1,x1 ] -> + let y1 = f x1 in + [v1,y1] + | [v1, x1; v2, x2] -> + let y1 = f x1 in + let y2 = f x2 in + [v1, y1; v2, y2] + | [ v1, x1; v2, x2; v3, x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [v1, y1; v2, y2; v3, y3] + | [ v1, x1; v2, x2; v3, x3; v4, x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [v1, y1; v2, y2; v3, y3; v4, y4] + | (v1, x1) ::(v2, x2) :: (v3, x3)::(v4, x4) :: (v5, x5) ::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + (v1, y1)::(v2, y2) :: (v3, y3) :: (v4, y4) :: (v5, y5) :: (map_snd tail f) + + +let rec map_last l f= + match l with + | [] -> + [] + | [x1] -> + let y1 = f true x1 in + [y1] + | [x1; x2] -> + let y1 = f false x1 in + let y2 = f true x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f true x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f true x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::tail -> + (* make sure that tail is not empty *) + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f false x4 in + y1::y2::y3::y4::(map_last tail f) + +let rec mapi_aux lst i f = + match lst with + [] -> [] + | a::l -> + let r = f i a in r :: mapi_aux l (i + 1) f + +let mapi lst f = mapi_aux lst 0 f + +let rec last xs = + match xs with + | [x] -> x + | _ :: tl -> last tl + | [] -> invalid_arg "Ext_list.last" + + + +let rec append_aux l1 l2 = + match l1 with + | [] -> l2 + | [a0] -> a0::l2 + | [a0;a1] -> a0::a1::l2 + | [a0;a1;a2] -> a0::a1::a2::l2 + | [a0;a1;a2;a3] -> a0::a1::a2::a3::l2 + | [a0;a1;a2;a3;a4] -> a0::a1::a2::a3::a4::l2 + | a0::a1::a2::a3::a4::rest -> a0::a1::a2::a3::a4::append_aux rest l2 + +let append l1 l2 = + match l2 with + | [] -> l1 + | _ -> append_aux l1 l2 + +let append_one l1 x = append_aux l1 [x] + +let rec map_append l1 l2 f = + match l1 with + | [] -> l2 + | [a0] -> f a0::l2 + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + b0::b1::l2 + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + b0::b1::b2::l2 + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + b0::b1::b2::b3::l2 + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::l2 + + | a0::a1::a2::a3::a4::rest -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::map_append rest l2 f + + + +let rec fold_right l acc f = + match l with + | [] -> acc + | [a0] -> f a0 acc + | [a0;a1] -> f a0 (f a1 acc) + | [a0;a1;a2] -> f a0 (f a1 (f a2 acc)) + | [a0;a1;a2;a3] -> f a0 (f a1 (f a2 (f a3 acc))) + | [a0;a1;a2;a3;a4] -> + f a0 (f a1 (f a2 (f a3 (f a4 acc)))) + | a0::a1::a2::a3::a4::rest -> + f a0 (f a1 (f a2 (f a3 (f a4 (fold_right rest acc f ))))) + +let rec fold_right2 l r acc f = + match l,r with + | [],[] -> acc + | [a0],[b0] -> f a0 b0 acc + | [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc) + | [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc)) + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc))) + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc)))) + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f ))))) + | _, _ -> invalid_arg "Ext_list.fold_right2" + +let rec map2 l r f = + match l,r with + | [],[] -> [] + | [a0],[b0] -> [f a0 b0] + | [a0;a1],[b0;b1] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + [c0; c1] + | [a0;a1;a2],[b0;b1;b2] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + [c0;c1;c2] + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + [c0;c1;c2;c3] + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + [c0;c1;c2;c3;c4] + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + c0::c1::c2::c3::c4::map2 arest brest f + | _, _ -> invalid_arg "Ext_list.map2" + +let rec fold_left_with_offset l accu i f = + match l with + | [] -> accu + | a::l -> + fold_left_with_offset + l + (f a accu i) + (i + 1) + f + + +let rec filter_map xs (f: 'a -> 'b option)= + match xs with + | [] -> [] + | y :: ys -> + begin match f y with + | None -> filter_map ys f + | Some z -> z :: filter_map ys f + end + +let rec exclude (xs : 'a list) (p : 'a -> bool) : 'a list = + match xs with + | [] -> [] + | x::xs -> + if p x then exclude xs p + else x:: exclude xs p + +let rec exclude_with_val l p = + match l with + | [] -> None + | a0::xs -> + if p a0 then Some (exclude xs p) + else + match xs with + | [] -> None + | a1::rest -> + if p a1 then + Some (a0:: exclude rest p) + else + match exclude_with_val rest p with + | None -> None + | Some rest -> Some (a0::a1::rest) + + + +let rec same_length xs ys = + match xs, ys with + | [], [] -> true + | _::xs, _::ys -> same_length xs ys + | _, _ -> false + + +let init n f = + match n with + | 0 -> [] + | 1 -> + let a0 = f 0 in + [a0] + | 2 -> + let a0 = f 0 in + let a1 = f 1 in + [a0; a1] + | 3 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + [a0; a1; a2] + | 4 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + [a0; a1; a2; a3] + | 5 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + let a4 = f 4 in + [a0; a1; a2; a3; a4] + | _ -> + Array.to_list (Array.init n f) + +let rec small_split_at n acc l = + if n <= 0 then List.rev acc , l + else + match l with + | x::xs -> small_split_at (n - 1) (x ::acc) xs + | _ -> invalid_arg "Ext_list.split_at" + +let split_at l n = + small_split_at n [] l + +let rec split_at_last_aux acc x = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [ x] -> List.rev acc, x + | y0::ys -> split_at_last_aux (y0::acc) ys + +let split_at_last (x : 'a list) = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [a0] -> + [], a0 + | [a0;a1] -> + [a0], a1 + | [a0;a1;a2] -> + [a0;a1], a2 + | [a0;a1;a2;a3] -> + [a0;a1;a2], a3 + | [a0;a1;a2;a3;a4] -> + [a0;a1;a2;a3], a4 + | a0::a1::a2::a3::a4::rest -> + let rev, last = split_at_last_aux [] rest + in + a0::a1::a2::a3::a4:: rev , last + +(** + can not do loop unroll due to state combination +*) +let filter_mapi xs f = + let rec aux i xs = + match xs with + | [] -> [] + | y :: ys -> + begin match f y i with + | None -> aux (i + 1) ys + | Some z -> z :: aux (i + 1) ys + end in + aux 0 xs + +let rec filter_map2 xs ys (f: 'a -> 'b -> 'c option) = + match xs,ys with + | [],[] -> [] + | u::us, v :: vs -> + begin match f u v with + | None -> filter_map2 us vs f (* idea: rec f us vs instead? *) + | Some z -> z :: filter_map2 us vs f + end + | _ -> invalid_arg "Ext_list.filter_map2" + + +let rec rev_map_append l1 l2 f = + match l1 with + | [] -> l2 + | a :: l -> rev_map_append l (f a :: l2) f + + +let rec rev_append l1 l2 = + match l1 with + [] -> l2 + | a :: l -> rev_append l (a :: l2) + +(** It is not worth loop unrolling, + it is already tail-call, and we need to be careful + about evaluation order when unroll +*) +let rec flat_map_aux f acc append lx = + match lx with + | [] -> rev_append acc append + | a0::rest -> flat_map_aux f (rev_append (f a0) acc ) append rest + +let flat_map lx f = + flat_map_aux f [] [] lx + +let flat_map_append lx append f = + flat_map_aux f [] append lx + + +let rec length_compare l n = + if n < 0 then `Gt + else + begin match l with + | _ ::xs -> length_compare xs (n - 1) + | [] -> + if n = 0 then `Eq + else `Lt + end + +let rec length_ge l n = + if n > 0 then + match l with + | _ :: tl -> length_ge tl (n - 1) + | [] -> false + else true +(** + + {[length xs = length ys + n ]} +*) +let rec length_larger_than_n xs ys n = + match xs, ys with + | _, [] -> length_compare xs n = `Eq + | _::xs, _::ys -> + length_larger_than_n xs ys n + | [], _ -> false + + + + +let rec group (eq : 'a -> 'a -> bool) lst = + match lst with + | [] -> [] + | x::xs -> + aux eq x (group eq xs ) + +and aux eq (x : 'a) (xss : 'a list list) : 'a list list = + match xss with + | [] -> [[x]] + | (y0::_ as y)::ys -> (* cannot be empty *) + if eq x y0 then + (x::y) :: ys + else + y :: aux eq x ys + | _ :: _ -> assert false + +let stable_group lst eq = group eq lst |> List.rev + +let rec drop h n = + if n < 0 then invalid_arg "Ext_list.drop" + else + if n = 0 then h + else + match h with + | [] -> + invalid_arg "Ext_list.drop" + | _ :: tl -> + drop tl (n - 1) + +let rec find_first x p = + match x with + | [] -> None + | x :: l -> + if p x then Some x + else find_first l p + +let rec find_first_not xs p = + match xs with + | [] -> None + | a::l -> + if p a + then find_first_not l p + else Some a + + +let rec rev_iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x2 ; f x1 + | [x1; x2; x3] -> + f x3 ; f x2 ; f x1 + | [x1; x2; x3; x4] -> + f x4; f x3; f x2; f x1 + | x1::x2::x3::x4::x5::tail -> + rev_iter tail f; + f x5; f x4 ; f x3; f x2 ; f x1 + +let rec iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x1 ; f x2 + | [x1; x2; x3] -> + f x1 ; f x2 ; f x3 + | [x1; x2; x3; x4] -> + f x1; f x2; f x3; f x4 + | x1::x2::x3::x4::x5::tail -> + f x1; f x2 ; f x3; f x4 ; f x5; + iter tail f + + +let rec for_all lst p = + match lst with + [] -> true + | a::l -> p a && for_all l p + +let rec for_all_snd lst p = + match lst with + [] -> true + | (_,a)::l -> p a && for_all_snd l p + + +let rec for_all2_no_exn l1 l2 p = + match (l1, l2) with + | ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_no_exn l1 l2 p + | (_, _) -> false + + +let rec find_opt xs p = + match xs with + | [] -> None + | x :: l -> + match p x with + | Some _ as v -> v + | None -> find_opt l p + + + +let rec split_map l f = + match l with + | [] -> + [],[] + | [x1] -> + let a0,b0 = f x1 in + [a0],[b0] + | [x1; x2] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + [a1;a2],[b1;b2] + | [x1; x2; x3] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + [a1;a2;a3], [b1;b2;b3] + | [x1; x2; x3; x4] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + [a1;a2;a3;a4], [b1;b2;b3;b4] + | x1::x2::x3::x4::x5::tail -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + let a5,b5 = f x5 in + let ass,bss = split_map tail f in + a1::a2::a3::a4::a5::ass, + b1::b2::b3::b4::b5::bss + + + + +let sort_via_array lst cmp = + let arr = Array.of_list lst in + Array.sort cmp arr; + Array.to_list arr + + + + +let rec assoc_by_string lst (k : string) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if Ext_string.equal k1 k then v1 else + assoc_by_string rest k def + +let rec assoc_by_int lst (k : int) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if k1 = k then v1 else + assoc_by_int rest k def + + +let rec nth_aux l n = + match l with + | [] -> None + | a::l -> if n = 0 then Some a else nth_aux l (n-1) + +let nth_opt l n = + if n < 0 then None + else + nth_aux l n + +let rec iter_snd lst f = + match lst with + | [] -> () + | (_,x)::xs -> + f x ; + iter_snd xs f + +let rec iter_fst lst f = + match lst with + | [] -> () + | (x,_)::xs -> + f x ; + iter_fst xs f + +let rec exists l p = + match l with + [] -> false + | x :: xs -> p x || exists xs p + +let rec exists_snd l p = + match l with + [] -> false + | (_, a)::l -> p a || exists_snd l p + +let rec concat_append + (xss : 'a list list) + (xs : 'a list) : 'a list = + match xss with + | [] -> xs + | l::r -> append l (concat_append r xs) + +let rec fold_left l accu f = + match l with + [] -> accu + | a::l -> fold_left l (f accu a) f + +let reduce_from_left lst fn = + match lst with + | first :: rest -> fold_left rest first fn + | _ -> invalid_arg "Ext_list.reduce_from_left" + +let rec fold_left2 l1 l2 accu f = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> fold_left2 l1 l2 (f a1 a2 accu) f + | (_, _) -> invalid_arg "List.fold_left2" + +let singleton_exn xs = match xs with [x] -> x | _ -> assert false + + +end +module Map_gen += struct +#1 "map_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. *) +(* *) +(***********************************************************************) +(** adapted from stdlib *) + +type ('key,'a) t = + | Empty + | Node of ('key,'a) t * 'key * 'a * ('key,'a) t * int + +type ('key,'a) enumeration = + | End + | More of 'key * 'a * ('key,'a) t * ('key, 'a) enumeration + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec bindings_aux accu = function + | Empty -> accu + | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l + +let bindings s = + bindings_aux [] s + + +let rec fill_array_aux (s : _ t) i arr : int = + match s with + | Empty -> i + | Node (l,k,v,r,_) -> + let inext = fill_array_aux l i arr in + Array.unsafe_set arr inext (k,v); + fill_array_aux r (inext + 1) arr + +let to_sorted_array (s : ('key,'a) t) : ('key * 'a ) array = + match s with + | Empty -> [||] + | Node(l,k,v,r,_) -> + let len = + cardinal_aux (cardinal_aux 1 r) l in + let arr = + Array.make len (k,v) in + ignore (fill_array_aux s 0 arr : int); + arr +let rec keys_aux accu = function + Empty -> accu + | Node(l, v, _, r, _) -> keys_aux (v :: keys_aux accu r) l + +let keys s = keys_aux [] s + + + +let rec cons_enum m e = + match m with + Empty -> e + | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e)) + + +let height = function + | Empty -> 0 + | Node(_,_,_,_,h) -> h + +let create l x d r = + let hl = height l and hr = height r in + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let singleton x d = Node(Empty, x, d, Empty, 1) + +let bal l x d r = + let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> invalid_arg "Map.bal" + | Node(ll, lv, ld, lr, _) -> + if height ll >= height lr then + create ll lv ld (create lr x d r) + else begin + match lr with + Empty -> invalid_arg "Map.bal" + | Node(lrl, lrv, lrd, lrr, _)-> + create (create ll lv ld lrl) lrv lrd (create lrr x d r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> invalid_arg "Map.bal" + | Node(rl, rv, rd, rr, _) -> + if height rr >= height rl then + create (create l x d rl) rv rd rr + else begin + match rl with + Empty -> invalid_arg "Map.bal" + | Node(rll, rlv, rld, rlr, _) -> + create (create l x d rll) rlv rld (create rlr rv rd rr) + end + end else + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec min_binding_exn = function + Empty -> raise Not_found + | Node(Empty, x, d, r, _) -> (x, d) + | Node(l, x, d, r, _) -> min_binding_exn l + +let choose = min_binding_exn + +let rec max_binding_exn = function + Empty -> raise Not_found + | Node(l, x, d, Empty, _) -> (x, d) + | Node(l, x, d, r, _) -> max_binding_exn r + +let rec remove_min_binding = function + Empty -> invalid_arg "Map.remove_min_elt" + | Node(Empty, x, d, r, _) -> r + | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r + +let merge t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + bal t1 x d (remove_min_binding t2) + + +let rec iter x f = match x with + Empty -> () + | Node(l, v, d, r, _) -> + iter l f; f v d; iter r f + +let rec map x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = map l f in + let d' = f d in + let r' = map r f in + Node(l', v, d', r', h) + +let rec mapi x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = mapi l f in + let d' = f v d in + let r' = mapi r f in + Node(l', v, d', r', h) + +let rec fold m accu f = + match m with + Empty -> accu + | Node(l, v, d, r, _) -> + fold r (f v d (fold l accu f)) f + +let rec for_all x p = match x with + Empty -> true + | Node(l, v, d, r, _) -> p v d && for_all l p && for_all r p + +let rec exists x p = match x with + Empty -> false + | Node(l, v, d, r, _) -> p v d || exists l p || exists r p + +(* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal (add_min_binding k v l) x d r + +let rec add_max_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal l x d (add_max_binding k v r) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v d r = + match (l, r) with + (Empty, _) -> add_min_binding v d r + | (_, Empty) -> add_max_binding v d l + | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) -> + if lh > rh + 2 then bal ll lv ld (join lr v d r) else + if rh > lh + 2 then bal (join l v d rl) rv rd rr else + create l v d r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + join t1 x d (remove_min_binding t2) + +let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + +let rec filter x p = match x with + Empty -> Empty + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pvd = p v d in + let r' = filter r p in + if pvd then join l' v d r' else concat l' r' + +let rec partition x p = match x with + Empty -> (Empty, Empty) + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pvd = p v d in + let (rt, rf) = partition r p in + if pvd + then (join lt v d rt, concat lf rf) + else (concat lt rt, join lf v d rf) + +let compare compare_key cmp_val m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + let c = compare_key v1 v2 in + if c <> 0 then c else + let c = cmp_val d1 d2 in + if c <> 0 then c else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in compare_aux (cons_enum m1 End) (cons_enum m2 End) + +let equal compare_key cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + compare_key v1 v2 = 0 && cmp d1 d2 && + equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in equal_aux (cons_enum m1 End) (cons_enum m2 End) + + + + +module type S = + sig + type key + type +'a t + val empty: 'a t + val compare_key: key -> key -> int + val is_empty: 'a t -> bool + val mem: 'a t -> key -> bool + val to_sorted_array : + 'a t -> (key * 'a ) array + val add: 'a t -> key -> 'a -> 'a t + (** [add x y m] + If [x] was already bound in [m], its previous binding disappears. *) + val adjust: 'a t -> key -> ('a option-> 'a) -> 'a t + (** [adjust acc k replace ] if not exist [add (replace None ], otherwise + [add k v (replace (Some old))] + *) + val singleton: key -> 'a -> 'a t + + val remove: 'a t -> key -> 'a t + (** [remove x m] returns a map containing the same bindings as + [m], except for [x] which is unbound in the returned map. *) + + val merge: + 'a t -> 'b t -> + (key -> 'a option -> 'b option -> 'c option) -> 'c t + (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + and of [m2]. The presence of each such binding, and the corresponding + value, is determined with the function [f]. + @since 3.12.0 + *) + + val disjoint_merge : 'a t -> 'a t -> 'a t + (* merge two maps, will raise if they have the same key *) + val compare: 'a t -> 'a t -> ('a -> 'a -> int) -> int + (** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. *) + + val equal: 'a t -> 'a t -> ('a -> 'a -> bool) -> bool + + val iter: 'a t -> (key -> 'a -> unit) -> unit + (** [iter f m] applies [f] to all bindings in map [m]. + The bindings are passed to [f] in increasing order. *) + + val fold: 'a t -> 'b -> (key -> 'a -> 'b -> 'b) -> 'b + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1 ... kN] are the keys of all bindings in [m] + (in increasing order) *) + + val for_all: 'a t -> (key -> 'a -> bool) -> bool + (** [for_all p m] checks if all the bindings of the map. + order unspecified + *) + + val exists: 'a t -> (key -> 'a -> bool) -> bool + (** [exists p m] checks if at least one binding of the map + satisfy the predicate [p]. + order unspecified + *) + + val filter: 'a t -> (key -> 'a -> bool) -> 'a t + (** [filter p m] returns the map with all the bindings in [m] + that satisfy predicate [p]. + order unspecified + *) + + val partition: 'a t -> (key -> 'a -> bool) -> 'a t * 'a t + (** [partition p m] returns a pair of maps [(m1, m2)], where + [m1] contains all the bindings of [s] that satisfy the + predicate [p], and [m2] is the map with all the bindings of + [s] that do not satisfy [p]. + *) + + val cardinal: 'a t -> int + (** Return the number of bindings of a map. *) + + val bindings: 'a t -> (key * 'a) list + (** Return the list of all bindings of the given map. + The returned list is sorted in increasing order with respect + to the ordering *) + val keys : 'a t -> key list + (* Increasing order *) + + val min_binding_exn: 'a t -> (key * 'a) + (** raise [Not_found] if the map is empty. *) + + val max_binding_exn: 'a t -> (key * 'a) + (** Same as {!Map.S.min_binding} *) + + val choose: 'a t -> (key * 'a) + (** Return one binding of the given map, or raise [Not_found] if + the map is empty. Which binding is chosen is unspecified, + but equal bindings will be chosen for equal maps. + *) + + val split: 'a t -> key -> 'a t * 'a option * 'a t + (** [split x m] returns a triple [(l, data, r)], where + [l] is the map with all the bindings of [m] whose key + is strictly less than [x]; + [r] is the map with all the bindings of [m] whose key + is strictly greater than [x]; + [data] is [None] if [m] contains no binding for [x], + or [Some v] if [m] binds [v] to [x]. + @since 3.12.0 + *) + + val find_exn: 'a t -> key -> 'a + (** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. *) + val find_opt: 'a t -> key ->'a option + val find_default: 'a t -> key -> 'a -> 'a + val map: 'a t -> ('a -> 'b) -> 'b t + (** [map f m] returns a map with same domain as [m], where the + associated value [a] of all bindings of [m] has been + replaced by the result of the application of [f] to [a]. + The bindings are passed to [f] in increasing order + with respect to the ordering over the type of the keys. *) + + val mapi: 'a t -> (key -> 'a -> 'b) -> 'b t + (** Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. *) + + val of_list : (key * 'a) list -> 'a t + val of_array : (key * 'a ) array -> 'a t + val add_list : (key * 'b) list -> 'b t -> 'b t + + end + +end +module String_map : sig +#1 "string_map.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 Map_gen.S with type key = string + +end = struct +#1 "string_map.ml" + +# 2 "ext/map.cppo.ml" +(* we don't create [map_poly], since some operations require raise an exception which carries [key] *) + + + +# 10 "ext/map.cppo.ml" + type key = string + let compare_key = Ext_string.compare + +# 22 "ext/map.cppo.ml" +type 'a t = (key,'a) Map_gen.t +exception Duplicate_key of key + +let empty = Map_gen.empty +let is_empty = Map_gen.is_empty +let iter = Map_gen.iter +let fold = Map_gen.fold +let for_all = Map_gen.for_all +let exists = Map_gen.exists +let singleton = Map_gen.singleton +let cardinal = Map_gen.cardinal +let bindings = Map_gen.bindings +let to_sorted_array = Map_gen.to_sorted_array +let keys = Map_gen.keys +let choose = Map_gen.choose +let partition = Map_gen.partition +let filter = Map_gen.filter +let map = Map_gen.map +let mapi = Map_gen.mapi +let bal = Map_gen.bal +let height = Map_gen.height +let max_binding_exn = Map_gen.max_binding_exn +let min_binding_exn = Map_gen.min_binding_exn + + +let rec add (tree : _ Map_gen.t as 'a) x data : 'a = match tree with + | Empty -> + Node(Empty, x, data, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, data, r, h) + else if c < 0 then + bal (add l x data ) v d r + else + bal l v d (add r x data ) + + +let rec adjust (tree : _ Map_gen.t as 'a) x replace : 'a = + match tree with + | Empty -> + Node(Empty, x, replace None, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, replace (Some d) , r, h) + else if c < 0 then + bal (adjust l x replace ) v d r + else + bal l v d (adjust r x replace ) + + +let rec find_exn (tree : _ Map_gen.t ) x = match tree with + | Empty -> + raise Not_found + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_exn (if c < 0 then l else r) x + +let rec find_opt (tree : _ Map_gen.t ) x = match tree with + | Empty -> None + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then Some d + else find_opt (if c < 0 then l else r) x + +let rec find_default (tree : _ Map_gen.t ) x default = match tree with + | Empty -> default + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_default (if c < 0 then l else r) x default + +let rec mem (tree : _ Map_gen.t ) x= match tree with + | Empty -> + false + | Node(l, v, d, r, _) -> + let c = compare_key x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : _ Map_gen.t as 'a) x : 'a = match tree with + | Empty -> + Empty + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Map_gen.merge l r + else if c < 0 then + bal (remove l x) v d r + else + bal l v d (remove r x ) + + +let rec split (tree : _ Map_gen.t as 'a) x : 'a * _ option * 'a = match tree with + | Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Map_gen.join rl v d r) + else + let (lr, pres, rr) = split r x in (Map_gen.join l v d lr, pres, rr) + +let rec merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) f : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split s2 v1 in + Map_gen.concat_or_join (merge l1 l2 f) v1 (f v1 (Some d1) d2) (merge r1 r2 f) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split s1 v2 in + Map_gen.concat_or_join (merge l1 l2 f) v2 (f v2 d1 (Some d2)) (merge r1 r2 f) + | _ -> + assert false + +let rec disjoint_merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + begin match split s2 v1 with + | l2, None, r2 -> + Map_gen.join (disjoint_merge l1 l2) v1 d1 (disjoint_merge r1 r2) + | _, Some _, _ -> + raise (Duplicate_key v1) + end + | (_, Node (l2, v2, d2, r2, h2)) -> + begin match split s1 v2 with + | (l1, None, r1) -> + Map_gen.join (disjoint_merge l1 l2) v2 d2 (disjoint_merge r1 r2) + | (_, Some _, _) -> + raise (Duplicate_key v2) + end + | _ -> + assert false + + + +let compare m1 m2 cmp = Map_gen.compare compare_key cmp m1 m2 + +let equal m1 m2 cmp = Map_gen.equal compare_key cmp m1 m2 + +let add_list (xs : _ list ) init = + Ext_list.fold_left xs init (fun acc (k,v) -> add acc k v ) + +let of_list xs = add_list xs empty + +let of_array xs = + Ext_array.fold_left xs empty (fun acc (k,v) -> add acc k v ) + +end +module Ext_json_types += struct +#1 "ext_json_types.ml" +(* Copyright (C) 2015-2017 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. *) + +type loc = Lexing.position +type json_str = + { str : string ; loc : loc} + +type json_flo = + { flo : string ; loc : loc} +type json_array = + { content : t array ; + loc_start : loc ; + loc_end : loc ; + } + +and json_map = + { map : t String_map.t ; loc : loc } +and t = + | True of loc + | False of loc + | Null of loc + | Flo of json_flo + | Str of json_str + | Arr of json_array + | Obj of json_map + + +end +module Ext_position : sig +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +(** [offset pos newpos] + return a new position + here [newpos] is zero based, the use case is that + at position [pos], we get a string and Lexing from that string, + therefore, we get a [newpos] and we need rebase it on top of + [pos] +*) +val offset : t -> t -> t + +val lexbuf_from_channel_with_fname: + in_channel -> string -> + Lexing.lexbuf + +val print : Format.formatter -> t -> unit +end = struct +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +let offset (x : t) (y:t) = + { + x with + pos_lnum = + x.pos_lnum + y.pos_lnum - 1; + pos_cnum = + x.pos_cnum + y.pos_cnum; + pos_bol = + if y.pos_lnum = 1 then + x.pos_bol + else x.pos_cnum + y.pos_bol + } + +let print fmt (pos : t) = + Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) + + + +let lexbuf_from_channel_with_fname ic fname = + let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in + let pos : t = { + pos_fname = fname ; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0 (* copied from zero_pos*) + } in + x.lex_start_p <- pos; + x.lex_curr_p <- pos ; + x + + +end +module Ext_json : sig +#1 "ext_json.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. *) + + +type path = string list +type status = + | No_path + | Found of Ext_json_types.t + | Wrong_type of path + + +type callback = + [ + `Str of (string -> unit) + | `Str_loc of (string -> Lexing.position -> unit) + | `Flo of (string -> unit ) + | `Flo_loc of (string -> Lexing.position -> unit ) + | `Bool of (bool -> unit ) + | `Obj of (Ext_json_types.t String_map.t -> unit) + | `Arr of (Ext_json_types.t array -> unit ) + | `Arr_loc of + (Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit) + | `Null of (unit -> unit) + | `Not_found of (unit -> unit) + | `Id of (Ext_json_types.t -> unit ) + ] + +val test: + ?fail:(unit -> unit) -> + string -> callback + -> Ext_json_types.t String_map.t + -> Ext_json_types.t String_map.t + +val query : path -> Ext_json_types.t -> status + +val loc_of : Ext_json_types.t -> Ext_position.t + +val equal : Ext_json_types.t -> Ext_json_types.t -> bool + +end = struct +#1 "ext_json.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. *) + +type callback = + [ + `Str of (string -> unit) + | `Str_loc of (string -> Lexing.position -> unit) + | `Flo of (string -> unit ) + | `Flo_loc of (string -> Lexing.position -> unit ) + | `Bool of (bool -> unit ) + | `Obj of (Ext_json_types.t String_map.t -> unit) + | `Arr of (Ext_json_types.t array -> unit ) + | `Arr_loc of (Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit) + | `Null of (unit -> unit) + | `Not_found of (unit -> unit) + | `Id of (Ext_json_types.t -> unit ) + ] + + +type path = string list + +type status = + | No_path + | Found of Ext_json_types.t + | Wrong_type of path + +let test ?(fail=(fun () -> ())) key + (cb : callback) (m : Ext_json_types.t String_map.t) + = + begin match String_map.find_exn m key, cb with + | exception Not_found -> + begin match cb with `Not_found f -> f () + | _ -> fail () + end + | True _, `Bool cb -> cb true + | False _, `Bool cb -> cb false + | Flo {flo = s} , `Flo cb -> cb s + | Flo {flo = s; loc} , `Flo_loc cb -> cb s loc + | Obj {map = b} , `Obj cb -> cb b + | Arr {content}, `Arr cb -> cb content + | Arr {content; loc_start ; loc_end}, `Arr_loc cb -> + cb content loc_start loc_end + | Null _, `Null cb -> cb () + | Str {str = s }, `Str cb -> cb s + | Str {str = s ; loc }, `Str_loc cb -> cb s loc + | any , `Id cb -> cb any + | _, _ -> fail () + end; + m +let query path (json : Ext_json_types.t ) = + let rec aux acc paths json = + match path with + | [] -> Found json + | p :: rest -> + match json with + | Obj {map } -> + (match String_map.find_opt map p with + | Some m -> aux (p::acc) rest m + | None -> No_path) + | _ -> Wrong_type acc + in aux [] path json + + +let loc_of (x : Ext_json_types.t) = + match x with + | True p | False p | Null p -> p + | Str p -> p.loc + | Arr p -> p.loc_start + | Obj p -> p.loc + | Flo p -> p.loc + + +let rec equal + (x : Ext_json_types.t) + (y : Ext_json_types.t) = + match x with + | Null _ -> (* [%p? Null _ ] *) + begin match y with + | Null _ -> true + | _ -> false end + | Str {str } -> + begin match y with + | Str {str = str2} -> str = str2 + | _ -> false end + | Flo {flo} + -> + begin match y with + | Flo {flo = flo2} -> + flo = flo2 + | _ -> false + end + | True _ -> + begin match y with + | True _ -> true + | _ -> false + end + | False _ -> + begin match y with + | False _ -> true + | _ -> false + end + | Arr {content} + -> + begin match y with + | Arr {content = content2} + -> + Ext_array.for_all2_no_exn content content2 equal + | _ -> false + end + + | Obj {map} -> + begin match y with + | Obj { map = map2} -> + String_map.equal map map2 equal + | _ -> false + end + + +end +module Bsb_exception : sig +#1 "bsb_exception.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. *) + + +(** + This module is used for fatal errros +*) +type error +exception Error of error + +val print : Format.formatter -> error -> unit +val package_not_found : pkg:Bsb_pkg_types.t -> json:string option -> 'a + +val conflict_module: + string -> string -> string -> 'a + +val errorf : loc:Ext_position.t -> ('a, unit, string, 'b) format4 -> 'a + +val config_error : Ext_json_types.t -> string -> 'a + +val invalid_spec : string -> 'a + +val invalid_json : string -> 'a +end = struct +#1 "bsb_exception.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. *) + + + +type error = + | Package_not_found of Bsb_pkg_types.t * string option (* json file *) + | Json_config of Ext_position.t * string + | Invalid_json of string + | Invalid_spec of string + | Conflict_module of string * string * string + + +exception Error of error + +let error err = raise (Error err) +let package_not_found ~pkg ~json = + error (Package_not_found(pkg,json)) + +let print (fmt : Format.formatter) (x : error) = + match x with + | Conflict_module (modname,dir1,dir2) -> + Format.fprintf fmt + "@{Error:@} %s found in two directories: (%s, %s)\n\ + File names must be unique per project" + modname dir1 dir2 + | Package_not_found (name,json_opt) -> + let in_json = match json_opt with + | None -> Ext_string.empty + | Some x -> " in " ^ x in + let name = Bsb_pkg_types.to_string name in + if Ext_string.equal name Bs_version.package_name then + Format.fprintf fmt + "File \"bsconfig.json\", line 1\n\ + @{Error:@} package @{bs-platform@} is not found %s\n\ + It's the basic, required package. If you have it installed globally,\n\ + Please run `npm link bs-platform` to make it available" in_json + else + Format.fprintf fmt + "File \"bsconfig.json\", line 1\n\ + @{Error:@} package @{%s@} not found or built %s\n\ + - Did you install it?\n\ + - If you did, did you run `bsb -make-world`?" + name + in_json + + | Json_config (pos,s) -> + Format.fprintf fmt "File \"bsconfig.json\", line %d:\n\ + @{Error:@} %s \n\ + For more details, please checkout the schema http://bucklescript.github.io/bucklescript/docson/#build-schema.json" + pos.pos_lnum s + | Invalid_spec s -> + Format.fprintf fmt + "@{Error: Invalid bsconfig.json%s@}" s + | Invalid_json s -> + Format.fprintf fmt + "File %S, line 1\n\ + @{Error: Invalid json format@}" s + +let conflict_module modname dir1 dir2 = + error (Conflict_module (modname,dir1,dir2)) +let errorf ~loc fmt = + Format.ksprintf (fun s -> error (Json_config (loc,s))) fmt + + +let config_error config fmt = + let loc = Ext_json.loc_of config in + + error (Json_config (loc,fmt)) + +let invalid_spec s = error (Invalid_spec s) + +let invalid_json s = error (Invalid_json s) + +let () = + Printexc.register_printer (fun x -> + match x with + | Error x -> + Some (Format.asprintf "%a" print x ) + | _ -> None + ) + +end +module Ext_char : sig +#1 "ext_char.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. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool + +val is_lower_case : char -> bool + +val uppercase_ascii : char -> char + +val lowercase_ascii : char -> char +end = struct +#1 "ext_char.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. *) + + + + + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) + +let escaped = Char.escaped + + +let valid_hex x = + match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> true + | _ -> false + + + +let is_lower_case c = + (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') +let uppercase_ascii = + + Char.uppercase_ascii + + +let lowercase_ascii = + + Char.lowercase_ascii + + +end +module Ext_sys : sig +#1 "ext_sys.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. *) + + +(* Not used yet *) +(* val is_directory_no_exn : string -> bool *) + + +val is_windows_or_cygwin : bool + +val getenv_opt : + string -> + string option +end = struct +#1 "ext_sys.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. *) + +(** TODO: not exported yet, wait for Windows Fix*) +let is_directory_no_exn f = + try Sys.is_directory f with _ -> false + + +let is_windows_or_cygwin = Sys.win32 || Sys.cygwin + + +let getenv_opt = Sys.getenv_opt + +end +module Literals : sig +#1 "literals.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 js_array_ctor : string +val js_type_number : string +val js_type_string : string +val js_type_object : string +val js_type_boolean : string +val js_undefined : string +val js_prop_length : string + +val param : string +val partial_arg : string +val prim : string + +(**temporary varaible used in {!Js_ast_util} *) +val tmp : string + +val create : string +val runtime : string +val stdlib : string +val imul : string + +val setter_suffix : string +val setter_suffix_len : int + + +val debugger : string +val raw_expr : string +val raw_stmt : string +val raw_function : string +val unsafe_downgrade : string +val fn_run : string +val method_run : string +val fn_method : string +val fn_mk : string + +(** callback actually, not exposed to user yet *) +(* val js_fn_runmethod : string *) + +val bs_deriving : string +val bs_deriving_dot : string +val bs_type : string + +(** nodejs *) + +val node_modules : string +val node_modules_length : int +val package_json : string +val bsconfig_json : string +val build_ninja : string + +(* Name of the library file created for each external dependency. *) +val library_file : string + +val suffix_a : string +val suffix_cmj : string +val suffix_cmo : string +val suffix_cma : string +val suffix_cmi : string +val suffix_cmx : string +val suffix_cmxa : string +val suffix_ml : string +val suffix_mlast : string +val suffix_mlast_simple : string +val suffix_mliast : string +val suffix_mliast_simple : string +val suffix_mlmap : string +val suffix_mll : string +val suffix_re : string +val suffix_rei : string + +val suffix_d : string +val suffix_js : string +val suffix_bs_js : string +(* val suffix_re_js : string *) +val suffix_gen_js : string +val suffix_gen_tsx: string + +val suffix_tsx : string +val suffix_mlastd : string +val suffix_mliastd : string + +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string + +val commonjs : string +val amdjs : string +val es6 : string +val es6_global : string +val amdjs_global : string +val unused_attribute : string +val dash_nostdlib : string + +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string + +val native : string +val bytecode : string +val js : string + +val node_sep : string +val node_parent : string +val node_current : string +val gentype_import : string +end = struct +#1 "literals.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 js_array_ctor = "Array" +let js_type_number = "number" +let js_type_string = "string" +let js_type_object = "object" +let js_type_boolean = "boolean" +let js_undefined = "undefined" +let js_prop_length = "length" + +let prim = "prim" +let param = "param" +let partial_arg = "partial_arg" +let tmp = "tmp" + +let create = "create" (* {!Caml_exceptions.create}*) + +let runtime = "runtime" (* runtime directory *) + +let stdlib = "stdlib" + +let imul = "imul" (* signed int32 mul *) + +let setter_suffix = "#=" +let setter_suffix_len = String.length setter_suffix + +let debugger = "debugger" +let raw_expr = "raw_expr" +let raw_stmt = "raw_stmt" +let raw_function = "raw_function" +let unsafe_downgrade = "unsafe_downgrade" +let fn_run = "fn_run" +let method_run = "method_run" + +let fn_method = "fn_method" +let fn_mk = "fn_mk" +(*let js_fn_runmethod = "js_fn_runmethod"*) + +let bs_deriving = "bs.deriving" +let bs_deriving_dot = "bs.deriving." +let bs_type = "bs.type" + + +(** nodejs *) +let node_modules = "node_modules" +let node_modules_length = String.length "node_modules" +let package_json = "package.json" +let bsconfig_json = "bsconfig.json" +let build_ninja = "build.ninja" + +(* Name of the library file created for each external dependency. *) +let library_file = "lib" + +let suffix_a = ".a" +let suffix_cmj = ".cmj" +let suffix_cmo = ".cmo" +let suffix_cma = ".cma" +let suffix_cmi = ".cmi" +let suffix_cmx = ".cmx" +let suffix_cmxa = ".cmxa" +let suffix_mll = ".mll" +let suffix_ml = ".ml" +let suffix_mli = ".mli" +let suffix_re = ".re" +let suffix_rei = ".rei" +let suffix_mlmap = ".mlmap" + +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" +let suffix_mlast = ".mlast" +let suffix_mlast_simple = ".mlast_simple" +let suffix_mliast = ".mliast" +let suffix_mliast_simple = ".mliast_simple" +let suffix_d = ".d" +let suffix_mlastd = ".mlast.d" +let suffix_mliastd = ".mliast.d" +let suffix_js = ".js" +let suffix_bs_js = ".bs.js" +(* let suffix_re_js = ".re.js" *) +let suffix_gen_js = ".gen.js" +let suffix_gen_tsx = ".gen.tsx" +let suffix_tsx = ".tsx" + +let commonjs = "commonjs" +let amdjs = "amdjs" +let es6 = "es6" +let es6_global = "es6-global" +let amdjs_global = "amdjs-global" +let unused_attribute = "Unused attribute " +let dash_nostdlib = "-nostdlib" + +let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" +let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" + +let native = "native" +let bytecode = "bytecode" +let js = "js" + + + +(** Used when produce node compatible paths *) +let node_sep = "/" +let node_parent = ".." +let node_current = "." + +let gentype_import = "genType.import" +end +module Ext_path : sig +#1 "ext_path.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t + + + + + +(** + [combine path1 path2] + 1. add some simplifications when concatenating + 2. when [path2] is absolute, return [path2] +*) +val combine : + string -> + string -> + string + + + +val chop_extension : ?loc:string -> string -> string + + +val chop_extension_if_any : string -> string + +val chop_all_extensions_if_any : + string -> string + +(** + {[ + get_extension "a.txt" = ".txt" + get_extension "a" = "" + ]} +*) +val get_extension : string -> string + + + + +val node_rebase_file : + from:string -> + to_:string -> + string -> + string + +(** + TODO: could be highly optimized + if [from] and [to] resolve to the same path, a zero-length string is returned + Given that two paths are directory + + A typical use case is + {[ + Filename.concat + (rel_normalized_absolute_path cwd (Filename.dirname a)) + (Filename.basename a) + ]} +*) +val rel_normalized_absolute_path : from:string -> string -> string + + +val normalize_absolute_path : string -> string + +val absolute_path : string Lazy.t -> string -> string + +(** [concat dirname filename] + The same as {!Filename.concat} except a tiny optimization + for current directory simplification +*) +val concat : string -> string -> string + +val check_suffix_case : + string -> string -> bool +end = struct +#1 "ext_path.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t = + | File of string + | Dir of string + + + + + + +let split_by_sep_per_os : string -> string list = + if Ext_sys.is_windows_or_cygwin then + fun x -> + (* on Windows, we can still accept -bs-package-output lib/js *) + Ext_string.split_by + (fun x -> match x with |'/' |'\\' -> true | _ -> false) x + else + fun x -> Ext_string.split x '/' + +(** example + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + ]} + + The other way + {[ + + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + ]} + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib//ocaml_array.ml" + ]} + {[ + /a/b + /c/d + ]} +*) +let node_relative_path + ~from:(file_or_dir_2 : t ) + (file_or_dir_1 : t) + = + let relevant_dir1 = + match file_or_dir_1 with + | Dir x -> x + | File file1 -> Filename.dirname file1 in + let relevant_dir2 = + match file_or_dir_2 with + | Dir x -> x + | File file2 -> Filename.dirname file2 in + let dir1 = split_by_sep_per_os relevant_dir1 in + let dir2 = split_by_sep_per_os relevant_dir2 in + let rec go (dir1 : string list) (dir2 : string list) = + match dir1, dir2 with + | "." :: xs, ys -> go xs ys + | xs , "." :: ys -> go xs ys + | x::xs , y :: ys when x = y + -> go xs ys + | _, _ -> + Ext_list.map_append dir2 dir1 (fun _ -> Literals.node_parent) + in + match go dir1 dir2 with + | (x :: _ ) as ys when x = Literals.node_parent -> + String.concat Literals.node_sep ys + | ys -> + String.concat Literals.node_sep + @@ Literals.node_current :: ys + + +let node_concat ~dir base = + dir ^ Literals.node_sep ^ base + +let node_rebase_file ~from ~to_ file = + + node_concat + ~dir:( + if from = to_ then Literals.node_current + else node_relative_path ~from:(Dir from) (Dir to_)) + file + + +(*** + {[ + Filename.concat "." "";; + "./" + ]} +*) +let combine path1 path2 = + if Filename.is_relative path2 then + if Ext_string.is_empty path2 then + path1 + else + if path1 = Filename.current_dir_name then + path2 + else + if path2 = Filename.current_dir_name + then path1 + else + Filename.concat path1 path2 + else + path2 + + +let chop_extension ?(loc="") name = + try Filename.chop_extension name + with Invalid_argument _ -> + Ext_pervasives.invalid_argf + "Filename.chop_extension ( %s : %s )" loc name + +let chop_extension_if_any fname = + try Filename.chop_extension fname with Invalid_argument _ -> fname + +let rec chop_all_extensions_if_any fname = + match Filename.chop_extension fname with + | x -> chop_all_extensions_if_any x + | exception _ -> fname + +let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos + + +let (//) x y = + if x = Filename.current_dir_name then y + else if y = Filename.current_dir_name then x + else Filename.concat x y + +(** + {[ + split_aux "//ghosg//ghsogh/";; + - : string * string list = ("/", ["ghosg"; "ghsogh"]) + ]} + Note that + {[ + Filename.dirname "/a/" = "/" + Filename.dirname "/a/b/" = Filename.dirname "/a/b" = "/a" + ]} + Special case: + {[ + basename "//" = "/" + basename "///" = "/" + ]} + {[ + basename "" = "." + basename "" = "." + dirname "" = "." + dirname "" = "." + ]} +*) +let split_aux p = + let rec go p acc = + let dir = Filename.dirname p in + if dir = p then dir, acc + else + let new_path = Filename.basename p in + if Ext_string.equal new_path Filename.dir_sep then + go dir acc + (* We could do more path simplification here + leave to [rel_normalized_absolute_path] + *) + else + go dir (new_path :: acc) + + in go p [] + + + + + +(** + TODO: optimization + if [from] and [to] resolve to the same path, a zero-length string is returned + + This function is useed in [es6-global] and + [amdjs-global] format and tailored for `rollup` +*) +let rel_normalized_absolute_path ~from to_ = + let root1, paths1 = split_aux from in + let root2, paths2 = split_aux to_ in + if root1 <> root2 then root2 + else + let rec go xss yss = + match xss, yss with + | x::xs, y::ys -> + if Ext_string.equal x y then go xs ys + else if x = Filename.current_dir_name then go xs yss + else if y = Filename.current_dir_name then go xss ys + else + let start = + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + Ext_list.fold_left yss start (fun acc v -> acc // v) + | [], [] -> Ext_string.empty + | [], y::ys -> Ext_list.fold_left ys y (fun acc x -> acc // x) + | x::xs, [] -> + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + let v = go paths1 paths2 in + + if Ext_string.is_empty v then Literals.node_current + else + if + v = "." + || v = ".." + || Ext_string.starts_with v "./" + || Ext_string.starts_with v "../" + then v + else "./" ^ v + +(*TODO: could be hgighly optimized later + {[ + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/a/b/../c../d/e/f";; + + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/gsho/./../..";; + + normalize_absolute_path "/a/b/c/d";; + + normalize_absolute_path "/a/b/c/d/";; + + normalize_absolute_path "/a/";; + + normalize_absolute_path "/a";; + ]} +*) +(** See tests in {!Ounit_path_tests} *) +let normalize_absolute_path x = + let drop_if_exist xs = + match xs with + | [] -> [] + | _ :: xs -> xs in + let rec normalize_list acc paths = + match paths with + | [] -> acc + | x :: xs -> + if Ext_string.equal x Ext_string.current_dir_lit then + normalize_list acc xs + else if Ext_string.equal x Ext_string.parent_dir_lit then + normalize_list (drop_if_exist acc ) xs + else + normalize_list (x::acc) xs + in + let root, paths = split_aux x in + let rev_paths = normalize_list [] paths in + let rec go acc rev_paths = + match rev_paths with + | [] -> Filename.concat root acc + | last::rest -> go (Filename.concat last acc ) rest in + match rev_paths with + | [] -> root + | last :: rest -> go last rest + + + + +let absolute_path cwd s = + let process s = + let s = + if Filename.is_relative s then + Lazy.force cwd // s + else s in + (* Now simplify . and .. components *) + let rec aux s = + let base,dir = Filename.basename s, Filename.dirname s in + if dir = s then dir + else if base = Filename.current_dir_name then aux dir + else if base = Filename.parent_dir_name then Filename.dirname (aux dir) + else aux dir // base + in aux s in + process s + + +let absolute cwd s = + match s with + | File x -> File (absolute_path cwd x ) + | Dir x -> Dir (absolute_path cwd x) + +let concat dirname filename = + if filename = Filename.current_dir_name then dirname + else if dirname = Filename.current_dir_name then filename + else Filename.concat dirname filename + + +let check_suffix_case = + Ext_string.ends_with +end +module Ext_modulename : sig +#1 "ext_modulename.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file : string -> string + + +val module_name_of_file_if_any : string -> string + +(** [modulename, upper] + if [upper = true] then it means it is indeed uppercase +*) +val module_name_of_file_if_any_with_upper : string -> string * bool + + +(** Given an JS bundle name, generate a meaningful + bounded module name +*) +val js_id_name_of_hint_name : string -> string +end = struct +#1 "ext_modulename.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file file = + Ext_string.capitalize_ascii + (Filename.chop_extension @@ Filename.basename file) + +let module_name_of_file_if_any file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + Ext_string.capitalize_ascii v + +let module_name_of_file_if_any_with_upper file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + let res = Ext_string.capitalize_ascii v in + res, res == v + + + + +let good_hint_name module_name offset = + let len = String.length module_name in + len > offset && + (function | 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false) + (String.unsafe_get module_name offset) && + Ext_string.for_all_from module_name (offset + 1) + (function + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + -> true + | _ -> false) + +let rec collect_start buf s off len = + if off >= len then () + else + let next = succ off in + match String.unsafe_get s off with + | 'a' .. 'z' as c -> + Buffer.add_char buf (Ext_char.uppercase_ascii c) + ; + collect_next buf s next len + | 'A' .. 'Z' as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | _ -> collect_start buf s next len +and collect_next buf s off len = + if off >= len then () + else + let next = off + 1 in + match String.unsafe_get s off with + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | '.' + | '-' -> + collect_start buf s next len + | _ -> + collect_next buf s next len + +(** This is for a js exeternal module, we can change it when printing + for example + {[ + var React$1 = require('react'); + React$1.render(..) + ]} + Given a name, if duplicated, they should have the same id +*) +let js_id_name_of_hint_name module_name = + let i = Ext_string.rindex_neg module_name '/' in + if i >= 0 then + let offset = succ i in + if good_hint_name module_name offset then + Ext_string.capitalize_ascii + (Ext_string.tail_from module_name offset) + else + let str_len = String.length module_name in + let buf = Buffer.create str_len in + collect_start buf module_name offset str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then + Ext_string.capitalize_ascii module_name + else res + else + if good_hint_name module_name 0 then + Ext_string.capitalize_ascii module_name + else + let str_len = (String.length module_name) in + let buf = Buffer.create str_len in + collect_start buf module_name 0 str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then module_name + else res + +end +module Bsb_db : sig +#1 "bsb_db.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. *) + +(** Store a file called [.bsbuild] that can be communicated + between [bsb.exe] and [bsb_helper.exe]. + [bsb.exe] stores such data which would be retrieved by + [bsb_helper.exe]. It is currently used to combine with + ocamldep to figure out which module->file it depends on +*) + +type case = bool + + +type ml_info = + | Ml_source of bool * bool + (* No extension stored + Ml_source(name,is_re) + [is_re] default to false + *) + + | Ml_empty +type mli_info = + | Mli_source of bool * bool + | Mli_empty + +type module_info = + { + mli_info : mli_info ; + ml_info : ml_info ; + name_sans_extension : string + } + +type t = module_info String_map.t + +type ts = t array + +(** store the meta data indexed by {!Bsb_dir_index} + {[ + 0 --> lib group + 1 --> dev 1 group + . + + ]} +*) + +val dir_of_module_info : module_info -> string + + +val filename_sans_suffix_of_module_info : module_info -> string + + +(** + Currently it is okay to have duplicated module, + In the future, we may emit a warning +*) +val collect_module_by_filename : + dir:string -> t -> string -> t + +(** + return [boolean] to indicate whether reason file exists or not + will raise if it fails sanity check +*) +val sanity_check : t -> bool +end = struct +#1 "bsb_db.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. *) + +type case = bool +(** true means upper case*) + +type ml_info = + | Ml_source of bool * case (* Ml_source(is_re, case) default to false *) + | Ml_empty +type mli_info = + | Mli_source of bool * case + | Mli_empty + +type module_info = + { + mli_info : mli_info ; + ml_info : ml_info ; + name_sans_extension : string ; + } + + +type t = module_info String_map.t + +type ts = t array +(** indexed by the group *) + + + +let dir_of_module_info (x : module_info) + = + Filename.dirname x.name_sans_extension + + +let filename_sans_suffix_of_module_info (x : module_info) = + x.name_sans_extension + +let check (x : module_info) name_sans_extension = + if x.name_sans_extension <> name_sans_extension then + Bsb_exception.invalid_spec + (Printf.sprintf + "implementation and interface have different path names or different cases %s vs %s" + x.name_sans_extension name_sans_extension) + +let adjust_module_info (x : _ option) suffix name_sans_extension upper = + match suffix with + | ".ml" -> + let ml_info = Ml_source ( false, upper) in + (match x with + | None -> + {name_sans_extension ; ml_info ; mli_info = Mli_empty} + | Some x -> + check x name_sans_extension; + {x with ml_info }) + | ".re" -> + let ml_info = Ml_source ( true, upper)in + (match x with None -> + {name_sans_extension; ml_info ; mli_info = Mli_empty} + | Some x -> + check x name_sans_extension; + {x with ml_info}) + | ".mli" -> + let mli_info = Mli_source (false, upper) in + (match x with None -> + {name_sans_extension; mli_info ; ml_info = Ml_empty} + | Some x -> + check x name_sans_extension; + {x with mli_info }) + | ".rei" -> + let mli_info = Mli_source (true, upper) in + (match x with None -> + { name_sans_extension; mli_info ; ml_info = Ml_empty} + | Some x -> + check x name_sans_extension; + { x with mli_info}) + | _ -> + Ext_pervasives.failwithf ~loc:__LOC__ + "don't know what to do with %s%s" + name_sans_extension suffix + +let collect_module_by_filename ~dir (map : t) file_name : t = + let module_name, upper = + Ext_modulename.module_name_of_file_if_any_with_upper file_name in + let suffix = Ext_path.get_extension file_name in + let name_sans_extension = + Ext_path.chop_extension (Filename.concat dir file_name) in + String_map.adjust + map + module_name + (fun opt_module_info -> + adjust_module_info + opt_module_info + suffix + name_sans_extension upper ) + + + +let sanity_check (map : t ) = + String_map.exists map (fun _ module_info -> + match module_info with + | { ml_info = Ml_source(is_re,_); + mli_info = Mli_source(is_rei,_) } -> + is_re || is_rei + | {ml_info = Ml_source(is_re,_); mli_info = Mli_empty} + | {mli_info = Mli_source(is_re,_); ml_info = Ml_empty} + -> is_re + | {ml_info = Ml_empty ; mli_info = Mli_empty } -> false + ) + +end +module Bsb_db_io : sig +#1 "bsb_db_io.mli" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + + + + +type t + +type group = { + modules : string array ; + meta_info_offset : int + } + +val decode : + string -> + int ref -> + group array + +val write_build_cache : + dir:string -> Bsb_db.ts -> unit + + +val read_build_cache : + dir:string -> t + +val find_opt : + t -> (* contains global info *) + int -> (* more likely to be zero *) + string -> (* module name *) + Bsb_db.module_info option +end = struct +#1 "bsb_db_io.ml" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + + + type group = { + modules : string array ; + meta_info_offset : int + } + +type t = group array * string (* string is whole content*) + +let bsbuild_cache = ".bsbuild" + + +let nl buf = + Buffer.add_char buf '\n' +let comma buf = + Buffer.add_char buf ',' +let bool buf b = + Buffer.add_char buf (if b then '1' else '0') + +(* IDEAS: + Pros: + - could be even shortened to a single byte + Cons: + - decode would allocate + - code too verbose + - not readable + *) +let encode_ml_info (x : Bsb_db.ml_info ) : char = + match x with + | Ml_empty -> '0' + | Ml_source(false,false) -> '1' + | Ml_source(false,true) -> '2' + | Ml_source(true, false) -> '3' + | Ml_source(true, true) -> '4' + +let decode_ml_info (x : char ) : Bsb_db.ml_info = + match x with + | '0' -> Ml_empty + | '1' -> Ml_source(false,false) + | '2' -> Ml_source(false,true) + | '3' -> Ml_source(true, false) + | '4' -> Ml_source(true, true) + | _ -> assert false + +let encode_mli_info (x : Bsb_db.mli_info ) : char = + match x with + | Mli_empty -> '0' + | Mli_source(false,false) -> '1' + | Mli_source(false,true) -> '2' + | Mli_source(true, false) -> '3' + | Mli_source(true, true) -> '4' + +let decode_mli_info (x : char ) : Bsb_db.mli_info = + match x with + | '0' -> Mli_empty + | '1' -> Mli_source(false,false) + | '2' -> Mli_source(false,true) + | '3' -> Mli_source(true, false) + | '4' -> Mli_source(true, true) + | _ -> assert false + +let rec encode_module_info (x : Bsb_db.module_info) (buf : Buffer.t) = + Buffer.add_string buf x.name_sans_extension; + comma buf; + Buffer.add_char buf (encode_mli_info x.mli_info); + Buffer.add_char buf (encode_ml_info x.ml_info) + + + +(* Make sure [tmp_buf1] and [tmp_buf2] is cleared , + they are only used to control the order. + Strictly speaking, [tmp_buf1] is not needed +*) +let encode_single (x : Bsb_db.t) (buf : Buffer.t) (buf2 : Buffer.t) = + let len = String_map.cardinal x in + nl buf ; + Buffer.add_string buf (string_of_int len); + String_map.iter x (fun name module_info -> + nl buf; + Buffer.add_string buf name; + nl buf2; + encode_module_info module_info buf2 + ) + +let encode (x : Bsb_db.ts) (oc : out_channel)= + output_char oc '\n'; + let len = Array.length x in + output_string oc (string_of_int len); + let tmp_buf1 = Buffer.create 10_000 in + let tmp_buf2 = Buffer.create 60_000 in + Ext_array.iter x (fun x -> begin + encode_single x tmp_buf1 tmp_buf2; + Buffer.output_buffer oc tmp_buf1; + Buffer.output_buffer oc tmp_buf2; + Buffer.clear tmp_buf1; + Buffer.clear tmp_buf2 + end + ) + + +type cursor = int ref + +let extract_line (x : string) (cur : cursor) : string = + Ext_string.extract_until x cur '\n' + +let next_mdoule_info (s : string) (cur : int) ~count = + if count = 0 then cur + else + Ext_string.index_count s cur '\n' count + 1 + +let rec decode (x : string) (offset : cursor) = + let len = int_of_string (extract_line x offset) in + Array.init len (fun _ -> decode_single x offset) +and decode_single x (offset : cursor) : group = + let cardinal = int_of_string (extract_line x offset) in + let modules = decode_modules x offset cardinal in + let meta_info_offset = !offset in + offset := next_mdoule_info x meta_info_offset ~count:cardinal; + { modules ; meta_info_offset } +and decode_modules x (offset : cursor) cardinal = + let result = Array.make cardinal "" in + for i = 0 to cardinal - 1 do + Array.unsafe_set result i (extract_line x offset) + done ; + result + + + + +let write_build_cache ~dir (bs_files : Bsb_db.ts) : unit = + let oc = open_out_bin (Filename.concat dir bsbuild_cache) in + output_string oc Bs_version.version ; + encode bs_files oc; + close_out oc + + +let read_build_cache ~dir : t = + let ic = open_in_bin (Filename.concat dir bsbuild_cache) in + let len = in_channel_length ic in + let all_content = really_input_string ic len in + let offset = ref 0 in + let cur_module_info_magic_number = extract_line all_content offset in + assert (cur_module_info_magic_number = Bs_version.version); + decode all_content offset, all_content + +let cmp (a : string) b = String_map.compare_key a b + +let rec binarySearchAux (arr : string array) (lo : int) (hi : int) (key : string) : _ option = + let mid = (lo + hi)/2 in + let midVal = Array.unsafe_get arr mid in + let c = cmp key midVal in + if c = 0 then Some (mid) + else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = (Array.unsafe_get arr lo) in + if loVal = key then Some lo + else None + else binarySearchAux arr lo mid key + else (* a[lo] =< a[mid] < key <= a[hi] *) + if lo = mid then + let hiVal = (Array.unsafe_get arr hi) in + if hiVal = key then Some hi + else None + else binarySearchAux arr mid hi key + +let find_opt_aux sorted key : _ option = + let len = Array.length sorted in + if len = 0 then None + else + let lo = Array.unsafe_get sorted 0 in + let c = cmp key lo in + if c < 0 then None + else + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = cmp key hi in + if c2 > 0 then None + else binarySearchAux sorted 0 (len - 1) key + +let find_opt + ((sorteds,whole) : t ) i key + : Bsb_db.module_info option = + let group = sorteds.(i) in + let i = find_opt_aux group.modules key in + match i with + | None -> None + | Some count -> + let cursor = + ref (next_mdoule_info whole group.meta_info_offset ~count) + in + let name_sans_extension = + Ext_string.extract_until whole cursor ',' in + let mli_info = decode_mli_info whole.[!cursor] in + let ml_info = decode_ml_info whole.[!cursor + 1] in + Some {mli_info ; ml_info; name_sans_extension} +end +module Ounit_bsb_pkg_tests += struct +#1 "ounit_bsb_pkg_tests.ml" + + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let printer_string = fun x -> x +let (=~) = OUnit.assert_equal ~printer:printer_string + + +let parse_data_one = +(Bsb_db_io.decode {|4.0.19 +2 +1 +Demo +src/demo,01 +1 +Test +examples/test,01 +|} (ref 7)) + +let parse_data_two = + Bsb_db_io.decode {|4.0.19 +3 +2 +Fib +Demo +src/hi/fib,01 +src/demo,01 +0 +0|} (ref 7) +let data_one : Bsb_db_io.group array = + [| {modules = [|"Demo"|]; meta_info_offset = 16}; {modules = [|"Test"|]; meta_info_offset = 35}|] + +let data_two : Bsb_db_io.group array = + [| {modules = [|"Fib"; "Demo"|]; meta_info_offset = 20 }; {modules = [||]; meta_info_offset = 48}; {modules = [||]; meta_info_offset = -1} |] + + +let scope_test s (a,b,c)= + match Bsb_pkg_types.extract_pkg_name_and_file s with + | Scope(a0,b0),c0 -> + a =~ a0 ; b =~ b0 ; c =~ c0 + | Global _,_ -> OUnit.assert_failure __LOC__ + +let global_test s (a,b) = + match Bsb_pkg_types.extract_pkg_name_and_file s with + | Scope _, _ -> + OUnit.assert_failure __LOC__ + | Global a0, b0-> + a=~a0; b=~b0 + +let s_test0 s (a,b)= + match Bsb_pkg_types.string_as_package s with + | Scope(name,scope) -> + a =~ name ; b =~scope + | _ -> OUnit.assert_failure __LOC__ + +let s_test1 s a = + match Bsb_pkg_types.string_as_package s with + | Global x -> + a =~ x + | _ -> OUnit.assert_failure __LOC__ + +let suites = + __FILE__ >::: [ + __LOC__ >:: begin fun _ -> + scope_test "@hello/hi" + ("hi", "@hello",""); + + scope_test "@hello/hi/x" + ("hi", "@hello","x"); + + + scope_test "@hello/hi/x/y" + ("hi", "@hello","x/y"); + end ; + __LOC__ >:: begin fun _ -> + global_test "hello" + ("hello",""); + global_test "hello/x" + ("hello","x"); + global_test "hello/x/y" + ("hello","x/y") + end ; + __LOC__ >:: begin fun _ -> + s_test0 "@x/y" ("y","@x"); + s_test0 "@x/y/z" ("y/z","@x"); + s_test1 "xx" "xx"; + s_test1 "xx/yy/zz" "xx/yy/zz" + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal parse_data_one data_one + end ; + __LOC__ >:: begin fun _ -> + + OUnit.assert_equal parse_data_two data_two + end + ] + + + + +end +module Bsb_regex : sig +#1 "bsb_regex.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + +(** Used in `bsb -init` command *) +val global_substitute: + string -> + reg:string -> + (string -> string list -> string) -> + string +end = struct +#1 "bsb_regex.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 string_after s n = String.sub s n (String.length s - n) + + + +(* There seems to be a bug in {!Str.global_substitute} +{[ +Str.global_substitute (Str.regexp "\\${bsb:\\([-a-zA-Z0-9]+\\)}") (fun x -> (x^":found")) {| ${bsb:hello-world} ${bsb:x} ${x}|} ;; +- : bytes = +" ${bsb:hello-world} ${bsb:x} ${x}:found ${bsb:hello-world} ${bsb:x} ${x}:found ${x}" +]} +*) +let global_substitute text ~reg:expr repl_fun = + let text_len = String.length text in + let expr = Str.regexp expr in + let rec replace accu start last_was_empty = + let startpos = if last_was_empty then start + 1 else start in + if startpos > text_len then + string_after text start :: accu + else + match Str.search_forward expr text startpos with + | exception Not_found -> + string_after text start :: accu + | pos -> + let end_pos = Str.match_end() in + let matched = (Str.matched_string text) in + let groups = + let rec aux n acc = + match Str.matched_group n text with + | exception (Not_found | Invalid_argument _ ) + -> acc + | v -> aux (succ n) (v::acc) in + aux 1 [] in + let repl_text = repl_fun matched groups in + replace (repl_text :: String.sub text start (pos-start) :: accu) + end_pos (end_pos = pos) + in + String.concat "" (List.rev (replace [] 0 false)) + +end +module Ounit_bsb_regex_tests += struct +#1 "ounit_bsb_regex_tests.ml" + + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + +let test_eq x y = + Bsb_regex.global_substitute ~reg:"\\${bsb:\\([-a-zA-Z0-9]+\\)}" x + (fun _ groups -> + match groups with + | x::xs -> x + | _ -> assert false + ) =~ y + + +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + test_eq + {| hi hi hi ${bsb:name} + ${bsb:x} + ${bsb:u} + |} + {| hi hi hi name + x + u + |} + end; + __LOC__ >:: begin fun _ -> + test_eq "xx" "xx"; + test_eq "${bsb:x}" "x"; + test_eq "a${bsb:x}" "ax"; + + end; + + __LOC__ >:: begin fun _ -> + test_eq "${bsb:x}x" "xx" + end; + + __LOC__ >:: begin fun _ -> + test_eq {| +{ + "name": "${bsb:name}", + "version": "${bsb:proj-version}", + "sources": [ + "src" + ], + "reason" : { "react-jsx" : true}, + "bs-dependencies" : [ + // add your bs-dependencies here + ] +} +|} {| +{ + "name": "name", + "version": "proj-version", + "sources": [ + "src" + ], + "reason" : { "react-jsx" : true}, + "bs-dependencies" : [ + // add your bs-dependencies here + ] +} +|} + end + + ; + __LOC__ >:: begin fun _ -> + test_eq {| +{ + "name": "${bsb:name}", + "version": "${bsb:proj-version}", + "scripts": { + "clean": "bsb -clean", + "clean:all": "bsb -clean-world", + "build": "bsb", + "build:all": "bsb -make-world", + "watch": "bsb -w", + }, + "keywords": [ + "Bucklescript" + ], + "license": "MIT", + "devDependencies": { + "bs-platform": "${bsb:bs-version}" + } +} +|} {| +{ + "name": "name", + "version": "proj-version", + "scripts": { + "clean": "bsb -clean", + "clean:all": "bsb -clean-world", + "build": "bsb", + "build:all": "bsb -make-world", + "watch": "bsb -w", + }, + "keywords": [ + "Bucklescript" + ], + "license": "MIT", + "devDependencies": { + "bs-platform": "bs-version" + } +} +|} + end; + __LOC__ >:: begin fun _ -> + test_eq {| +{ + "version": "0.1.0", + "command": "${bsb:bsb}", + "options": { + "cwd": "${workspaceRoot}" + }, + "isShellCommand": true, + "args": [ + "-w" + ], + "showOutput": "always", + "isWatching": true, + "problemMatcher": { + "fileLocation": "absolute", + "owner": "ocaml", + "watching": { + "activeOnStart": true, + "beginsPattern": ">>>> Start compiling", + "endsPattern": ">>>> Finish compiling" + }, + "pattern": [ + { + "regexp": "^File \"(.*)\", line (\\d+)(?:, characters (\\d+)-(\\d+))?:$", + "file": 1, + "line": 2, + "column": 3, + "endColumn": 4 + }, + { + "regexp": "^(?:(?:Parse\\s+)?(Warning|[Ee]rror)(?:\\s+\\d+)?:)?\\s+(.*)$", + "severity": 1, + "message": 2, + "loop": true + } + ] + } +} +|} {| +{ + "version": "0.1.0", + "command": "bsb", + "options": { + "cwd": "${workspaceRoot}" + }, + "isShellCommand": true, + "args": [ + "-w" + ], + "showOutput": "always", + "isWatching": true, + "problemMatcher": { + "fileLocation": "absolute", + "owner": "ocaml", + "watching": { + "activeOnStart": true, + "beginsPattern": ">>>> Start compiling", + "endsPattern": ">>>> Finish compiling" + }, + "pattern": [ + { + "regexp": "^File \"(.*)\", line (\\d+)(?:, characters (\\d+)-(\\d+))?:$", + "file": 1, + "line": 2, + "column": 3, + "endColumn": 4 + }, + { + "regexp": "^(?:(?:Parse\\s+)?(Warning|[Ee]rror)(?:\\s+\\d+)?:)?\\s+(.*)$", + "severity": 1, + "message": 2, + "loop": true + } + ] + } +} +|} + end + ] +end +module Ounit_cmd_util : sig +#1 "ounit_cmd_util.mli" +type output = { + stderr : string ; + stdout : string ; + exit_code : int +} + + +val perform : string -> string array -> output + + +val perform_bsc : string array -> output + + + val bsc_check_eval : string -> output + +val debug_output : output -> unit +end = struct +#1 "ounit_cmd_util.ml" +let (//) = Filename.concat + +(** may nonterminate when [cwd] is '.' *) +let rec unsafe_root_dir_aux cwd = + if Sys.file_exists (cwd//Literals.bsconfig_json) then cwd + else unsafe_root_dir_aux (Filename.dirname cwd) + +let project_root = unsafe_root_dir_aux (Sys.getcwd ()) +let jscomp = project_root // "jscomp" +let bsc_bin = project_root // "lib" + +let bsc_exe = bsc_bin // "bsc.exe" +let runtime_dir = jscomp // "runtime" +let others_dir = jscomp // "others" + + +let stdlib_dir = jscomp // "stdlib-406" + + +let rec safe_dup fd = + let new_fd = Unix.dup fd in + if (Obj.magic new_fd : int) >= 3 then + new_fd (* [dup] can not be 0, 1, 2*) + else begin + let res = safe_dup fd in + Unix.close new_fd; + res + end + +let safe_close fd = + try Unix.close fd with Unix.Unix_error(_,_,_) -> () + + +type output = { + stderr : string ; + stdout : string ; + exit_code : int +} + +let perform command args = + let new_fd_in, new_fd_out = Unix.pipe () in + let err_fd_in, err_fd_out = Unix.pipe () in + match Unix.fork () with + | 0 -> + begin try + safe_close new_fd_in; + safe_close err_fd_in; + Unix.dup2 err_fd_out Unix.stderr ; + Unix.dup2 new_fd_out Unix.stdout; + Unix.execv command args + with _ -> + exit 127 + end + | pid -> + (* when all the descriptors on a pipe's input are closed and the pipe is + empty, a call to [read] on its output returns zero: end of file. + when all the descriptiors on a pipe's output are closed, a call to + [write] on its input kills the writing process (EPIPE). + *) + safe_close new_fd_out ; + safe_close err_fd_out ; + let in_chan = Unix.in_channel_of_descr new_fd_in in + let err_in_chan = Unix.in_channel_of_descr err_fd_in in + let buf = Buffer.create 1024 in + let err_buf = Buffer.create 1024 in + (try + while true do + Buffer.add_string buf (input_line in_chan ); + Buffer.add_char buf '\n' + done; + with + End_of_file -> ()) ; + (try + while true do + Buffer.add_string err_buf (input_line err_in_chan ); + Buffer.add_char err_buf '\n' + done; + with + End_of_file -> ()) ; + let exit_code = match snd @@ Unix.waitpid [] pid with + | Unix.WEXITED exit_code -> exit_code + | Unix.WSIGNALED _signal_number + | Unix.WSTOPPED _signal_number -> 127 in + { + stdout = Buffer.contents buf ; + stderr = Buffer.contents err_buf; + exit_code + } + + +let perform_bsc args = + perform bsc_exe + (Array.append + [|bsc_exe ; + "-bs-package-name" ; "bs-platform"; + "-bs-no-version-header"; + "-bs-cross-module-opt"; + "-w"; + "-40"; + "-I" ; + runtime_dir ; + "-I"; + others_dir ; + "-I" ; + stdlib_dir + |] args) + +let bsc_check_eval str = + perform_bsc [|"-bs-eval"; str|] + + let debug_output o = + Printf.printf "\nexit_code:%d\nstdout:%s\nstderr:%s\n" + o.exit_code o.stdout o.stderr + +end +module Ounit_cmd_tests += struct +#1 "ounit_cmd_tests.ml" +let (//) = Filename.concat + + + + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + + + + +(* let output_of_exec_command command args = + let readme, writeme = Unix.pipe () in + let pid = Unix.create_process command args Unix.stdin writeme Unix.stderr in + let in_chan = Unix.in_channel_of_descr readme *) + + + +let perform_bsc = Ounit_cmd_util.perform_bsc +let bsc_check_eval = Ounit_cmd_util.bsc_check_eval + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + let v_output = perform_bsc [| "-v" |] in + OUnit.assert_bool __LOC__ ((perform_bsc [| "-h" |]).exit_code <> 0 ); + OUnit.assert_bool __LOC__ (v_output.exit_code = 0); + (* Printf.printf "\n*>%s" v_output.stdout; *) + (* Printf.printf "\n*>%s" v_output.stderr ; *) + end; + __LOC__ >:: begin fun _ -> + let v_output = + perform_bsc [| "-bs-eval"; {|let str = "'a'" |}|] in + OUnit.assert_bool __LOC__ (v_output.exit_code = 0) + end; + __LOC__ >:: begin fun _ -> + let should_be_warning = + bsc_check_eval {|let bla4 foo x y= foo##(method1 x y [@bs]) |} in + (* debug_output should_be_warning; *) + OUnit.assert_bool __LOC__ (Ext_string.contain_substring + should_be_warning.stderr "Unused") + end; + __LOC__ >:: begin fun _ -> + let should_be_warning = + bsc_check_eval {| external mk : int -> ([`a|`b [@bs.string]]) = "" [@@bs.val] |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring + should_be_warning.stderr "Unused") + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| +external ff : + resp -> (_ [@bs.as "x"]) -> int -> unit = + "x" [@@bs.set] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr + "Ill defined" + ) + end; + + __LOC__ >:: begin fun _ -> + (** used in return value + This should fail, we did not + support uncurry return value yet + *) + let should_err = bsc_check_eval {| + external v3 : + int -> int -> (int -> int -> int [@bs.uncurry]) + = ""[@@bs.val] + + |} in + (* Ounit_cmd_util.debug_output should_err;*) + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring + should_err.stderr "bs.uncurry") + end ; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external v4 : + (int -> int -> int [@bs.uncurry]) = "" + [@@bs.val] + + |} in + (* Ounit_cmd_util.debug_output should_err ; *) + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring + should_err.stderr "bs.uncurry") + end ; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + {js| \uFFF|js} + |} in + OUnit.assert_bool __LOC__ (not @@ Ext_string.is_empty should_err.stderr) + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external mk : int -> ([`a|`b] [@bs.string]) = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ (not @@ Ext_string.is_empty should_err.stderr) + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external mk : int -> ([`a|`b] ) = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ ( Ext_string.is_empty should_err.stderr) + (* give a warning or ? + ( [`a | `b ] [@bs.string] ) + (* auto-convert to ocaml poly-variant *) + *) + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + type t + external mk : int -> (_ [@bs.as {json| { x : 3 } |json}]) -> t = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ (Ext_string.contain_substring should_err.stderr "Invalid json literal") + end + ; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + type t + external mk : int -> (_ [@bs.as {json| { "x" : 3 } |json}]) -> t = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ (Ext_string.is_empty should_err.stderr) + end + ; + (* #1510 *) + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + let should_fail = fun [@bs.this] (Some x) y u -> y + u + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "simple") + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + let should_fail = fun [@bs.this] (Some x as v) y u -> y + u + |} in + (* Ounit_cmd_util.debug_output should_err; *) + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "simple") + end; + + (* __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : string -> unit -> unit = "x.y" [@@bs.send] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "Not a valid method name") + end; *) + + + + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : int = "%identity" +|} in + OUnit.assert_bool __LOC__ + (not (Ext_string.is_empty should_err.stderr)) + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : int -> int = "%identity" +|} in + OUnit.assert_bool __LOC__ + (Ext_string.is_empty should_err.stderr) + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : int -> int -> int = "%identity" +|} in + OUnit.assert_bool __LOC__ + (not (Ext_string.is_empty should_err.stderr)) + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : (int -> int) -> int = "%identity" +|} in + OUnit.assert_bool __LOC__ + ( (Ext_string.is_empty should_err.stderr)) + + end; + + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external f : int -> (int-> int) = "%identity" +|} in + OUnit.assert_bool __LOC__ + (not (Ext_string.is_empty should_err.stderr)) + + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external foo_bar : + (_ [@bs.as "foo"]) -> + string -> + string = "bar" + [@@bs.send] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "Ill defined attribute") + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + let bla4 foo x y = foo##(method1 x y [@bs]) + |} in + (* Ounit_cmd_util.debug_output should_err ; *) + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr + "Unused") + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + external mk : int -> + ( + [`a|`b] + [@bs.string] + ) = "" [@@bs.val] + |} in + (* Ounit_cmd_util.debug_output should_err ; *) + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr + "Unused") + end; + __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + type -'a t = {k : 'a } [@@bs.deriving abstract] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "contravariant") + end; + (* __LOC__ >:: begin fun _ -> + let should_err = bsc_check_eval {| + type 'a t = {k : int -> 'a } [@@bs.deriving abstract] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring should_err.stderr "not allowed") + end *) + (* __LOC__ >:: begin fun _ -> *) + (* let should_infer = perform_bsc [| "-i"; "-bs-eval"|] {| *) + (* let f = fun [@bs] x -> let (a,b) = x in a + b *) + (* |} in *) + (* let infer_type = bsc_eval (Printf.sprintf {| *) + + (* let f : %s = fun [@bs] x -> let (a,b) = x in a + b *) + (* |} should_infer.stdout ) in *) + (* begin *) + (* Ounit_cmd_util.debug_output should_infer ; *) + (* Ounit_cmd_util.debug_output infer_type ; *) + (* OUnit.assert_bool __LOC__ *) + (* ((Ext_string.is_empty infer_type.stderr)) *) + (* end *) + (* end *) + ] + + +end +module Bs_exception : sig +#1 "bs_exception.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. *) + +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string +(* +TODO: In the futrue, we should refine dependency [bsb] +should not rely on such exception, it should have its own exception handling +*) + +(* exception Error of error *) + +(* val report_error : Format.formatter -> error -> unit *) + +val error : error -> 'a + +end = struct +#1 "bs_exception.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. *) + + +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string + (** TODO: we need add location handling *) +exception Error of error + +let error err = raise (Error err) + +let report_error ppf = function + | Dependency_script_module_dependent_not s + -> + Format.fprintf ppf + "%s is compiled in script mode while its dependent is not" + s + | Missing_ml_dependency s -> + Format.fprintf ppf "Missing dependency %s in search path" s + | Cmj_not_found s -> + Format.fprintf ppf "%s not found, it means either the module does not exist or it is a namespace" 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@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_space + Format.pp_print_string) + str + | Bs_duplicate_exports str -> + Format.fprintf ppf "%s are exported as twice" str + | Bs_duplicated_module (a,b) + -> + Format.fprintf ppf "The build system does not support two files with same names yet %s, %s" a b + | Bs_main_not_exist main + -> + Format.fprintf ppf "File %s not found " main + + | Bs_package_not_found package + -> + Format.fprintf ppf "Package %s not found or %s/lib/ocaml does not exist or please set npm_config_prefix correctly" + package package + | Bs_invalid_path path + -> Format.pp_print_string ppf ("Invalid path: " ^ path ) + + +let () = + Location.register_error_of_exn + (function + | Error err + -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) + +end +module Ext_format : sig +#1 "ext_format.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. *) + + + + + + + + +(** Simplified wrapper module for the standard library [Format] module. + *) + +type t = private Format.formatter + +val string : t -> string -> unit + +val break : t -> unit + +val break1 : t -> unit + +val space : t -> unit + +val group : t -> int -> (unit -> 'a) -> 'a +(** [group] will record current indentation + and indent futher + *) + +val vgroup : t -> int -> (unit -> 'a) -> 'a + +val paren : t -> (unit -> 'a) -> 'a + +val paren_group : t -> int -> (unit -> 'a) -> 'a + +val brace_group : t -> int -> (unit -> 'a) -> 'a + +val brace_vgroup : t -> int -> (unit -> 'a) -> 'a + +val bracket_group : t -> int -> (unit -> 'a) -> 'a + +val newline : t -> unit + +val to_out_channel : out_channel -> t + +val flush : t -> unit -> unit + +val pp_print_queue : + ?pp_sep:(Format.formatter -> unit -> unit) -> + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Queue.t -> unit + +end = struct +#1 "ext_format.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. *) + + + + + + + + +open Format + +type t = formatter + +let string = pp_print_string + +let break = fun fmt -> pp_print_break fmt 0 0 + +let break1 = + fun fmt -> pp_print_break fmt 0 1 + +let space fmt = + pp_print_break fmt 1 0 + +let vgroup fmt indent u = + pp_open_vbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let group fmt indent u = + pp_open_hovbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let paren fmt u = + string fmt "("; + let v = u () in + string fmt ")"; + v + +let brace fmt u = + string fmt "{"; + (* break1 fmt ; *) + let v = u () in + string fmt "}"; + v + +let bracket fmt u = + string fmt "["; + let v = u () in + string fmt "]"; + v + +let paren_group st n action = + group st n (fun _ -> paren st action) + +let brace_group st n action = + group st n (fun _ -> brace st action ) + +let brace_vgroup st n action = + vgroup st n (fun _ -> + string st "{"; + pp_print_break st 0 2; + let v = vgroup st 0 action in + pp_print_break st 0 0; + string st "}"; + v + ) +let bracket_group st n action = + group st n (fun _ -> bracket st action) + +let newline fmt = pp_print_newline fmt () + +let to_out_channel = formatter_of_out_channel + +(* let non_breaking_space fmt = string fmt " " *) +(* let set_needed_space_function _ _ = () *) +let flush = pp_print_flush + +let list = pp_print_list + +let rec pp_print_queue ?(pp_sep = pp_print_cut) pp_v ppf q = + Queue.iter (fun q -> pp_v ppf q ; pp_sep ppf ()) q + +end +module Ext_ref : sig +#1 "ext_ref.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. *) + +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) + +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b + +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b + +end = struct +#1 "ext_ref.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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res + +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e + +end +module Js_config : sig +#1 "js_config.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 get_packages_info : + unit -> Js_packages_info.t *) + + +(** set/get header *) +val no_version_header : bool ref + + +(** return [package_name] and [path] + when in script mode: +*) + +(* val get_current_package_name_and_path : + Js_packages_info.module_system -> + Js_packages_info.info_query *) + + +(* val set_package_name : string -> unit +val get_package_name : unit -> string option *) + +(** cross module inline option *) +val cross_module_inline : bool ref +val set_cross_module_inline : bool -> unit +val get_cross_module_inline : unit -> bool + +(** diagnose option *) +val diagnose : bool ref +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit + + +(** options for builtin ppx *) +val no_builtin_ppx_ml : bool ref +val no_builtin_ppx_mli : bool ref + + + +val no_warn_unimplemented_external : bool ref + +(** check-div-by-zero option *) +val check_div_by_zero : bool ref +val get_check_div_by_zero : unit -> bool + + + + + +(** Debugging utilies *) +val set_current_file : string -> unit +val get_current_file : unit -> string +val get_module_name : unit -> string + +val iset_debug_file : string -> unit +val set_debug_file : string -> unit +val get_debug_file : unit -> string + +val is_same_file : unit -> bool + +val tool_name : string + + +val sort_imports : bool ref +val dump_js : bool ref +val syntax_only : bool ref +val binary_ast : bool ref + + +val bs_suffix : bool ref +val debug : bool ref + +val cmi_only : bool ref +val force_cmi : bool ref +val force_cmj : bool ref +end = struct +#1 "js_config.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 add_npm_package_path s = + match !packages_info with + | Empty -> + Ext_pervasives.bad_argf "please set package name first using -bs-package-name "; + | NonBrowser(name, envs) -> + let env, path = + match Ext_string.split ~keep_empty:false s ':' with + | [ package_name; path] -> + (match Js_packages_info.module_system_of_string package_name with + | Some x -> x + | None -> + Ext_pervasives.bad_argf "invalid module system %s" package_name), path + | [path] -> + NodeJS, path + | _ -> + Ext_pervasives.bad_argf "invalid npm package path: %s" s + in + packages_info := NonBrowser (name, ((env,path) :: envs)) *) +(** Browser is not set via command line only for internal use *) + + +let no_version_header = ref false + +let cross_module_inline = ref false + +let get_cross_module_inline () = !cross_module_inline +let set_cross_module_inline b = + cross_module_inline := b + + +let diagnose = ref false +let get_diagnose () = !diagnose +let set_diagnose b = diagnose := b + +let (//) = Filename.concat + +(* let get_packages_info () = !packages_info *) + +let no_builtin_ppx_ml = ref false +let no_builtin_ppx_mli = ref false + + +(** TODO: will flip the option when it is ready *) +let no_warn_unimplemented_external = ref false +let current_file = ref "" +let debug_file = ref "" + +let set_current_file f = current_file := f +let get_current_file () = !current_file +let get_module_name () = + Filename.chop_extension + (Filename.basename (Ext_string.uncapitalize_ascii !current_file)) + +let iset_debug_file _ = () +let set_debug_file f = debug_file := f +let get_debug_file () = !debug_file + + +let is_same_file () = + !debug_file <> "" && !debug_file = !current_file + +let tool_name = "BuckleScript" + +let check_div_by_zero = ref true +let get_check_div_by_zero () = !check_div_by_zero + + + + +let sort_imports = ref true +let dump_js = ref false + + + +let syntax_only = ref false +let binary_ast = ref false + +let bs_suffix = ref false + +let debug = ref false + +let cmi_only = ref false +let force_cmi = ref false +let force_cmj = ref false +end +module Ml_binary : sig +#1 "ml_binary.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. *) + + + +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind + + +val read_ast : 'a kind -> in_channel -> 'a + +val write_ast : + 'a kind -> string -> 'a -> out_channel -> unit +end = struct +#1 "ml_binary.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. *) + + +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind + +(** [read_ast kind ic] assume [ic] channel is + in the right position *) +let read_ast (type t ) (kind : t kind) ic : t = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + let buffer = really_input_string ic (String.length magic) in + assert(buffer = magic); (* already checked by apply_rewriter *) + Location.input_name := input_value ic; + input_value ic + +let write_ast (type t) (kind : t kind) + (fname : string) + (pt : t) oc = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + output_string oc magic ; + output_value oc fname; + output_value oc pt +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" + + (* not suporting nested if here..*) +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];; + +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + + +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@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 + + (** return the key found in the hashtbl. + Use case: when you find the key existed in hashtbl, + you want to use the one stored in the hashtbl. + (they are semantically equivlanent, but may have other information different) + *) + val find_key_opt: 'a t -> key -> key option + + val find_default: 'a t -> key -> 'a -> 'a + + val replace: 'a t -> key -> 'a -> unit + val mem: 'a t -> key -> bool + val iter: 'a t -> (key -> 'a -> unit) -> 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 h f = + 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 = + Ext_array.fold_left h.data 0 (fun m b -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + {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_key_opt eq key (lst : _ bucketlist) : _ option = + match lst with + | Empty -> None + | Cons(k1,d1,rest1) -> + if eq key k1 then Some k1 else + match rest1 with + | Empty -> None + | Cons(k2,d2,rest2) -> + if eq key k2 then Some k2 else + match rest2 with + | Empty -> None + | Cons(k3,d3,rest3) -> + if eq key k3 then Some k3 else + small_bucket_key_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 "ext/hashtbl.cppo.ml" +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 h_data = h.data in + Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); + 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 + let h_data = h.data in + if find_bucket (Array.unsafe_get h_data i) then + begin + Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get 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 rec remove_bucket key (h : _ t) (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 key h next) + +let remove (h : _ t ) key = + let i = key_index h key in + let h_data = h.data in + let old_h_szie = h.size in + let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in + if old_h_szie <> h.size then + Array.unsafe_set h_data i new_bucket + +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 Array.unsafe_get 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_key_opt (h : _ t) key = + Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in + let l = Array.unsafe_get h_data i in + try + Array.unsafe_set h_data i (replace_bucket l) + with Not_found -> + begin + Array.unsafe_set 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; + end + +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 (Array.unsafe_get h.data (key_index h key)) + + +let of_list2 ks vs = + let len = List.length ks in + let map = create len in + List.iter2 (fun k v -> add map k v) ks vs ; + map + + +end +module Ast_extract : sig +#1 "ast_extract.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. *) + + + + + + + + + +module String_set = Depend.StringSet + +val read_parse_and_extract : 'a Ml_binary.kind -> 'a -> String_set.t + +type ('a,'b) t + +val sort_files_by_dependencies : + domain:String_set.t -> String_set.t String_map.t -> string Queue.t + + +val sort : + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + ('a, 'b) t String_map.t -> string Queue.t + + + +(** + [build fmt files parse_implementation parse_interface] + Given a list of files return an ast table +*) +val collect_ast_map : + Format.formatter -> + string list -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a, 'b) t String_map.t + +type dir_spec = + { dir : string ; + mutable excludes : string list + } + +(** If the genereated queue is empty, it means + 1. The main module does not exist (does not exist due to typo) + 2. It does exist but not in search path + The order matters from head to tail +*) +val collect_from_main : + ?extra_dirs:dir_spec list -> + ?excludes : string list -> + ?alias_map: string String_hashtbl.t -> + Format.formatter -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + string -> ('a, 'b) t String_map.t * string Queue.t + +val build_queue : + Format.formatter -> + string Queue.t -> + ('b, 'c) t String_map.t -> + (Format.formatter -> string -> string -> 'b -> unit) -> + (Format.formatter -> string -> string -> 'c -> unit) -> unit + +val handle_queue : + Format.formatter -> + string Queue.t -> + ('a, 'b) t String_map.t -> + (string -> string -> 'a -> unit) -> + (string -> string -> 'b -> unit) -> + (string -> string -> string -> 'b -> 'a -> unit) -> unit + + +val build_lazy_queue : + Format.formatter -> + string Queue.t -> + (Parsetree.structure lazy_t, Parsetree.signature lazy_t) t String_map.t -> + (Format.formatter -> string -> string -> Parsetree.structure -> unit) -> + (Format.formatter -> string -> string -> Parsetree.signature -> unit) -> unit + + + +end = struct +#1 "ast_extract.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. *) + +type module_name = private string + +module String_set = Depend.StringSet + +(* FIXME: [Clflags.open_modules] seems not to be properly used *) + +module SMap = Depend.StringMap +let bound_vars = SMap.empty + + +type 'a kind = 'a Ml_binary.kind + + +let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = + Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> + List.iter + (fun modname -> + + ignore @@ + + Depend.open_module bound_vars (Longident.Lident modname)) + (!Clflags.open_modules); + (match k with + | Ml_binary.Ml -> Depend.add_implementation bound_vars ast + | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); + !Depend.free_structure_names + end + +type ('a,'b) ast_info = + | Ml of + string * (* sourcefile *) + 'a * + string (* opref *) + | Mli of string * (* sourcefile *) + 'b * + string (* opref *) + | Ml_mli of + string * (* sourcefile *) + 'a * + string * (* opref1 *) + string * (* sourcefile *) + 'b * + string (* opref2*) + +type ('a,'b) t = + { module_name : string ; ast_info : ('a,'b) ast_info } + + +(* only visit nodes that are currently in the domain *) +(* https://en.wikipedia.org/wiki/Topological_sorting *) +(* dfs *) +let sort_files_by_dependencies ~(domain : String_set.t) (dependency_graph : String_set.t String_map.t) : + string Queue.t = + let next current = + String_map.find_exn dependency_graph current in + let worklist = ref domain in + let result = Queue.create () in + let rec visit (visiting : String_set.t) path (current : string) = + let next_path = current :: path in + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends next_path) + else if String_set.mem current !worklist then + begin + let next_set = String_set.add current visiting in + next current |> + String_set.iter + (fun node -> + if String_map.mem dependency_graph node then + visit next_set next_path node) + ; + worklist := String_set.remove current !worklist; + Queue.push current result ; + end in + while not (String_set.is_empty !worklist) do + visit String_set.empty [] (String_set.choose !worklist) + done; + if Js_config.get_diagnose () then + Format.fprintf Format.err_formatter + "Order: @[%a@]@." + (Ext_format.pp_print_queue + ~pp_sep:Format.pp_print_space + Format.pp_print_string) + result ; + result +;; + + + +let sort project_ml project_mli (ast_table : _ t String_map.t) = + let domain = + String_map.fold ast_table String_set.empty + (fun k _ acc -> String_set.add k acc) + in + let h = + String_map.map ast_table + (fun + ({ast_info}) + -> + match ast_info with + | Ml (_, ast, _) + -> + read_parse_and_extract Ml (project_ml ast) + | Mli (_, ast, _) + -> + read_parse_and_extract Mli (project_mli ast) + | Ml_mli (_, impl, _, _, intf, _) + -> + String_set.union + (read_parse_and_extract Ml (project_ml impl)) + (read_parse_and_extract Mli (project_mli intf)) + ) in + sort_files_by_dependencies ~domain h + +(** same as {!Ocaml_parse.check_suffix} but does not care with [-c -o] option*) +let check_suffix name = + if Ext_path.check_suffix_case name ".ml" + || Ext_path.check_suffix_case name ".mlt" then + `Ml, + Ext_path.chop_extension_if_any name + else if Ext_path.check_suffix_case name !Config.interface_suffix then + `Mli, Ext_path.chop_extension_if_any name + else + raise(Arg.Bad("don't know what to do with " ^ name)) + + +let collect_ast_map ppf files parse_implementation parse_interface = + Ext_list.fold_left files String_map.empty + (fun acc source_file -> + match check_suffix source_file with + | `Ml, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = + (Ml (source_file, parse_implementation + ppf source_file, opref)); + module_name ; + } + | {ast_info = (Ml (source_file2, _, _) + | Ml_mli(source_file2, _, _,_,_,_))} -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Mli (source_file2, intf, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli (source_file, + parse_implementation ppf source_file, + opref, + source_file2, + intf, + opref2 + ); + module_name} + end + | `Mli, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = (Mli (source_file, parse_interface + ppf source_file, opref)); + module_name } + | {ast_info = + (Mli (source_file2, _, _) | + Ml_mli(_,_,_,source_file2,_,_)) } -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Ml (source_file2, impl, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli + (source_file2, + impl, + opref2, + source_file, + parse_interface ppf source_file, + opref + ); + module_name} + end + ) +;; +type dir_spec = + { dir : string ; + mutable excludes : string list + } + +let collect_from_main + ?(extra_dirs=[]) + ?(excludes=[]) + ?alias_map + (ppf : Format.formatter) + parse_implementation + parse_interface + project_impl + project_intf + main_module = + let files = + Ext_list.fold_left extra_dirs [] (fun acc dir_spec -> + let dirname, excludes = + match dir_spec with + | { dir = dirname; excludes = dir_excludes} -> + (* dirname, excludes *) + (* | `Dir_with_excludes (dirname, dir_excludes) -> *) + dirname, + (Ext_list.flat_map_append + dir_excludes excludes + (fun x -> [x ^ ".ml" ; x ^ ".mli" ]) + ) + in + Ext_array.fold_left (Sys.readdir dirname) acc (fun acc source_file -> + if (Ext_string.ends_with source_file ".ml" || + Ext_string.ends_with source_file ".mli" ) + && (* not_excluded source_file *) (not (List.mem source_file excludes)) + then + (Filename.concat dirname source_file) :: acc else acc + ) ) + in + let ast_table = collect_ast_map ppf files parse_implementation parse_interface in + let visited = String_hashtbl.create 31 in + let result = Queue.create () in + let next module_name : String_set.t = + let module_set = + match String_map.find_exn ast_table module_name with + | exception _ -> String_set.empty + | {ast_info = Ml (_, impl, _)} -> + read_parse_and_extract Ml (project_impl impl) + | {ast_info = Mli (_, intf,_)} -> + read_parse_and_extract Mli (project_intf intf) + | {ast_info = Ml_mli(_, impl, _, _, intf, _)} + -> + String_set.union + (read_parse_and_extract Ml (project_impl impl)) + (read_parse_and_extract Mli (project_intf intf)) + in + match alias_map with + | None -> module_set + | Some map -> + String_set.fold (fun x acc -> String_set.add (String_hashtbl.find_default map x x) acc ) module_set String_set.empty + in + let rec visit visiting path current = + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends (current::path)) + else + if not (String_hashtbl.mem visited current) + && String_map.mem ast_table current then + begin + String_set.iter + (visit + (String_set.add current visiting) + (current::path)) + (next current) ; + Queue.push current result; + String_hashtbl.add visited current (); + end in + visit (String_set.empty) [] main_module ; + ast_table, result + + +let build_queue ppf queue + (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue + |> Queue.iter + (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,ast, opref)} + -> + after_parsing_impl ppf source_file + opref ast + | {ast_info = Mli (source_file,ast,opref) ; } + -> + after_parsing_sig ppf source_file + opref ast + | {ast_info = Ml_mli(source_file1,impl,opref1,source_file2,intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +let handle_queue + ppf + queue ast_table + decorate_module_only + decorate_interface_only + decorate_module = + queue + |> Queue.iter + (fun base -> + match (String_map.find_exn ast_table base ).ast_info with + | exception Not_found -> assert false + | Ml (ml_name, ml_content, _) + -> + decorate_module_only base ml_name ml_content + | Mli (mli_name , mli_content, _) -> + decorate_interface_only base mli_name mli_content + | Ml_mli (ml_name, ml_content, _, mli_name, mli_content, _) + -> + decorate_module base mli_name ml_name mli_content ml_content + + ) + + + +let build_lazy_queue ppf queue (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue |> Queue.iter (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,lazy ast, opref)} + -> + after_parsing_impl ppf source_file opref ast + | {ast_info = Mli (source_file,lazy ast,opref) ; } + -> + after_parsing_sig ppf source_file opref ast + | {ast_info = Ml_mli(source_file1,lazy impl,opref1,source_file2,lazy intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +end +module Ounit_depends_format_test += struct +#1 "ounit_depends_format_test.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) (xs : string list) (ys : string list) = + OUnit.assert_equal xs ys + ~printer:(fun xs -> String.concat "," xs ) + +let f (x : string) = + let stru = Parse.implementation (Lexing.from_string x) in + Ast_extract.String_set.elements (Ast_extract.read_parse_and_extract Ml_binary.Ml stru) + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + f {|module X = List|} =~ ["List"]; + f {|module X = List module X0 = List1|} =~ ["List";"List1"] + end + ] +end +module Ounit_ffi_error_debug_test += struct +#1 "ounit_ffi_error_debug_test.ml" +let (//) = Filename.concat + + + + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + + + +let bsc_eval = Ounit_cmd_util.bsc_check_eval + +let debug_output = Ounit_cmd_util.debug_output + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + let output = bsc_eval {| +external err : + hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> _ = "" [@@bs.obj] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + __LOC__ >:: begin fun _ -> +let output = bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> _ = "" [@@bs.obj] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + __LOC__ >:: begin fun _ -> + let output = bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b of string ] [@bs.string]) -> + unit -> unit = "" [@@bs.val] + |} in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end; + + __LOC__ >:: begin fun _ -> + (** + Each [@bs.unwrap] variant constructor requires an argument + *) + let output = + bsc_eval {| + external err : + ?hi_should_error:([`a of int | `b] [@bs.unwrap]) -> unit -> unit = "" [@@bs.val] + |} + in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "bs.unwrap") + end; + + __LOC__ >:: begin fun _ -> + (** + [@bs.unwrap] args are not supported in [@@bs.obj] functions + *) + let output = + bsc_eval {| + external err : + ?hi_should_error:([`a of int] [@bs.unwrap]) -> unit -> _ = "" [@@bs.obj] + |} + in + OUnit.assert_bool __LOC__ + (Ext_string.contain_substring output.stderr "hi_should_error") + end + + ] + +end +module Hash_set_gen += struct +#1 "hash_set_gen.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. *) + + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) + +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a list array; (* the buckets *) + initial_size: int; (* initial array size *) + } + + + + +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; data = Array.make s [] } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + Array.unsafe_set h.data i [] + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size [ ] + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + +let iter h f = + let rec do_bucket = function + | [ ] -> + () + | k :: rest -> + f k ; 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 h init f = + let rec do_bucket b accu = + match b with + [ ] -> + accu + | k :: rest -> + do_bucket rest (f k accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu + +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 [ ] in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + [ ] -> () + | key :: rest -> + let nidx = indexfun h key in + ndata.(nidx) <- key :: ndata.(nidx); + insert_bucket rest + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + +let elements set = + fold set [] (fun k acc -> k :: acc) + + + + +let stats h = + let mbl = + Ext_array.fold_left h.data 0 (fun m b -> max m (List.length b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = List.length b in + histo.(l) <- histo.(l) + 1) + ; + {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 key lst = + match lst with + | [] -> false + | key1::rest -> + eq_key key key1 || + match rest with + | [] -> false + | key2 :: rest -> + eq_key key key2 || + match rest with + | [] -> false + | key3 :: rest -> + eq_key key key3 || + small_bucket_mem eq_key key rest + +let rec remove_bucket eq_key key (h : _ t) buckets = + match buckets with + | [ ] -> + [ ] + | k :: next -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else k :: remove_bucket eq_key key h next + +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + val copy: t -> t + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val elements : t -> key list +end + +end +module Hash_set : sig +#1 "hash_set.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. *) + +(** Ideas are based on {!Hashtbl}, + however, {!Hashtbl.add} does not really optimize and has a bad semantics for {!Hash_set}, + This module fixes the semantics of [add]. + [remove] is not optimized since it is not used too much +*) + + + + + +module Make ( H : Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) +(** A naive t implementation on top of [hashtbl], the value is [unit]*) + + +end = struct +#1 "hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 43 "ext/hash_set.cppo.ml" +module Make (H: Hashtbl.HashedType) : (Hash_set_gen.S with type key = H.t) = struct +type key = H.t +let eq_key = H.equal +let key_index (h : _ Hash_set_gen.t ) key = + (H.hash key) land (Array.length h.data - 1) +type t = key Hash_set_gen.t + + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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)) + +# 124 "ext/hash_set.cppo.ml" +end + + +end +module Hash_set_poly : sig +#1 "hash_set_poly.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. *) + + +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 -> 'a -> unit +val remove : 'a t -> 'a -> unit + +val mem : 'a t -> 'a -> bool + +val iter : 'a t -> ('a -> unit) -> unit + +val elements : 'a t -> 'a list + +val length : 'a t -> int + +val stats: 'a t -> Hashtbl.statistics + +end = struct +#1 "hash_set_poly.ml" +# 1 "ext/hash_set.cppo.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. *) +# 51 "ext/hash_set.cppo.ml" +[@@@ocaml.warning "-3"] +(* we used cppo the mixture does not work*) +external seeded_hash_param : + int -> int -> int -> 'a -> int = "caml_hash" "noalloc" +let key_index (h : _ Hash_set_gen.t ) (key : 'a) = + seeded_hash_param 10 100 0 key land (Array.length h.data - 1) +let eq_key = (=) +type 'a t = 'a Hash_set_gen.t + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Ordered_hash_set_gen += struct +#1 "ordered_hash_set_gen.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. *) + +module type S = +sig + type key + type t + val create: int -> t + val clear: t -> unit + val reset: t -> unit + val copy: t -> t + val add: t -> key -> unit + val mem: t -> key -> bool + val rank: t -> key -> int (* -1 if not found*) + val iter: (key -> int -> unit) -> t -> unit + val fold: (key -> int -> 'b -> 'b) -> t -> 'b -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val choose_exn: t -> key + val of_array: key array -> t + val to_sorted_array: t -> key array + val replace: t -> key -> key -> unit + val reset_to_list : t -> key list -> unit + exception Replace_failure of bool +end + +exception Replace_failure of bool + + +(** when it is true, it means the old key does not exist , + when it is false, it means the new key already exist + *) + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) +type 'a bucket = + | Empty + | Cons of 'a * int * 'a bucket + +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a bucket array; + mutable data_mask: int ; + initial_size: int; + } +(* Invariant + [data_mask = Array.length data - 1 ] + [Array.length data is power of 2] +*) + + +let create initial_size = + let initial_size = Ext_util.power_2_above 16 initial_size in + { initial_size ; + size = 0; + data = Array.make initial_size Empty; + data_mask = initial_size - 1 ; + } + +let clear h = + h.size <- 0; + let h_data = h.data in + for i = 0 to h.data_mask do + Array.unsafe_set h_data i Empty + done + +(** Note this function is only used internally, make sure [h_initial_size] + is a power of 16 *) +let reset_with_size h h_initial_size = + h.size <- 0; + h.data <- Array.make h_initial_size Empty; + h.data_mask <- h_initial_size - 1 + +let reset h = + reset_with_size h h.initial_size + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + + +let rec insert_bucket nmask ndata hash = function + | Empty -> () + | Cons(key,info,rest) -> + let nidx = hash key land nmask in (* so that indexfun sees the new bucket count *) + Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); + insert_bucket nmask ndata hash rest + +let resize hash h = + let odata = h.data in + let odata_mask = h.data_mask in + let nsize = (odata_mask + 1) * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + h.data <- ndata; + let nmask = nsize - 1 in + h.data_mask <- nmask ; + for i = 0 to odata_mask do + match Array.unsafe_get odata i with + | Empty -> () + | Cons(key,info,rest) -> + let nidx = hash key land nmask in + Array.unsafe_set ndata nidx (Cons(key,info, (Array.unsafe_get ndata nidx))); + insert_bucket nmask ndata hash rest + done + end + + +let rec do_bucket f = function + | Empty -> + () + | Cons(k ,i, rest) -> + f k i ; do_bucket f rest + +let iter f h = + let d = h.data in + for i = 0 to h.data_mask do + do_bucket f (Array.unsafe_get d i) + done + +(* find one element *) +let choose_exn h = + let rec aux arr offset last_index = + if offset > last_index then + raise Not_found (* This happens when size is 0, otherwise it is never called *) + else + match Array.unsafe_get arr offset with + | Empty -> aux arr (offset + 1) last_index + | Cons (k,_,rest) -> k + in + let h_data = h.data in + aux h_data 0 h.data_mask + +let fold f h init = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons( k , i, rest) -> + do_bucket rest (f k i accu) in + let d = h.data in + let accu = ref init in + for i = 0 to h.data_mask do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu + + +let rec set_bucket arr = function + | Empty -> () + | Cons(k,i,rest) -> + Array.unsafe_set arr i k; + set_bucket arr rest + +let to_sorted_array h = + if h.size = 0 then [||] + else + let v = choose_exn h in + let arr = Array.make h.size v in + let d = h.data in + for i = 0 to h.data_mask do + set_bucket arr (Array.unsafe_get d i) + done; + arr + + + + +let rec bucket_length acc (x : _ bucket) = + match x with + | Empty -> acc + | Cons(_,_,rest) -> bucket_length (acc + 1) rest + +let stats h = + let mbl = + Ext_array.fold_left h.data 0 (fun m (b : _ bucket) -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + { Hashtbl.num_bindings = h.size; + num_buckets = h.data_mask + 1 ; + max_bucket_length = mbl; + bucket_histogram = histo } + + +end +module Ordered_hash_set_string : sig +#1 "ordered_hash_set_string.mli" + + + + +include Ordered_hash_set_gen.S with type key = string +end = struct +#1 "ordered_hash_set_string.ml" + +# 11 "ext/ordered_hash_set.cppo.ml" + type key = string + type t = key Ordered_hash_set_gen.t + let hash = Bs_hash_stubs.hash_string + let equal_key = Ext_string.equal + +# 24 +open Ordered_hash_set_gen +exception Replace_failure = Replace_failure +let create = create +let clear = clear +let reset = reset +let copy = copy +let iter = iter +let fold = fold +let length = length +let stats = stats +let choose_exn = choose_exn +let to_sorted_array = to_sorted_array + + + +let rec small_bucket_mem key lst = + match lst with + | Empty -> false + | Cons(key1,_, rest) -> + equal_key key key1 || + match rest with + | Empty -> false + | Cons(key2 , _, rest) -> + equal_key key key2 || + match rest with + | Empty -> false + | Cons(key3,_, rest) -> + equal_key key key3 || + small_bucket_mem key rest + +let rec small_bucket_rank key lst = + match lst with + | Empty -> -1 + | Cons(key1,i,rest) -> + if equal_key key key1 then i + else match rest with + | Empty -> -1 + | Cons(key2,i2, rest) -> + if equal_key key key2 then i2 else + match rest with + | Empty -> -1 + | Cons(key3,i3, rest) -> + if equal_key key key3 then i3 else + small_bucket_rank key rest + +let add h key = + let h_data_mask = h.data_mask in + let i = hash key land h_data_mask in + if not (small_bucket_mem key h.data.(i)) then + begin + Array.unsafe_set h.data i (Cons(key,h.size, Array.unsafe_get h.data i)); + h.size <- h.size + 1 ; + if h.size > Array.length h.data lsl 1 then resize hash h + end + +let old_key_not_exist = Replace_failure false +let new_key_already_exist = Replace_failure true + +let rec small_bucket_rank_and_delete key lst = + match lst with + | Empty -> raise old_key_not_exist + | Cons(key1,i,rest) -> + if equal_key key key1 then i, rest + else match rest with + | Empty -> raise old_key_not_exist + | Cons(key2,i2, rest) -> + if equal_key key key2 then i2, (Cons (key1,i,rest)) else + match rest with + | Empty -> raise old_key_not_exist + | Cons(key3,i3, rest) -> + if equal_key key key3 then i3, (Cons (key1,i,Cons(key2,i2,rest))) else + let (rank, rest ) = small_bucket_rank_and_delete key rest in + rank, Cons (key1,i, + Cons (key2,i2, + Cons(key3,i3,rest))) + +let replace h old_key new_key = + let h_data_mask = h.data_mask in + let i = hash old_key land h_data_mask in + let h_data = h.data in + let bucket = Array.unsafe_get h_data i in + let (rank,new_bucket) = small_bucket_rank_and_delete old_key bucket in + Array.unsafe_set h_data i new_bucket ; + + let j = hash new_key land h_data_mask in + let insert_bucket = Array.unsafe_get h_data j in + let mem = small_bucket_mem new_key insert_bucket in + if mem then raise new_key_already_exist + else + Array.unsafe_set h_data j (Cons (new_key,rank, insert_bucket)) + +let of_array arr = + let len = Array.length arr in + let h = create len in + for i = 0 to len - 1 do + add h (Array.unsafe_get arr i) + done; + h + +(* clear the Hashset and re-initialize it to [lst] *) +let reset_to_list h lst = + let len = List.length lst in + let () = Ordered_hash_set_gen.reset_with_size h (Ext_util.power_2_above 16 len) in + List.iter (fun x -> add h x ) lst + +let mem h key = + small_bucket_mem key (Array.unsafe_get h.data (hash key land h.data_mask)) + +let rank h key = + small_bucket_rank key (Array.unsafe_get h.data (hash key land h.data_mask)) + + + + + + + + + + + + + +end +module String_hash_set : sig +#1 "string_hash_set.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 Hash_set_gen.S with type key = string + +end = struct +#1 "string_hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 31 "ext/hash_set.cppo.ml" +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 + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Ounit_hash_set_tests += struct +#1 "ounit_hash_set_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +type id = { name : string ; stamp : int } + +module Id_hash_set = Hash_set.Make(struct + type t = id + let equal x y = x.stamp = y.stamp && x.name = y.name + let hash x = Hashtbl.hash x.stamp + end + ) + +let const_tbl = [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "100"; "99"; "98"; + "97"; "96"; "95"; "94"; "93"; "92"; "91"; "90"; "89"; "88"; "87"; "86"; "85"; + "84"; "83"; "82"; "81"; "80"; "79"; "78"; "77"; "76"; "75"; "74"; "73"; "72"; + "71"; "70"; "69"; "68"; "67"; "66"; "65"; "64"; "63"; "62"; "61"; "60"; "59"; + "58"; "57"; "56"; "55"; "54"; "53"; "52"; "51"; "50"; "49"; "48"; "47"; "46"; + "45"; "44"; "43"; "42"; "41"; "40"; "39"; "38"; "37"; "36"; "35"; "34"; "33"; + "32"; "31"; "30"; "29"; "28"; "27"; "26"; "25"; "24"; "23"; "22"; "21"; "20"; + "19"; "18"; "17"; "16"; "15"; "14"; "13"; "12"; "11"|] +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 31 in + for i = 0 to 1000 do + Hash_set_poly.add v i + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1001 + end ; + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 31 in + for i = 0 to 1_0_000 do + Hash_set_poly.add v 0 + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1 + end ; + __LOC__ >:: begin fun _ -> + let v = Hash_set_poly.create 30 in + for i = 0 to 2_000 do + Hash_set_poly.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + Hash_set_poly.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + assert (Hash_set_poly.mem v {name = "x"; stamp = i}) + done; + OUnit.assert_equal (Hash_set_poly.length v) 2_001; + for i = 1990 to 3_000 do + Hash_set_poly.remove v {name = "x"; stamp = i} + done ; + OUnit.assert_equal (Hash_set_poly.length v) 1990; + (* OUnit.assert_equal (Hash_set.stats v) *) + (* {Hashtbl.num_bindings = 1990; num_buckets = 1024; max_bucket_length = 7; *) + (* bucket_histogram = [|139; 303; 264; 178; 93; 32; 12; 3|]} *) + end ; + __LOC__ >:: begin fun _ -> + let v = Id_hash_set.create 30 in + for i = 0 to 2_000 do + Id_hash_set.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + Id_hash_set.add v {name = "x" ; stamp = i} + done ; + for i = 0 to 2_000 do + assert (Id_hash_set.mem v {name = "x"; stamp = i}) + done; + OUnit.assert_equal (Id_hash_set.length v) 2_001; + for i = 1990 to 3_000 do + Id_hash_set.remove v {name = "x"; stamp = i} + done ; + OUnit.assert_equal (Id_hash_set.length v) 1990; + for i = 1000 to 3990 do + Id_hash_set.remove v { name = "x"; stamp = i } + done; + OUnit.assert_equal (Id_hash_set.length v) 1000; + for i = 1000 to 1100 do + Id_hash_set.add v { name = "x"; stamp = i}; + done; + OUnit.assert_equal (Id_hash_set.length v ) 1101; + for i = 0 to 1100 do + OUnit.assert_bool "exist" (Id_hash_set.mem v {name = "x"; stamp = i}) + done + (* OUnit.assert_equal (Hash_set.stats v) *) + (* {num_bindings = 1990; num_buckets = 1024; max_bucket_length = 8; *) + (* bucket_histogram = [|148; 275; 285; 182; 95; 21; 14; 2; 2|]} *) + + end + ; + __LOC__ >:: begin fun _ -> + let v = Ordered_hash_set_string.create 3 in + for i = 0 to 10 do + Ordered_hash_set_string.add v (string_of_int i) + done; + for i = 100 downto 2 do + Ordered_hash_set_string.add v (string_of_int i) + done; + OUnit.assert_equal (Ordered_hash_set_string.to_sorted_array v ) + const_tbl + end; + __LOC__ >:: begin fun _ -> + let duplicate arr = + let len = Array.length arr in + let rec aux tbl off = + if off >= len then None + else + let curr = (Array.unsafe_get arr off) in + if String_hash_set.check_add tbl curr then + aux tbl (off + 1) + else Some curr in + aux (String_hash_set.create len) 0 in + let v = [| "if"; "a"; "b"; "c" |] in + OUnit.assert_equal (duplicate v) None; + OUnit.assert_equal (duplicate [|"if"; "a"; "b"; "b"; "c"|]) (Some "b") + end; + __LOC__ >:: begin fun _ -> + let of_array lst = + let len = Array.length lst in + let tbl = String_hash_set.create len in + Ext_array.iter lst (String_hash_set.add tbl) ; tbl in + let hash = of_array const_tbl in + let len = String_hash_set.length hash in + String_hash_set.remove hash "x"; + OUnit.assert_equal len (String_hash_set.length hash); + String_hash_set.remove hash "0"; + OUnit.assert_equal (len - 1 ) (String_hash_set.length hash) + end + ] + +end +module Int_hash_set : sig +#1 "int_hash_set.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 Hash_set_gen.S with type key = int + +end = struct +#1 "int_hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 25 "ext/hash_set.cppo.ml" +type key = int +let key_index (h : _ Hash_set_gen.t ) (key : key) = + (Bs_hash_stubs.hash_int key) land (Array.length h.data - 1) +let eq_key = Ext_int.equal +type t = key Hash_set_gen.t + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Ounit_hash_stubs_test += struct +#1 "ounit_hash_stubs_test.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +let count = 2_000_000 + +let bench () = + Ounit_tests_util.time "int hash set" begin fun _ -> + let v = Int_hash_set.create 2_000_000 in + for i = 0 to count do + Int_hash_set.add v i + done ; + for i = 0 to 3 do + for i = 0 to count do + assert (Int_hash_set.mem v i) + done + done + end; + Ounit_tests_util.time "int hash set" begin fun _ -> + let v = Hash_set_poly.create 2_000_000 in + for i = 0 to count do + Hash_set_poly.add v i + done ; + for i = 0 to 3 do + for i = 0 to count do + assert (Hash_set_poly.mem v i) + done + done + end + + +type id (* = Ident.t *) = { stamp : int; name : string; mutable flags : int; } +let hash id = Bs_hash_stubs.hash_stamp_and_name id.stamp id.name +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int 0 =~ Hashtbl.hash 0 + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_int max_int =~ Hashtbl.hash max_int + end; + __LOC__ >:: begin fun _ -> + Bs_hash_stubs.hash_string "The quick brown fox jumps over the lazy dog" =~ + Hashtbl.hash "The quick brown fox jumps over the lazy dog" + end; + __LOC__ >:: begin fun _ -> + Array.init 100 (fun i -> String.make i 'a' ) + |> Array.iter (fun x -> + Bs_hash_stubs.hash_string x =~ Hashtbl.hash x) + end; + __LOC__ >:: begin fun _ -> + (** only stamp matters here *) + hash {stamp = 1 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 1 ; + hash {stamp = 11 ; name = "xx"; flags = 0} =~ Bs_hash_stubs.hash_small_int 11; + end; + __LOC__ >:: begin fun _ -> + (* only string matters here *) + hash {stamp = 0 ; name = "Pervasives"; flags = 0} =~ Bs_hash_stubs.hash_string "Pervasives"; + hash {stamp = 0 ; name = "UU"; flags = 0} =~ Bs_hash_stubs.hash_string "UU"; + end; + __LOC__ >:: begin fun _ -> + let v = Array.init 20 (fun i -> i) in + let u = Array.init 30 (fun i -> (0-i) ) in + Bs_hash_stubs.int_unsafe_blit + v 0 u 10 20 ; + OUnit.assert_equal u (Array.init 30 (fun i -> if i < 10 then -i else i - 10)) + end + ] + +end +module Ounit_hashtbl_tests += struct +#1 "ounit_hashtbl_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + +let suites = + __FILE__ + >:::[ + (* __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 _ -> + let h = String_hashtbl.create 0 in + let count = 1000 in + for j = 0 to 1 do + for i = 0 to count - 1 do + String_hashtbl.add h (string_of_int i) i + done + done ; + String_hashtbl.length h =~ 2 * count + end; + "replace semantics" >:: begin fun _ -> + let h = String_hashtbl.create 0 in + let count = 1000 in + for j = 0 to 1 do + for i = 0 to count - 1 do + String_hashtbl.replace h (string_of_int i) i + done + done ; + String_hashtbl.length h =~ count + end; + + ] + +end +module Js_reserved_map : sig +#1 "js_reserved_map.mli" +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * 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 is_reserved : + string -> bool +end = struct +#1 "js_reserved_map.ml" + +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * 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 sorted_keywords = [| + "AbortController"; + "AbortSignal"; + "ActiveXObject"; + "AnalyserNode"; + "AnimationEvent"; + "Array"; + "ArrayBuffer"; + "Atomics"; + "Attr"; + "Audio"; + "AudioBuffer"; + "AudioBufferSourceNode"; + "AudioContext"; + "AudioDestinationNode"; + "AudioListener"; + "AudioNode"; + "AudioParam"; + "AudioParamMap"; + "AudioProcessingEvent"; + "AudioScheduledSourceNode"; + "AudioWorkletNode"; + "BarProp"; + "BaseAudioContext"; + "BatteryManager"; + "BeforeInstallPromptEvent"; + "BeforeUnloadEvent"; + "BigInt"; + "BigInt64Array"; + "BigUint64Array"; + "BiquadFilterNode"; + "Blob"; + "BlobEvent"; + "BluetoothUUID"; + "Boolean"; + "BroadcastChannel"; + "Buffer"; + "ByteLengthQueuingStrategy"; + "CDATASection"; + "CSS"; + "CSSConditionRule"; + "CSSFontFaceRule"; + "CSSGroupingRule"; + "CSSImageValue"; + "CSSImportRule"; + "CSSKeyframeRule"; + "CSSKeyframesRule"; + "CSSKeywordValue"; + "CSSMathInvert"; + "CSSMathMax"; + "CSSMathMin"; + "CSSMathNegate"; + "CSSMathProduct"; + "CSSMathSum"; + "CSSMathValue"; + "CSSMatrixComponent"; + "CSSMediaRule"; + "CSSNamespaceRule"; + "CSSNumericArray"; + "CSSNumericValue"; + "CSSPageRule"; + "CSSPerspective"; + "CSSPositionValue"; + "CSSRotate"; + "CSSRule"; + "CSSRuleList"; + "CSSScale"; + "CSSSkew"; + "CSSSkewX"; + "CSSSkewY"; + "CSSStyleDeclaration"; + "CSSStyleRule"; + "CSSStyleSheet"; + "CSSStyleValue"; + "CSSSupportsRule"; + "CSSTransformComponent"; + "CSSTransformValue"; + "CSSTranslate"; + "CSSUnitValue"; + "CSSUnparsedValue"; + "CSSVariableReferenceValue"; + "CanvasCaptureMediaStreamTrack"; + "CanvasGradient"; + "CanvasPattern"; + "CanvasRenderingContext2D"; + "ChannelMergerNode"; + "ChannelSplitterNode"; + "CharacterData"; + "ClipboardEvent"; + "CloseEvent"; + "Comment"; + "CompositionEvent"; + "ConstantSourceNode"; + "ConvolverNode"; + "CountQueuingStrategy"; + "Crypto"; + "CryptoKey"; + "CustomElementRegistry"; + "CustomEvent"; + "DOMError"; + "DOMException"; + "DOMImplementation"; + "DOMMatrix"; + "DOMMatrixReadOnly"; + "DOMParser"; + "DOMPoint"; + "DOMPointReadOnly"; + "DOMQuad"; + "DOMRect"; + "DOMRectList"; + "DOMRectReadOnly"; + "DOMStringList"; + "DOMStringMap"; + "DOMTokenList"; + "DataTransfer"; + "DataTransferItem"; + "DataTransferItemList"; + "DataView"; + "Date"; + "DelayNode"; + "DeviceMotionEvent"; + "DeviceOrientationEvent"; + "Document"; + "DocumentFragment"; + "DocumentType"; + "DragEvent"; + "DynamicsCompressorNode"; + "Element"; + "EnterPictureInPictureEvent"; + "Error"; + "ErrorEvent"; + "EvalError"; + "Event"; + "EventSource"; + "EventTarget"; + "File"; + "FileList"; + "FileReader"; + "Float32Array"; + "Float64Array"; + "FocusEvent"; + "FontFace"; + "FontFaceSetLoadEvent"; + "FormData"; + "Function"; + "GainNode"; + "Gamepad"; + "GamepadButton"; + "GamepadEvent"; + "GamepadHapticActuator"; + "HTMLAllCollection"; + "HTMLAnchorElement"; + "HTMLAreaElement"; + "HTMLAudioElement"; + "HTMLBRElement"; + "HTMLBaseElement"; + "HTMLBodyElement"; + "HTMLButtonElement"; + "HTMLCanvasElement"; + "HTMLCollection"; + "HTMLContentElement"; + "HTMLDListElement"; + "HTMLDataElement"; + "HTMLDataListElement"; + "HTMLDetailsElement"; + "HTMLDialogElement"; + "HTMLDirectoryElement"; + "HTMLDivElement"; + "HTMLDocument"; + "HTMLElement"; + "HTMLEmbedElement"; + "HTMLFieldSetElement"; + "HTMLFontElement"; + "HTMLFormControlsCollection"; + "HTMLFormElement"; + "HTMLFrameElement"; + "HTMLFrameSetElement"; + "HTMLHRElement"; + "HTMLHeadElement"; + "HTMLHeadingElement"; + "HTMLHtmlElement"; + "HTMLIFrameElement"; + "HTMLImageElement"; + "HTMLInputElement"; + "HTMLLIElement"; + "HTMLLabelElement"; + "HTMLLegendElement"; + "HTMLLinkElement"; + "HTMLMapElement"; + "HTMLMarqueeElement"; + "HTMLMediaElement"; + "HTMLMenuElement"; + "HTMLMetaElement"; + "HTMLMeterElement"; + "HTMLModElement"; + "HTMLOListElement"; + "HTMLObjectElement"; + "HTMLOptGroupElement"; + "HTMLOptionElement"; + "HTMLOptionsCollection"; + "HTMLOutputElement"; + "HTMLParagraphElement"; + "HTMLParamElement"; + "HTMLPictureElement"; + "HTMLPreElement"; + "HTMLProgressElement"; + "HTMLQuoteElement"; + "HTMLScriptElement"; + "HTMLSelectElement"; + "HTMLShadowElement"; + "HTMLSlotElement"; + "HTMLSourceElement"; + "HTMLSpanElement"; + "HTMLStyleElement"; + "HTMLTableCaptionElement"; + "HTMLTableCellElement"; + "HTMLTableColElement"; + "HTMLTableElement"; + "HTMLTableRowElement"; + "HTMLTableSectionElement"; + "HTMLTemplateElement"; + "HTMLTextAreaElement"; + "HTMLTimeElement"; + "HTMLTitleElement"; + "HTMLTrackElement"; + "HTMLUListElement"; + "HTMLUnknownElement"; + "HTMLVideoElement"; + "HashChangeEvent"; + "Headers"; + "History"; + "IDBCursor"; + "IDBCursorWithValue"; + "IDBDatabase"; + "IDBFactory"; + "IDBIndex"; + "IDBKeyRange"; + "IDBObjectStore"; + "IDBOpenDBRequest"; + "IDBRequest"; + "IDBTransaction"; + "IDBVersionChangeEvent"; + "IIRFilterNode"; + "IdleDeadline"; + "Image"; + "ImageBitmap"; + "ImageBitmapRenderingContext"; + "ImageCapture"; + "ImageData"; + "Infinity"; + "InputDeviceCapabilities"; + "InputDeviceInfo"; + "InputEvent"; + "Int16Array"; + "Int32Array"; + "Int8Array"; + "IntersectionObserver"; + "IntersectionObserverEntry"; + "Intl"; + "JSON"; + "KeyboardEvent"; + "Location"; + "MIDIAccess"; + "MIDIConnectionEvent"; + "MIDIInput"; + "MIDIInputMap"; + "MIDIMessageEvent"; + "MIDIOutput"; + "MIDIOutputMap"; + "MIDIPort"; + "Map"; + "Math"; + "MediaCapabilities"; + "MediaCapabilitiesInfo"; + "MediaDeviceInfo"; + "MediaDevices"; + "MediaElementAudioSourceNode"; + "MediaEncryptedEvent"; + "MediaError"; + "MediaList"; + "MediaQueryList"; + "MediaQueryListEvent"; + "MediaRecorder"; + "MediaSettingsRange"; + "MediaSource"; + "MediaStream"; + "MediaStreamAudioDestinationNode"; + "MediaStreamAudioSourceNode"; + "MediaStreamEvent"; + "MediaStreamTrack"; + "MediaStreamTrackEvent"; + "MessageChannel"; + "MessageEvent"; + "MessagePort"; + "MimeType"; + "MimeTypeArray"; + "MouseEvent"; + "MutationEvent"; + "MutationObserver"; + "MutationRecord"; + "NaN"; + "NamedNodeMap"; + "Navigator"; + "NetworkInformation"; + "Node"; + "NodeFilter"; + "NodeIterator"; + "NodeList"; + "Notification"; + "Number"; + "Object"; + "OfflineAudioCompletionEvent"; + "OfflineAudioContext"; + "OffscreenCanvas"; + "OffscreenCanvasRenderingContext2D"; + "Option"; + "OscillatorNode"; + "OverconstrainedError"; + "PageTransitionEvent"; + "PannerNode"; + "Path2D"; + "PaymentInstruments"; + "PaymentManager"; + "PaymentRequestUpdateEvent"; + "Performance"; + "PerformanceEntry"; + "PerformanceLongTaskTiming"; + "PerformanceMark"; + "PerformanceMeasure"; + "PerformanceNavigation"; + "PerformanceNavigationTiming"; + "PerformanceObserver"; + "PerformanceObserverEntryList"; + "PerformancePaintTiming"; + "PerformanceResourceTiming"; + "PerformanceServerTiming"; + "PerformanceTiming"; + "PeriodicWave"; + "PermissionStatus"; + "Permissions"; + "PhotoCapabilities"; + "PictureInPictureWindow"; + "Plugin"; + "PluginArray"; + "PointerEvent"; + "PopStateEvent"; + "ProcessingInstruction"; + "ProgressEvent"; + "Promise"; + "PromiseRejectionEvent"; + "Proxy"; + "PushManager"; + "PushSubscription"; + "PushSubscriptionOptions"; + "RTCCertificate"; + "RTCDTMFSender"; + "RTCDTMFToneChangeEvent"; + "RTCDataChannel"; + "RTCDataChannelEvent"; + "RTCIceCandidate"; + "RTCPeerConnection"; + "RTCPeerConnectionIceEvent"; + "RTCRtpContributingSource"; + "RTCRtpReceiver"; + "RTCRtpSender"; + "RTCRtpTransceiver"; + "RTCSessionDescription"; + "RTCStatsReport"; + "RTCTrackEvent"; + "RadioNodeList"; + "Range"; + "RangeError"; + "ReadableStream"; + "ReferenceError"; + "Reflect"; + "RegExp"; + "RemotePlayback"; + "ReportingObserver"; + "Request"; + "ResizeObserver"; + "ResizeObserverEntry"; + "Response"; + "SVGAElement"; + "SVGAngle"; + "SVGAnimateElement"; + "SVGAnimateMotionElement"; + "SVGAnimateTransformElement"; + "SVGAnimatedAngle"; + "SVGAnimatedBoolean"; + "SVGAnimatedEnumeration"; + "SVGAnimatedInteger"; + "SVGAnimatedLength"; + "SVGAnimatedLengthList"; + "SVGAnimatedNumber"; + "SVGAnimatedNumberList"; + "SVGAnimatedPreserveAspectRatio"; + "SVGAnimatedRect"; + "SVGAnimatedString"; + "SVGAnimatedTransformList"; + "SVGAnimationElement"; + "SVGCircleElement"; + "SVGClipPathElement"; + "SVGComponentTransferFunctionElement"; + "SVGDefsElement"; + "SVGDescElement"; + "SVGDiscardElement"; + "SVGElement"; + "SVGEllipseElement"; + "SVGFEBlendElement"; + "SVGFEColorMatrixElement"; + "SVGFEComponentTransferElement"; + "SVGFECompositeElement"; + "SVGFEConvolveMatrixElement"; + "SVGFEDiffuseLightingElement"; + "SVGFEDisplacementMapElement"; + "SVGFEDistantLightElement"; + "SVGFEDropShadowElement"; + "SVGFEFloodElement"; + "SVGFEFuncAElement"; + "SVGFEFuncBElement"; + "SVGFEFuncGElement"; + "SVGFEFuncRElement"; + "SVGFEGaussianBlurElement"; + "SVGFEImageElement"; + "SVGFEMergeElement"; + "SVGFEMergeNodeElement"; + "SVGFEMorphologyElement"; + "SVGFEOffsetElement"; + "SVGFEPointLightElement"; + "SVGFESpecularLightingElement"; + "SVGFESpotLightElement"; + "SVGFETileElement"; + "SVGFETurbulenceElement"; + "SVGFilterElement"; + "SVGForeignObjectElement"; + "SVGGElement"; + "SVGGeometryElement"; + "SVGGradientElement"; + "SVGGraphicsElement"; + "SVGImageElement"; + "SVGLength"; + "SVGLengthList"; + "SVGLineElement"; + "SVGLinearGradientElement"; + "SVGMPathElement"; + "SVGMarkerElement"; + "SVGMaskElement"; + "SVGMatrix"; + "SVGMetadataElement"; + "SVGNumber"; + "SVGNumberList"; + "SVGPathElement"; + "SVGPatternElement"; + "SVGPoint"; + "SVGPointList"; + "SVGPolygonElement"; + "SVGPolylineElement"; + "SVGPreserveAspectRatio"; + "SVGRadialGradientElement"; + "SVGRect"; + "SVGRectElement"; + "SVGSVGElement"; + "SVGScriptElement"; + "SVGSetElement"; + "SVGStopElement"; + "SVGStringList"; + "SVGStyleElement"; + "SVGSwitchElement"; + "SVGSymbolElement"; + "SVGTSpanElement"; + "SVGTextContentElement"; + "SVGTextElement"; + "SVGTextPathElement"; + "SVGTextPositioningElement"; + "SVGTitleElement"; + "SVGTransform"; + "SVGTransformList"; + "SVGUnitTypes"; + "SVGUseElement"; + "SVGViewElement"; + "Screen"; + "ScreenOrientation"; + "ScriptProcessorNode"; + "SecurityPolicyViolationEvent"; + "Selection"; + "Set"; + "ShadowRoot"; + "SharedArrayBuffer"; + "SharedWorker"; + "SourceBuffer"; + "SourceBufferList"; + "SpeechSynthesisErrorEvent"; + "SpeechSynthesisEvent"; + "SpeechSynthesisUtterance"; + "StaticRange"; + "StereoPannerNode"; + "Storage"; + "StorageEvent"; + "String"; + "StylePropertyMap"; + "StylePropertyMapReadOnly"; + "StyleSheet"; + "StyleSheetList"; + "SubtleCrypto"; + "Symbol"; + "SyncManager"; + "SyntaxError"; + "TaskAttributionTiming"; + "Text"; + "TextDecoder"; + "TextDecoderStream"; + "TextEncoder"; + "TextEncoderStream"; + "TextEvent"; + "TextMetrics"; + "TextTrack"; + "TextTrackCue"; + "TextTrackCueList"; + "TextTrackList"; + "TimeRanges"; + "Touch"; + "TouchEvent"; + "TouchList"; + "TrackEvent"; + "TransformStream"; + "TransitionEvent"; + "TreeWalker"; + "TypeError"; + "UIEvent"; + "URIError"; + "URL"; + "URLSearchParams"; + "Uint16Array"; + "Uint32Array"; + "Uint8Array"; + "Uint8ClampedArray"; + "UserActivation"; + "VTTCue"; + "ValidityState"; + "VisualViewport"; + "WaveShaperNode"; + "WeakMap"; + "WeakSet"; + "WebAssembly"; + "WebGL2RenderingContext"; + "WebGLActiveInfo"; + "WebGLBuffer"; + "WebGLContextEvent"; + "WebGLFramebuffer"; + "WebGLProgram"; + "WebGLQuery"; + "WebGLRenderbuffer"; + "WebGLRenderingContext"; + "WebGLSampler"; + "WebGLShader"; + "WebGLShaderPrecisionFormat"; + "WebGLSync"; + "WebGLTexture"; + "WebGLTransformFeedback"; + "WebGLUniformLocation"; + "WebGLVertexArrayObject"; + "WebKitCSSMatrix"; + "WebKitMutationObserver"; + "WebSocket"; + "WheelEvent"; + "Window"; + "Worker"; + "WritableStream"; + "XDomainRequest"; + "XMLDocument"; + "XMLHttpRequest"; + "XMLHttpRequestEventTarget"; + "XMLHttpRequestUpload"; + "XMLSerializer"; + "XPathEvaluator"; + "XPathExpression"; + "XPathResult"; + "XSLTProcessor"; + "__dirname"; + "__esModule"; + "__filename"; + "abstract"; + "arguments"; + "await"; + "boolean"; + "break"; + "byte"; + "case"; + "catch"; + "char"; + "class"; + "clearImmediate"; + "clearInterval"; + "clearTimeout"; + "console"; + "const"; + "continue"; + "debugger"; + "decodeURI"; + "decodeURIComponent"; + "default"; + "delete"; + "do"; + "document"; + "double"; + "else"; + "encodeURI"; + "encodeURIComponent"; + "enum"; + "escape"; + "eval"; + "event"; + "export"; + "exports"; + "extends"; + "false"; + "fetch"; + "final"; + "finally"; + "float"; + "for"; + "function"; + "global"; + "goto"; + "if"; + "implements"; + "import"; + "in"; + "instanceof"; + "int"; + "interface"; + "isFinite"; + "isNaN"; + "let"; + "location"; + "long"; + "module"; + "native"; + "navigator"; + "new"; + "null"; + "package"; + "parseFloat"; + "parseInt"; + "private"; + "process"; + "protected"; + "public"; + "require"; + "return"; + "setImmediate"; + "setInterval"; + "setTimeout"; + "short"; + "static"; + "super"; + "switch"; + "synchronized"; + "then"; + "this"; + "throw"; + "transient"; + "true"; + "try"; + "typeof"; + "undefined"; + "unescape"; + "var"; + "void"; + "volatile"; + "while"; + "window"; + "with"; + "yield"; + |] + + +type element = string + +let rec binarySearchAux (arr : element array) (lo : int) (hi : int) key : bool = + let mid = (lo + hi)/2 in + let midVal = Array.unsafe_get arr mid in + (* let c = cmp key midVal [@bs] in *) + if key = midVal then true + else if key < midVal then (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + (Array.unsafe_get arr lo) = key + else binarySearchAux arr lo mid key + else (* a[lo] =< a[mid] < key <= a[hi] *) + if lo = mid then + (Array.unsafe_get arr hi) = key + else binarySearchAux arr mid hi key + +let binarySearch (sorted : element array) (key : element) : bool = + let len = Array.length sorted in + if len = 0 then false + else + let lo = Array.unsafe_get sorted 0 in + (* let c = cmp key lo [@bs] in *) + if key < lo then false + else + let hi = Array.unsafe_get sorted (len - 1) in + (* let c2 = cmp key hi [@bs]in *) + if key > hi then false + else binarySearchAux sorted 0 (len - 1) key + +let is_reserved s = binarySearch sorted_keywords s + +end +module Ext_ident : sig +#1 "ext_ident.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 wrapper around [Ident] module in compiler-libs*) + + val is_js : Ident.t -> bool + +val is_js_object : Ident.t -> bool + +(** create identifiers for predefined [js] global variables *) +val create_js : string -> Ident.t + +val create : string -> Ident.t + + val make_js_object : Ident.t -> unit + +val reset : unit -> unit + +val create_tmp : ?name:string -> unit -> Ident.t + +val make_unused : unit -> Ident.t + + + +(** + Invariant: if name is not converted, the reference should be equal +*) +val convert : string -> string + + + +val is_js_or_global : Ident.t -> bool + + + +val compare : Ident.t -> Ident.t -> int +val equal : Ident.t -> Ident.t -> bool + +end = struct +#1 "ext_ident.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 js_flag = 0b1_000 (* check with ocaml compiler *) + +(* let js_module_flag = 0b10_000 (\* javascript external modules *\) *) +(* TODO: + check name conflicts with javascript conventions + {[ + Ext_ident.convert "^";; + - : string = "$caret" + ]} +*) +let js_object_flag = 0b100_000 (* javascript object flags *) + +let is_js (i : Ident.t) = + i.flags land js_flag <> 0 + +let is_js_or_global (i : Ident.t) = + i.flags land (8 lor 1) <> 0 + + +let is_js_object (i : Ident.t) = + i.flags land js_object_flag <> 0 + +let make_js_object (i : Ident.t) = + i.flags <- i.flags lor js_object_flag + +(* It's a js function hard coded by js api, so when printing, + it should preserve the name +*) +let create_js (name : string) : Ident.t = + { name = name; flags = js_flag ; stamp = 0} + +let create = Ident.create + +(* FIXME: no need for `$' operator *) +let create_tmp ?(name=Literals.tmp) () = create name + + +let js_module_table : Ident.t String_hashtbl.t = String_hashtbl.create 31 + +(* This is for a js exeternal module, we can change it when printing + for example + {[ + var React$1 = require('react'); + React$1.render(..) + ]} + + Given a name, if duplicated, they should have the same id +*) +let create_js_module (name : string) : Ident.t = + let name = + String.concat "" @@ Ext_list.map + (Ext_string.split name '-') Ext_string.capitalize_ascii in + (* TODO: if we do such transformation, we should avoid collision for example: + react-dom + react--dom + check collision later + *) + match String_hashtbl.find_exn js_module_table name with + | exception Not_found -> + let ans = Ident.create name in + (* let ans = { v with flags = js_module_flag} in *) + String_hashtbl.add js_module_table name ans; + ans + | v -> (* v *) Ident.rename v + + + + + + +exception Not_normal_letter of int +let name_mangle name = + + let len = String.length name in + try + for i = 0 to len - 1 do + match String.unsafe_get name i with + | 'a' .. 'z' | 'A' .. 'Z' + | '0' .. '9' | '_' | '$' + -> () + | _ -> raise (Not_normal_letter i) + done; + name (* Normal letter *) + with + | Not_normal_letter 0 -> + + let buffer = Buffer.create len in + for j = 0 to len - 1 do + let c = String.unsafe_get name j in + match c with + | '*' -> Buffer.add_string buffer "$star" + | '\'' -> Buffer.add_string buffer "$prime" + | '!' -> Buffer.add_string buffer "$bang" + | '>' -> Buffer.add_string buffer "$great" + | '<' -> Buffer.add_string buffer "$less" + | '=' -> Buffer.add_string buffer "$eq" + | '+' -> Buffer.add_string buffer "$plus" + | '-' -> Buffer.add_string buffer "$neg" + | '@' -> Buffer.add_string buffer "$at" + | '^' -> Buffer.add_string buffer "$caret" + | '/' -> Buffer.add_string buffer "$slash" + | '|' -> Buffer.add_string buffer "$pipe" + | '.' -> Buffer.add_string buffer "$dot" + | '%' -> Buffer.add_string buffer "$percent" + | '~' -> Buffer.add_string buffer "$tilde" + | '#' -> Buffer.add_string buffer "$hash" + | ':' -> Buffer.add_string buffer "$colon" + | 'a'..'z' | 'A'..'Z'| '_' + | '$' + | '0'..'9'-> Buffer.add_char buffer c + | _ -> Buffer.add_string buffer "$unknown" + done; Buffer.contents buffer + | Not_normal_letter i -> + String.sub name 0 i ^ + (let buffer = Buffer.create len in + for j = i to len - 1 do + let c = String.unsafe_get name j in + match c with + | '*' -> Buffer.add_string buffer "$star" + | '\'' -> Buffer.add_string buffer "$prime" + | '!' -> Buffer.add_string buffer "$bang" + | '>' -> Buffer.add_string buffer "$great" + | '<' -> Buffer.add_string buffer "$less" + | '=' -> Buffer.add_string buffer "$eq" + | '+' -> Buffer.add_string buffer "$plus" + | '-' -> Buffer.add_string buffer "$" + (* Note ocaml compiler also has [self-] *) + | '@' -> Buffer.add_string buffer "$at" + | '^' -> Buffer.add_string buffer "$caret" + | '/' -> Buffer.add_string buffer "$slash" + | '|' -> Buffer.add_string buffer "$pipe" + | '.' -> Buffer.add_string buffer "$dot" + | '%' -> Buffer.add_string buffer "$percent" + | '~' -> Buffer.add_string buffer "$tilde" + | '#' -> Buffer.add_string buffer "$hash" + | ':' -> Buffer.add_string buffer "$colon" + | '$' -> Buffer.add_string buffer "$dollar" + | 'a'..'z' | 'A'..'Z'| '_' + | '0'..'9'-> Buffer.add_char buffer c + | _ -> Buffer.add_string buffer "$unknown" + done; Buffer.contents buffer) +(* TODO: + check name conflicts with javascript conventions + {[ + Ext_ident.convert "^";; + - : string = "$caret" + ]} + [convert name] if [name] is a js keyword,add "$$" + otherwise do the name mangling to make sure ocaml identifier it is + a valid js identifier +*) +let convert (name : string) = + if Js_reserved_map.is_reserved name then + "$$" ^ name + else name_mangle name + +(** keyword could be used in property *) + +(* It is currently made a persistent ident to avoid fresh ids + which would result in different signature files + - other solution: use lazy values +*) +let make_unused () = create "_" + + + +let reset () = + String_hashtbl.clear js_module_table + + +(* Has to be total order, [x < y] + and [x > y] should be consistent + flags are not relevant here +*) +let compare (x : Ident.t ) ( y : Ident.t) = + let u = x.stamp - y.stamp in + if u = 0 then + Ext_string.compare x.name y.name + else u + +let equal ( x : Ident.t) ( y : Ident.t) = + if x.stamp <> 0 then x.stamp = y.stamp + else y.stamp = 0 && x.name = y.name + + +end +module Hash_set_ident_mask : sig +#1 "hash_set_ident_mask.mli" + + +(** Based on [hash_set] specialized for mask operations *) +type ident = Ident.t + + +type t +val create: int -> t + + +(* add one ident *) +val add_unmask : t -> ident -> unit + + +(** [check_mask h key] if [key] exists mask it otherwise nothing + return true if all keys are masked otherwise false +*) +val mask_check_all_hit : ident -> t -> bool + +(** [iter_and_unmask f h] iterating the collection and mask all idents, + dont consul the collection in function [f] + TODO: what happens if an exception raised in the callback, + would the hashtbl still be in consistent state? +*) +val iter_and_unmask: (ident -> bool -> unit) -> t -> unit + + + + + +end = struct +#1 "hash_set_ident_mask.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. *) + + + +type ident = Ident.t + +type key = {ident : ident ; mutable mask : bool } + +type t = { + mutable size : int ; + mutable data : key list array; + initial_size : int ; + mutable mask_size : int (* mark how many idents are marked *) +} + + + +let key_index_by_ident (h : t) (key : Ident.t) = + (Bs_hash_stubs.hash_string_int key.name key.stamp) land (Array.length h.data - 1) + +let key_index (h : t ) ({ident = key} : key) = + key_index_by_ident h key + + +let create initial_size = + let s = Ext_util.power_2_above 8 initial_size in + { initial_size = s; size = 0; data = Array.make s [] ; mask_size = 0} + +let iter_and_unmask f h = + let rec do_bucket buckets = + match buckets with + | [ ] -> + () + | k :: rest -> + f k.ident k.mask ; + if k.mask then + begin + k.mask <- false ; + (* we can set [h.mask_size] to zero, + however, it would result inconsistent state + once [f] throw + *) + h.mask_size <- h.mask_size - 1 + end; + 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 rec small_bucket_mem key lst = + match lst with + | [] -> false + | {ident = key1 }::rest -> + Ext_ident.equal key key1 || + match rest with + | [] -> false + | {ident = key2} :: rest -> + Ext_ident.equal key key2 || + match rest with + | [] -> false + | {ident = key3; _} :: rest -> + Ext_ident.equal key key3 || + small_bucket_mem key rest + +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 [ ] in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + [ ] -> () + | key :: rest -> + let nidx = indexfun h key in + ndata.(nidx) <- key :: ndata.(nidx); + insert_bucket rest + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + +let add_unmask (h : t) (key : Ident.t) = + let i = key_index_by_ident h key in + let h_data = h.data in + let old_bucket = Array.unsafe_get h_data i in + if not (small_bucket_mem key old_bucket) then + begin + Array.unsafe_set h_data i ({ident = key; mask = false} :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then resize key_index h + end + + + + +let rec small_bucket_mask key lst = + match lst with + | [] -> false + | key1::rest -> + if Ext_ident.equal key key1.ident then + if key1.mask then false else (key1.mask <- true ; true) + else + match rest with + | [] -> false + | key2 :: rest -> + if Ext_ident.equal key key2.ident then + if key2.mask then false else (key2.mask <- true ; true) + else + match rest with + | [] -> false + | key3 :: rest -> + if Ext_ident.equal key key3.ident then + if key3.mask then false else (key3.mask <- true ; true) + else + small_bucket_mask key rest + +let mask_check_all_hit (key : Ident.t) (h : t) = + if + small_bucket_mask key + (Array.unsafe_get h.data (key_index_by_ident h key )) then + begin + h.mask_size <- h.mask_size + 1 + end; + h.size = h.mask_size + + + + +end +module Ounit_ident_mask_tests += struct +#1 "ounit_ident_mask_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + let set = Hash_set_ident_mask.create 0 in + let a,b,c,d = + Ident.create "a", + Ident.create "b", + Ident.create "c", + Ident.create "d" in + Hash_set_ident_mask.add_unmask set a ; + Hash_set_ident_mask.add_unmask set a ; + Hash_set_ident_mask.add_unmask set b ; + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit a set ); + OUnit.assert_bool __LOC__ (Hash_set_ident_mask.mask_check_all_hit b set ); + Hash_set_ident_mask.iter_and_unmask (fun id mask -> + if id.Ident.name = "a" then + OUnit.assert_bool __LOC__ mask + else if id.Ident.name = "b" then + OUnit.assert_bool __LOC__ mask + else () + ) set ; + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit a set ); + OUnit.assert_bool __LOC__ (Hash_set_ident_mask.mask_check_all_hit b set ); + end; + __LOC__ >:: begin fun _ -> + let len = 1000 in + let idents = Array.init len (fun i -> Ident.create (string_of_int i)) in + let set = Hash_set_ident_mask.create 0 in + Array.iter (fun i -> Hash_set_ident_mask.add_unmask set i) idents; + for i = 0 to len - 2 do + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit idents.(i) set); + done ; + for i = 0 to len - 2 do + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit idents.(i) set); + done ; + OUnit.assert_bool __LOC__ (Hash_set_ident_mask.mask_check_all_hit idents.(len - 1) set) ; + Hash_set_ident_mask.iter_and_unmask (fun id mask -> ()) set; + for i = 0 to len - 2 do + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit idents.(i) set); + done ; + for i = 0 to len - 2 do + OUnit.assert_bool __LOC__ (not @@ Hash_set_ident_mask.mask_check_all_hit idents.(i) set); + done ; + OUnit.assert_bool __LOC__ (Hash_set_ident_mask.mask_check_all_hit idents.(len - 1) set) ; + + end + ] +end +module Vec_gen += struct +#1 "vec_gen.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. *) + + +module type ResizeType = +sig + type t + val null : t (* used to populate new allocated array checkout {!Obj.new_block} for more performance *) +end + +module type S = +sig + type elt + type t + val length : t -> int + val compact : t -> unit + val singleton : elt -> t + val empty : unit -> t + val make : int -> t + val init : int -> (int -> elt) -> t + val is_empty : t -> bool + val of_array : elt array -> t + val of_sub_array : elt array -> int -> int -> t + + (** Exposed for some APIs which only take array as input, + when exposed + *) + val unsafe_internal_array : t -> elt array + val reserve : t -> int -> unit + val push : t -> elt -> unit + val delete : t -> int -> unit + val pop : t -> unit + val get_last_and_pop : t -> elt + val delete_range : t -> int -> int -> unit + val get_and_delete_range : t -> int -> int -> t + val clear : t -> unit + val reset : t -> unit + val to_list : t -> elt list + val of_list : elt list -> t + val to_array : t -> elt array + val of_array : elt array -> t + val copy : t -> t + val reverse_in_place : t -> unit + val iter : t -> (elt -> unit) -> unit + val iteri : t -> (int -> elt -> unit ) -> unit + val iter_range : t -> from:int -> to_:int -> (elt -> unit) -> unit + val iteri_range : t -> from:int -> to_:int -> (int -> elt -> unit) -> unit + val map : (elt -> elt) -> t -> t + val mapi : (int -> elt -> elt) -> t -> t + val map_into_array : (elt -> 'f) -> t -> 'f array + val map_into_list : (elt -> 'f) -> t -> 'f list + val fold_left : ('f -> elt -> 'f) -> 'f -> t -> 'f + val fold_right : (elt -> 'g -> 'g) -> t -> 'g -> 'g + val filter : (elt -> bool) -> t -> t + val inplace_filter : (elt -> bool) -> t -> unit + val inplace_filter_with : (elt -> bool) -> cb_no:(elt -> 'a -> 'a) -> 'a -> t -> 'a + val inplace_filter_from : int -> (elt -> bool) -> t -> unit + val equal : (elt -> elt -> bool) -> t -> t -> bool + val get : t -> int -> elt + val unsafe_get : t -> int -> elt + val last : t -> elt + val capacity : t -> int + val exists : (elt -> bool) -> t -> bool + val sub : t -> int -> int -> t +end + + +end +module Int_vec : sig +#1 "int_vec.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 Vec_gen.S with type elt = int + +end = struct +#1 "int_vec.ml" +# 1 "ext/vec.cppo.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. *) + +# 34 "ext/vec.cppo.ml" +type elt = int +let null = 0 (* can be optimized *) +let unsafe_blit = Bs_hash_stubs.int_unsafe_blit + +# 41 "ext/vec.cppo.ml" +external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub" + +type t = { + mutable arr : elt array ; + mutable len : int ; +} + +let length d = d.len + +let compact d = + let d_arr = d.arr in + if d.len <> Array.length d_arr then + begin + let newarr = unsafe_sub d_arr 0 d.len in + d.arr <- newarr + end +let singleton v = + { + len = 1 ; + arr = [|v|] + } + +let empty () = + { + len = 0; + arr = [||]; + } + +let is_empty d = + d.len = 0 + +let reset d = + d.len <- 0; + d.arr <- [||] + + +(* For [to_*] operations, we should be careful to call {!Array.*} function + in case we operate on the whole array +*) +let to_list d = + let rec loop (d_arr : elt array) idx accum = + if idx < 0 then accum else loop d_arr (idx - 1) (Array.unsafe_get d_arr idx :: accum) + in + loop d.arr (d.len - 1) [] + + +let of_list lst = + let arr = Array.of_list lst in + { arr ; len = Array.length arr} + + +let to_array d = + unsafe_sub d.arr 0 d.len + +let of_array src = + { + len = Array.length src; + arr = Array.copy src; + (* okay to call {!Array.copy}*) + } +let of_sub_array arr off len = + { + len = len ; + arr = Array.sub arr off len + } +let unsafe_internal_array v = v.arr +(* we can not call {!Array.copy} *) +let copy src = + let len = src.len in + { + len ; + arr = unsafe_sub src.arr 0 len ; + } + +(* FIXME *) +let reverse_in_place src = + Ext_array.reverse_range src.arr 0 src.len + + + + +(* {!Array.sub} is not enough for error checking, it + may contain some garbage + *) +let sub (src : t) start len = + let src_len = src.len in + if len < 0 || start > src_len - len then invalid_arg "Vec.sub" + else + { len ; + arr = unsafe_sub src.arr start len } + +let iter d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f (Array.unsafe_get arr i) + done + +let iteri d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f i (Array.unsafe_get arr i) + done + +let iter_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iter_range" + else + let d_arr = d.arr in + for i = from to to_ do + f (Array.unsafe_get d_arr i) + done + +let iteri_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iteri_range" + else + let d_arr = d.arr in + for i = from to to_ do + f i (Array.unsafe_get d_arr i) + done + +let map_into_array f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [||] + else + let first_one = f (Array.unsafe_get src_arr 0) in + let arr = Array.make src_len first_one in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + arr +let map_into_list f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [] + else + let acc = ref [] in + for i = src_len - 1 downto 0 do + acc := f (Array.unsafe_get src_arr i) :: !acc + done; + !acc + +let mapi f src = + let len = src.len in + if len = 0 then { len ; arr = [| |] } + else + let src_arr = src.arr in + let arr = Array.make len (Array.unsafe_get src_arr 0) in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i (Array.unsafe_get src_arr i)) + done; + { + len ; + arr ; + } + +let fold_left f x a = + let rec loop a_len (a_arr : elt array) idx x = + if idx >= a_len then x else + loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx)) + in + loop a.len a.arr 0 x + +let fold_right f a x = + let rec loop (a_arr : elt array) idx x = + if idx < 0 then x + else loop a_arr (idx - 1) (f (Array.unsafe_get a_arr idx) x) + in + loop a.arr (a.len - 1) x + +(** + [filter] and [inplace_filter] +*) +let filter f d = + let new_d = copy d in + let new_d_arr = new_d.arr in + let d_arr = d.arr in + let p = ref 0 in + for i = 0 to d.len - 1 do + let x = Array.unsafe_get d_arr i in + (* TODO: can be optimized for segments blit *) + if f x then + begin + Array.unsafe_set new_d_arr !p x; + incr p; + end; + done; + new_d.len <- !p; + new_d + +let equal eq x y : bool = + if x.len <> y.len then false + else + let rec aux x_arr y_arr i = + if i < 0 then true else + if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then + aux x_arr y_arr (i - 1) + else false in + aux x.arr y.arr (x.len - 1) + +let get d i = + if i < 0 || i >= d.len then invalid_arg "Resize_array.get" + else Array.unsafe_get d.arr i +let unsafe_get d i = Array.unsafe_get d.arr i +let last d = + if d.len <= 0 then invalid_arg "Resize_array.last" + else Array.unsafe_get d.arr (d.len - 1) + +let capacity d = Array.length d.arr + +(* Attention can not use {!Array.exists} since the bound is not the same *) +let exists p d = + let a = d.arr in + let n = d.len in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + +let map f src = + let src_len = src.len in + if src_len = 0 then { len = 0 ; arr = [||]} + (* TODO: we may share the empty array + but sharing mutable state is very challenging, + the tricky part is to avoid mutating the immutable array, + here it looks fine -- + invariant: whenever [.arr] mutated, make sure it is not an empty array + Actually no: since starting from an empty array + {[ + push v (* the address of v should not be changed *) + ]} + *) + else + let src_arr = src.arr in + let first = f (Array.unsafe_get src_arr 0 ) in + let arr = Array.make src_len first in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + { + len = src_len; + arr = arr; + } + +let init len f = + if len < 0 then invalid_arg "Resize_array.init" + else if len = 0 then { len = 0 ; arr = [||] } + else + let first = f 0 in + let arr = Array.make len first in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i) + done; + { + + len ; + arr + } + + + + let make initsize : t = + if initsize < 0 then invalid_arg "Resize_array.make" ; + { + + len = 0; + arr = Array.make initsize null ; + } + + + + let reserve (d : t ) s = + let d_len = d.len in + let d_arr = d.arr in + if s < d_len || s < Array.length d_arr then () + else + let new_capacity = min Sys.max_array_length s in + let new_d_arr = Array.make new_capacity null in + unsafe_blit d_arr 0 new_d_arr 0 d_len; + d.arr <- new_d_arr + + let push (d : t) v = + let d_len = d.len in + let d_arr = d.arr in + let d_arr_len = Array.length d_arr in + if d_arr_len = 0 then + begin + d.len <- 1 ; + d.arr <- [| v |] + end + else + begin + if d_len = d_arr_len then + begin + if d_len >= Sys.max_array_length then + failwith "exceeds max_array_length"; + let new_capacity = min Sys.max_array_length d_len * 2 + (* [d_len] can not be zero, so [*2] will enlarge *) + in + let new_d_arr = Array.make new_capacity null in + d.arr <- new_d_arr; + unsafe_blit d_arr 0 new_d_arr 0 d_len ; + end; + d.len <- d_len + 1; + Array.unsafe_set d.arr d_len v + end + +(** delete element at offset [idx], will raise exception when have invalid input *) + let delete (d : t) idx = + let d_len = d.len in + if idx < 0 || idx >= d_len then invalid_arg "Resize_array.delete" ; + let arr = d.arr in + unsafe_blit arr (idx + 1) arr idx (d_len - idx - 1); + let idx = d_len - 1 in + d.len <- idx + +# 362 "ext/vec.cppo.ml" +(** pop the last element, a specialized version of [delete] *) + let pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.pop"; + d.len <- idx + +# 373 "ext/vec.cppo.ml" +(** pop and return the last element *) + let get_last_and_pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.get_last_and_pop"; + let last = Array.unsafe_get d.arr idx in + d.len <- idx + +# 384 "ext/vec.cppo.ml" + ; + last + +(** delete elements start from [idx] with length [len] *) + let delete_range (d : t) idx len = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.delete_range" ; + let arr = d.arr in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len + +# 402 "ext/vec.cppo.ml" +(** delete elements from [idx] with length [len] return the deleted elements as a new vec*) + let get_and_delete_range (d : t) idx len : t = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.get_and_delete_range" ; + let arr = d.arr in + let value = unsafe_sub arr idx len in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len; + +# 416 "ext/vec.cppo.ml" + {len = len ; arr = value} + + + (** Below are simple wrapper around normal Array operations *) + + let clear (d : t ) = + +# 428 "ext/vec.cppo.ml" + d.len <- 0 + + + + let inplace_filter f (d : t) : unit = + let d_arr = d.arr in + let d_len = d.len in + let p = ref 0 in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 448 "ext/vec.cppo.ml" + d.len <- last + (* INT , there is not need to reset it, since it will cause GC behavior *) + + +# 454 "ext/vec.cppo.ml" + let inplace_filter_from start f (d : t) : unit = + if start < 0 then invalid_arg "Vec.inplace_filter_from"; + let d_arr = d.arr in + let d_len = d.len in + let p = ref start in + for i = start to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 471 "ext/vec.cppo.ml" + d.len <- last + + +# 477 "ext/vec.cppo.ml" +(** inplace filter the elements and accumulate the non-filtered elements *) + let inplace_filter_with f ~cb_no acc (d : t) = + let d_arr = d.arr in + let p = ref 0 in + let d_len = d.len in + let acc = ref acc in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + else + acc := cb_no x !acc + done ; + let last = !p in + +# 497 "ext/vec.cppo.ml" + d.len <- last + (* INT , there is not need to reset it, since it will cause GC behavior *) + +# 502 "ext/vec.cppo.ml" + ; !acc + + + + +end +module Int_vec_util : sig +#1 "int_vec_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 mem : int -> Int_vec.t -> bool +end = struct +#1 "int_vec_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 rec unsafe_mem_aux arr i (key : int) bound = + if i <= bound then + if Array.unsafe_get arr i = (key : int) then + true + else unsafe_mem_aux arr (i + 1) key bound + else false + + + +let mem key (x : Int_vec.t) = + let internal_array = Int_vec.unsafe_internal_array x in + let len = Int_vec.length x in + unsafe_mem_aux internal_array 0 key (len - 1) + +end +module Ounit_int_vec_tests += struct +#1 "ounit_int_vec_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Int_vec_util.mem 3 (Int_vec.of_list [1;2;3])) + ; + OUnit.assert_bool __LOC__ + (not @@ Int_vec_util.mem 0 (Int_vec.of_list [1;2]) ); + + let v = Int_vec.make 100 in + OUnit.assert_bool __LOC__ + (not @@ Int_vec_util.mem 0 v) ; + Int_vec.push v 0; + OUnit.assert_bool __LOC__ + (Int_vec_util.mem 0 v ) + end; + + __LOC__ >:: begin fun _ -> + let u = Int_vec.make 100 in + Int_vec.push u 1; + OUnit.assert_bool __LOC__ + (not @@ Int_vec_util.mem 0 u ); + Int_vec.push u 0; + OUnit.assert_bool __LOC__ + (Int_vec_util.mem 0 u) + end + ] +end +module Ext_utf8 : sig +#1 "ext_utf8.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. *) + +type byte = + | Single of int + | Cont of int + | Leading of int * int + | Invalid + + +val classify : char -> byte + +val follow : + string -> + int -> + int -> + int -> + int * int + + +(** + return [-1] if failed +*) +val next : string -> remaining:int -> int -> int + + +exception Invalid_utf8 of string + + +val decode_utf8_string : string -> int list +end = struct +#1 "ext_utf8.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. *) + +type byte = + | Single of int + | Cont of int + | Leading of int * int + | Invalid + +(** [classify chr] returns the {!byte} corresponding to [chr] *) +let classify chr = + let c = int_of_char chr in + (* Classify byte according to leftmost 0 bit *) + if c land 0b1000_0000 = 0 then Single c else + (* c 0b0____*) + if c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111) else + (* c 0b10___*) + if c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111) else + (* c 0b110__*) + if c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111) else + (* c 0b1110_ *) + if c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111) else + (* c 0b1111_0___*) + if c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011) else + (* c 0b1111_10__*) + if c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001) + (* c 0b1111_110__ *) + else Invalid + +exception Invalid_utf8 of string + +(* when the first char is [Leading], + TODO: need more error checking + when out of bond + *) +let rec follow s n (c : int) offset = + if n = 0 then (c, offset) + else + begin match classify s.[offset+1] with + | Cont cc -> follow s (n-1) ((c lsl 6) lor (cc land 0x3f)) (offset+1) + | _ -> raise (Invalid_utf8 "Continuation byte expected") + end + + +let rec next s ~remaining offset = + if remaining = 0 then offset + else + begin match classify s.[offset+1] with + | Cont cc -> next s ~remaining:(remaining-1) (offset+1) + | _ -> -1 + | exception _ -> -1 (* it can happen when out of bound *) + end + + + + +let decode_utf8_string s = + let lst = ref [] in + let add elem = lst := elem :: !lst in + let rec decode_utf8_cont s i s_len = + if i = s_len then () + else + begin + match classify s.[i] with + | Single c -> + add c; decode_utf8_cont s (i+1) s_len + | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte") + | Leading (n, c) -> + let (c', i') = follow s n c i in add c'; + decode_utf8_cont s (i' + 1) s_len + | Invalid -> raise (Invalid_utf8 "Invalid byte") + end + in decode_utf8_cont s 0 (String.length s); + List.rev !lst + + +(** To decode {j||j} we need verify in the ast so that we have better error + location, then we do the decode later +*) + +let verify s loc = + assert false +end +module Ext_js_regex : sig +#1 "ext_js_regex.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. *) + +(* This is a module that checks if js regex is valid or not *) + +val js_regex_checker : string -> bool +end = struct +#1 "ext_js_regex.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 check_from_end al = + let rec aux l seen = + match l with + | [] -> false + | (e::r) -> + if e < 0 || e > 255 then false + else (let c = Char.chr e in + if c = '/' then true + else (if List.exists (fun x -> x = c) seen then false (* flag should not be repeated *) + else (if c = 'i' || c = 'g' || c = 'm' || c = 'y' || c ='u' then aux r (c::seen) + else false))) + in aux al [] + +let js_regex_checker s = + match Ext_utf8.decode_utf8_string s with + | [] -> false + | 47 (* [Char.code '/' = 47 ]*)::tail -> + check_from_end (List.rev tail) + | _ :: _ -> false + | exception Ext_utf8.Invalid_utf8 _ -> false + +end +module Ounit_js_regex_checker_tests += struct +#1 "ounit_js_regex_checker_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +open Ext_js_regex + +let suites = + __FILE__ + >::: + [ + "test_empty_string" >:: begin fun _ -> + let b = js_regex_checker "" in + OUnit.assert_equal b false + end; + "test_normal_regex" >:: begin fun _ -> + let b = js_regex_checker "/abc/" in + OUnit.assert_equal b true + end; + "test_wrong_regex_last" >:: begin fun _ -> + let b = js_regex_checker "/abc" in + OUnit.assert_equal b false + end; + "test_regex_with_flag" >:: begin fun _ -> + let b = js_regex_checker "/ss/ig" in + OUnit.assert_equal b true + end; + "test_regex_with_invalid_flag" >:: begin fun _ -> + let b = js_regex_checker "/ss/j" in + OUnit.assert_equal b false + end; + "test_regex_invalid_regex" >:: begin fun _ -> + let b = js_regex_checker "abc/i" in + OUnit.assert_equal b false + end; + "test_regex_empty_pattern" >:: begin fun _ -> + let b = js_regex_checker "//" in + OUnit.assert_equal b true + end; + "test_regex_with_utf8" >:: begin fun _ -> + let b = js_regex_checker "/😃/" in + OUnit.assert_equal b true + end; + "test_regex_repeated_flags" >:: begin fun _ -> + let b = js_regex_checker "/abc/gg" in + OUnit.assert_equal b false + end; + ] +end +module Ext_json_noloc : sig +#1 "ext_json_noloc.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + + +type t + +val true_ : t +val false_ : t +val null : t +val str : string -> t +val flo : string -> t +val arr : t array -> t +val obj : t String_map.t -> t +val kvs : (string * t) list -> t +val equal : t -> t -> bool +val to_string : t -> string + + +val to_channel : out_channel -> t -> unit +end = struct +#1 "ext_json_noloc.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + + +type t = + | True + | False + | Null + | Flo of string + | Str of string + | Arr of t array + | Obj of t String_map.t + + +(** poor man's serialization *) + +let quot x = + "\"" ^ String.escaped x ^ "\"" + +let true_ = True +let false_ = False +let null = Null +let str s = Str s +let flo s = Flo s +let arr s = Arr s +let obj s = Obj s +let kvs s = + Obj (String_map.of_list s) + +let rec equal + (x : t) + (y : t) = + match x with + | Null -> (* [%p? Null _ ] *) + begin match y with + | Null -> true + | _ -> false end + | Str str -> + begin match y with + | Str str2 -> str = str2 + | _ -> false end + | Flo flo + -> + begin match y with + | Flo flo2 -> + flo = flo2 + | _ -> false + end + | True -> + begin match y with + | True -> true + | _ -> false + end + | False -> + begin match y with + | False -> true + | _ -> false + end + | Arr content + -> + begin match y with + | Arr content2 + -> + Ext_array.for_all2_no_exn content content2 equal + | _ -> false + end + + | Obj map -> + begin match y with + | Obj map2 -> + String_map.equal map map2 equal + | _ -> false + end + +let rec encode_aux (x : t ) + (buf : Buffer.t) : unit = + let a str = Buffer.add_string buf str in + match x with + | Null -> a "null" + | Str s -> a (quot s) + | Flo s -> + a s (* + since our parsing keep the original float representation, we just dump it as is, there is no cases like [nan] *) + | Arr content -> + begin match content with + | [||] -> a "[]" + | _ -> + a "[ "; + encode_aux + (Array.unsafe_get content 0) + buf ; + for i = 1 to Array.length content - 1 do + a " , "; + encode_aux + (Array.unsafe_get content i) + buf + done; + a " ]" + end + | True -> a "true" + | False -> a "false" + | Obj map -> + if String_map.is_empty map then + a "{}" + else + begin + (*prerr_endline "WEIRD"; + prerr_endline (string_of_int @@ String_map.cardinal map ); *) + a "{ "; + let _ : int = String_map.fold map 0 (fun k v i -> + if i <> 0 then begin + a " , " + end; + a (quot k); + a " : "; + encode_aux v buf ; + i + 1 + ) in + a " }" + end + + +let to_string x = + let buf = Buffer.create 1024 in + encode_aux x buf ; + Buffer.contents buf + +let to_channel (oc : out_channel) x = + let buf = Buffer.create 1024 in + encode_aux x buf ; + Buffer.output_buffer oc buf +end +module Ext_json_parse : sig +#1 "ext_json_parse.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. *) + +type error + +val report_error : Format.formatter -> error -> unit + +exception Error of Lexing.position * Lexing.position * error + +val parse_json_from_string : string -> Ext_json_types.t + +val parse_json_from_chan : + string -> in_channel -> Ext_json_types.t + +val parse_json_from_file : string -> Ext_json_types.t + + +end = struct +#1 "ext_json_parse.ml" +# 1 "ext/ext_json_parse.mll" + +type error = + | Illegal_character of char + | Unterminated_string + | Unterminated_comment + | Illegal_escape of string + | Unexpected_token + | Expect_comma_or_rbracket + | Expect_comma_or_rbrace + | Expect_colon + | Expect_string_or_rbrace + | Expect_eof + (* | Trailing_comma_in_obj *) + (* | Trailing_comma_in_array *) + + +let fprintf = Format.fprintf +let report_error ppf = function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_escape s -> + fprintf ppf "Illegal backslash escape in string or character (%s)" s + | Unterminated_string -> + fprintf ppf "Unterminated_string" + | Expect_comma_or_rbracket -> + fprintf ppf "Expect_comma_or_rbracket" + | Expect_comma_or_rbrace -> + fprintf ppf "Expect_comma_or_rbrace" + | Expect_colon -> + fprintf ppf "Expect_colon" + | Expect_string_or_rbrace -> + fprintf ppf "Expect_string_or_rbrace" + | Expect_eof -> + fprintf ppf "Expect_eof" + | Unexpected_token + -> + fprintf ppf "Unexpected_token" + (* | Trailing_comma_in_obj *) + (* -> fprintf ppf "Trailing_comma_in_obj" *) + (* | Trailing_comma_in_array *) + (* -> fprintf ppf "Trailing_comma_in_array" *) + | Unterminated_comment + -> fprintf ppf "Unterminated_comment" + + +exception Error of Lexing.position * Lexing.position * error + + +let () = + Printexc.register_printer + (function x -> + match x with + | Error (loc_start,loc_end,error) -> + Some (Format.asprintf + "@[%a:@ %a@ -@ %a)@]" + report_error error + Ext_position.print loc_start + Ext_position.print loc_end + ) + + | _ -> None + ) + + + + + +type token = + | Comma + | Eof + | False + | Lbrace + | Lbracket + | Null + | Colon + | Number of string + | Rbrace + | Rbracket + | String of string + | True + +let error (lexbuf : Lexing.lexbuf) e = + raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) + + +let lexeme_len (x : Lexing.lexbuf) = + x.lex_curr_pos - x.lex_start_pos + +let update_loc ({ lex_curr_p; _ } as lexbuf : Lexing.lexbuf) diff = + lexbuf.lex_curr_p <- + { + lex_curr_p with + pos_lnum = lex_curr_p.pos_lnum + 1; + pos_bol = lex_curr_p.pos_cnum - diff; + } + +let char_for_backslash = function + | 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + +let dec_code c1 c2 c3 = + 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) + +let hex_code c1 c2 = + let d1 = Char.code c1 in + let val1 = + if d1 >= 97 then d1 - 87 + else if d1 >= 65 then d1 - 55 + else d1 - 48 in + let d2 = Char.code c2 in + let val2 = + if d2 >= 97 then d2 - 87 + else if d2 >= 65 then d2 - 55 + else d2 - 48 in + val1 * 16 + val2 + +let lf = '\010' + +# 124 "ext/ext_json_parse.ml" +let __ocaml_lex_tables = { + Lexing.lex_base = + "\000\000\239\255\240\255\241\255\000\000\025\000\011\000\244\255\ + \245\255\246\255\247\255\248\255\249\255\000\000\000\000\000\000\ + \041\000\001\000\254\255\005\000\005\000\253\255\001\000\002\000\ + \252\255\000\000\000\000\003\000\251\255\001\000\003\000\250\255\ + \079\000\089\000\099\000\121\000\131\000\141\000\153\000\163\000\ + \001\000\253\255\254\255\023\000\255\255\006\000\246\255\189\000\ + \248\255\215\000\255\255\249\255\249\000\181\000\252\255\009\000\ + \063\000\075\000\234\000\251\255\032\001\250\255"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\255\255\013\000\013\000\016\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\ + \016\000\016\000\255\255\000\000\012\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\013\000\255\255\013\000\255\255\013\000\255\255\ + \255\255\255\255\255\255\001\000\255\255\255\255\255\255\008\000\ + \255\255\255\255\255\255\255\255\006\000\006\000\255\255\006\000\ + \001\000\002\000\255\255\255\255\255\255\255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\000\000\255\255\255\255\255\255\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\ + \255\255\255\255\000\000\255\255\020\000\000\000\255\255\255\255\ + \000\000\255\255\255\255\255\255\000\000\255\255\255\255\000\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \042\000\000\000\000\000\255\255\000\000\047\000\000\000\047\000\ + \000\000\051\000\000\000\000\000\255\255\255\255\000\000\255\255\ + \255\255\255\255\255\255\000\000\255\255\000\000"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\019\000\018\000\018\000\019\000\017\000\019\000\255\255\ + \048\000\019\000\255\255\057\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \019\000\000\000\003\000\000\000\000\000\019\000\000\000\000\000\ + \050\000\000\000\000\000\043\000\008\000\006\000\033\000\016\000\ + \004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\007\000\004\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\005\000\005\000\032\000\044\000\033\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\021\000\057\000\000\000\000\000\000\000\ + \020\000\000\000\000\000\012\000\000\000\011\000\032\000\056\000\ + \000\000\025\000\049\000\000\000\000\000\032\000\014\000\024\000\ + \028\000\000\000\000\000\057\000\026\000\030\000\013\000\031\000\ + \000\000\000\000\022\000\027\000\015\000\029\000\023\000\000\000\ + \000\000\000\000\039\000\010\000\039\000\009\000\032\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\ + \035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\255\255\ + \035\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\000\000\000\000\255\255\ + \000\000\056\000\000\000\000\000\055\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\054\000\ + \000\000\054\000\000\000\000\000\000\000\000\000\054\000\000\000\ + \002\000\041\000\000\000\000\000\000\000\255\255\046\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\ + \053\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\255\255\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\000\000\000\000\000\000\000\000\ + \000\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\054\000\000\000\000\000\000\000\000\000\ + \000\000\054\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\000\000\000\000\000\000\000\000\054\000\000\000\000\000\ + \000\000\054\000\000\000\054\000\000\000\000\000\000\000\052\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\017\000\000\000\000\000\019\000\020\000\ + \045\000\019\000\020\000\055\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \000\000\255\255\000\000\255\255\255\255\019\000\255\255\255\255\ + \045\000\255\255\255\255\040\000\000\000\000\000\004\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\ + \006\000\006\000\006\000\006\000\006\000\004\000\043\000\005\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\016\000\057\000\255\255\255\255\255\255\ + \016\000\255\255\255\255\000\000\255\255\000\000\005\000\056\000\ + \255\255\014\000\045\000\255\255\255\255\004\000\000\000\023\000\ + \027\000\255\255\255\255\057\000\025\000\029\000\000\000\030\000\ + \255\255\255\255\015\000\026\000\000\000\013\000\022\000\255\255\ + \255\255\255\255\032\000\000\000\032\000\000\000\005\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\035\000\255\255\035\000\255\255\ + \034\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\047\000\ + \034\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\039\000\039\000\039\000\039\000\039\000\ + \039\000\039\000\039\000\039\000\039\000\255\255\255\255\047\000\ + \255\255\049\000\255\255\255\255\049\000\053\000\053\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\049\000\255\255\255\255\255\255\255\255\049\000\255\255\ + \000\000\040\000\255\255\255\255\255\255\020\000\045\000\049\000\ + \049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\ + \049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\047\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\255\255\255\255\255\255\255\255\ + \255\255\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\049\000\255\255\255\255\255\255\255\255\ + \255\255\049\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\ + \255\255\049\000\255\255\049\000\255\255\255\255\255\255\049\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\047\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255"; + Lexing.lex_base_code = + ""; + Lexing.lex_backtrk_code = + ""; + Lexing.lex_default_code = + ""; + Lexing.lex_trans_code = + ""; + Lexing.lex_check_code = + ""; + Lexing.lex_code = + ""; +} + +let rec lex_json buf lexbuf = + __ocaml_lex_lex_json_rec buf lexbuf 0 +and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 142 "ext/ext_json_parse.mll" + ( lex_json buf lexbuf) +# 314 "ext/ext_json_parse.ml" + + | 1 -> +# 143 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + lex_json buf lexbuf + ) +# 322 "ext/ext_json_parse.ml" + + | 2 -> +# 147 "ext/ext_json_parse.mll" + ( comment buf lexbuf) +# 327 "ext/ext_json_parse.ml" + + | 3 -> +# 148 "ext/ext_json_parse.mll" + ( True) +# 332 "ext/ext_json_parse.ml" + + | 4 -> +# 149 "ext/ext_json_parse.mll" + (False) +# 337 "ext/ext_json_parse.ml" + + | 5 -> +# 150 "ext/ext_json_parse.mll" + (Null) +# 342 "ext/ext_json_parse.ml" + + | 6 -> +# 151 "ext/ext_json_parse.mll" + (Lbracket) +# 347 "ext/ext_json_parse.ml" + + | 7 -> +# 152 "ext/ext_json_parse.mll" + (Rbracket) +# 352 "ext/ext_json_parse.ml" + + | 8 -> +# 153 "ext/ext_json_parse.mll" + (Lbrace) +# 357 "ext/ext_json_parse.ml" + + | 9 -> +# 154 "ext/ext_json_parse.mll" + (Rbrace) +# 362 "ext/ext_json_parse.ml" + + | 10 -> +# 155 "ext/ext_json_parse.mll" + (Comma) +# 367 "ext/ext_json_parse.ml" + + | 11 -> +# 156 "ext/ext_json_parse.mll" + (Colon) +# 372 "ext/ext_json_parse.ml" + + | 12 -> +# 157 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 377 "ext/ext_json_parse.ml" + + | 13 -> +# 159 "ext/ext_json_parse.mll" + ( Number (Lexing.lexeme lexbuf)) +# 382 "ext/ext_json_parse.ml" + + | 14 -> +# 161 "ext/ext_json_parse.mll" + ( + let pos = Lexing.lexeme_start_p lexbuf in + scan_string buf pos lexbuf; + let content = (Buffer.contents buf) in + Buffer.clear buf ; + String content +) +# 393 "ext/ext_json_parse.ml" + + | 15 -> +# 168 "ext/ext_json_parse.mll" + (Eof ) +# 398 "ext/ext_json_parse.ml" + + | 16 -> +let +# 169 "ext/ext_json_parse.mll" + c +# 404 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in +# 169 "ext/ext_json_parse.mll" + ( error lexbuf (Illegal_character c )) +# 408 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state + +and comment buf lexbuf = + __ocaml_lex_comment_rec buf lexbuf 40 +and __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 171 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 420 "ext/ext_json_parse.ml" + + | 1 -> +# 172 "ext/ext_json_parse.mll" + (comment buf lexbuf) +# 425 "ext/ext_json_parse.ml" + + | 2 -> +# 173 "ext/ext_json_parse.mll" + (error lexbuf Unterminated_comment) +# 430 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state + +and scan_string buf start lexbuf = + __ocaml_lex_scan_string_rec buf start lexbuf 45 +and __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 177 "ext/ext_json_parse.mll" + ( () ) +# 442 "ext/ext_json_parse.ml" + + | 1 -> +# 179 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 2 in + update_loc lexbuf len; + + scan_string buf start lexbuf + ) +# 452 "ext/ext_json_parse.ml" + + | 2 -> +# 186 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 3 in + update_loc lexbuf len; + scan_string buf start lexbuf + ) +# 461 "ext/ext_json_parse.ml" + + | 3 -> +let +# 191 "ext/ext_json_parse.mll" + c +# 467 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 192 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf (char_for_backslash c); + scan_string buf start lexbuf + ) +# 474 "ext/ext_json_parse.ml" + + | 4 -> +let +# 196 "ext/ext_json_parse.mll" + c1 +# 480 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) +and +# 196 "ext/ext_json_parse.mll" + c2 +# 485 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 196 "ext/ext_json_parse.mll" + c3 +# 490 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) +and +# 196 "ext/ext_json_parse.mll" + s +# 495 "ext/ext_json_parse.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_start_pos + 4) in +# 197 "ext/ext_json_parse.mll" + ( + let v = dec_code c1 c2 c3 in + if v > 255 then + error lexbuf (Illegal_escape s) ; + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 506 "ext/ext_json_parse.ml" + + | 5 -> +let +# 205 "ext/ext_json_parse.mll" + c1 +# 512 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 205 "ext/ext_json_parse.mll" + c2 +# 517 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) in +# 206 "ext/ext_json_parse.mll" + ( + let v = hex_code c1 c2 in + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 526 "ext/ext_json_parse.ml" + + | 6 -> +let +# 212 "ext/ext_json_parse.mll" + c +# 532 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 213 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf '\\'; + Buffer.add_char buf c; + + scan_string buf start lexbuf + ) +# 541 "ext/ext_json_parse.ml" + + | 7 -> +# 220 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + Buffer.add_char buf lf; + + scan_string buf start lexbuf + ) +# 551 "ext/ext_json_parse.ml" + + | 8 -> +# 227 "ext/ext_json_parse.mll" + ( + let ofs = lexbuf.lex_start_pos in + let len = lexbuf.lex_curr_pos - ofs in + Buffer.add_subbytes buf lexbuf.lex_buffer ofs len; + + scan_string buf start lexbuf + ) +# 562 "ext/ext_json_parse.ml" + + | 9 -> +# 235 "ext/ext_json_parse.mll" + ( + error lexbuf Unterminated_string + ) +# 569 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state + +;; + +# 239 "ext/ext_json_parse.mll" + + + + + + + +let rec parse_json lexbuf = + let buf = Buffer.create 64 in + let look_ahead = ref None in + let token () : token = + match !look_ahead with + | None -> + lex_json buf lexbuf + | Some x -> + look_ahead := None ; + x + in + let push e = look_ahead := Some e in + let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = + match token () with + | True -> True lexbuf.lex_start_p + | False -> False lexbuf.lex_start_p + | Null -> Null lexbuf.lex_start_p + | Number s -> Flo {flo = s; loc = lexbuf.lex_start_p} + | String s -> Str { str = s; loc = lexbuf.lex_start_p} + | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf + | Lbrace -> parse_map lexbuf.lex_start_p String_map.empty lexbuf + | _ -> error lexbuf Unexpected_token +(** Note if we remove [trailing_comma] support + we should report errors (actually more work), for example + {[ + match token () with + | Rbracket -> + if trailing_comma then + error lexbuf Trailing_comma_in_array + else + ]} + {[ + match token () with + | Rbrace -> + if trailing_comma then + error lexbuf Trailing_comma_in_obj + else + + ]} + *) + and parse_array loc_start loc_finish acc lexbuf + : Ext_json_types.t = + match token () with + | Rbracket -> + Arr {loc_start ; content = Ext_array.reverse_of_list acc ; + loc_end = lexbuf.lex_curr_p } + | x -> + push x ; + let new_one = json lexbuf in + begin match token () with + | Comma -> + parse_array loc_start loc_finish (new_one :: acc) lexbuf + | Rbracket + -> Arr {content = (Ext_array.reverse_of_list (new_one::acc)); + loc_start ; + loc_end = lexbuf.lex_curr_p } + | _ -> + error lexbuf Expect_comma_or_rbracket + end + and parse_map loc_start acc lexbuf : Ext_json_types.t = + match token () with + | Rbrace -> + Obj { map = acc ; loc = loc_start} + | String key -> + begin match token () with + | Colon -> + let value = json lexbuf in + begin match token () with + | Rbrace -> Obj {map = String_map.add acc key value ; loc = loc_start} + | Comma -> + parse_map loc_start (String_map.add acc key value ) lexbuf + | _ -> error lexbuf Expect_comma_or_rbrace + end + | _ -> error lexbuf Expect_colon + end + | _ -> error lexbuf Expect_string_or_rbrace + in + let v = json lexbuf in + match token () with + | Eof -> v + | _ -> error lexbuf Expect_eof + +let parse_json_from_string s = + parse_json (Lexing.from_string s ) + +let parse_json_from_chan fname in_chan = + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan fname in + parse_json lexbuf + +let parse_json_from_file s = + let in_chan = open_in s in + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan s in + match parse_json lexbuf with + | exception e -> close_in in_chan ; raise e + | v -> close_in in_chan; v + + + + + +# 688 "ext/ext_json_parse.ml" + +end +module Ext_obj : sig +#1 "ext_obj.mli" +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * 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 dump : 'a -> string +val pp_any : Format.formatter -> 'a -> unit + +end = struct +#1 "ext_obj.ml" +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * 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 rec dump r = + if Obj.is_int r then + string_of_int (Obj.magic r : int) + else (* Block. *) + let rec get_fields acc = function + | 0 -> acc + | n -> let n = n-1 in get_fields (Obj.field r n :: acc) n + in + let rec is_list r = + if Obj.is_int r then + r = Obj.repr 0 (* [] *) + else + let s = Obj.size r and t = Obj.tag r in + t = 0 && s = 2 && is_list (Obj.field r 1) (* h :: t *) + in + let rec get_list r = + if Obj.is_int r then + [] + else + let h = Obj.field r 0 and t = get_list (Obj.field r 1) in + h :: t + in + let opaque name = + (* XXX In future, print the address of value 'r'. Not possible + * in pure OCaml at the moment. *) + "<" ^ name ^ ">" + in + let s = Obj.size r and t = Obj.tag r in + (* From the tag, determine the type of block. *) + match t with + | _ when is_list r -> + let fields = get_list r in + "[" ^ String.concat "; " (Ext_list.map fields dump) ^ "]" + | 0 -> + let fields = get_fields [] s in + "(" ^ String.concat ", " (Ext_list.map fields dump) ^ ")" + | x when x = Obj.lazy_tag -> + (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not + * clear if very large constructed values could have the same + * tag. XXX *) + opaque "lazy" + | x when x = Obj.closure_tag -> + opaque "closure" + | x when x = Obj.object_tag -> + let fields = get_fields [] s in + let _clasz, id, slots = + match fields with + | h::h'::t -> h, h', t + | _ -> assert false + in + (* No information on decoding the class (first field). So just print + * out the ID and the slots. *) + "Object #" ^ dump id ^ " (" ^ String.concat ", " (Ext_list.map slots dump) ^ ")" + | x when x = Obj.infix_tag -> + opaque "infix" + | x when x = Obj.forward_tag -> + opaque "forward" + | x when x < Obj.no_scan_tag -> + let fields = get_fields [] s in + "Tag" ^ string_of_int t ^ + " (" ^ String.concat ", " (Ext_list.map fields dump) ^ ")" + | x when x = Obj.string_tag -> + "\"" ^ String.escaped (Obj.magic r : string) ^ "\"" + | x when x = Obj.double_tag -> + string_of_float (Obj.magic r : float) + | x when x = Obj.abstract_tag -> + opaque "abstract" + | x when x = Obj.custom_tag -> + opaque "custom" + | x when x = Obj.custom_tag -> + opaque "final" + | x when x = Obj.double_array_tag -> + "[|"^ + String.concat ";" + (Array.to_list (Array.map string_of_float (Obj.magic r : float array))) ^ + "|]" + | _ -> + opaque (Printf.sprintf "unknown: tag %d size %d" t s) + +let dump v = dump (Obj.repr v) + +let pp_any fmt v = + Format.fprintf fmt "@[%s@]" + (dump v ) + + + +end +module Ounit_json_tests += struct +#1 "ounit_json_tests.ml" + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +open Ext_json_parse +let (|?) m (key, cb) = + m |> Ext_json.test key cb + +let rec strip (x : Ext_json_types.t) : Ext_json_noloc.t = + let open Ext_json_noloc in + match x with + | True _ -> true_ + | False _ -> false_ + | Null _ -> null + | Flo {flo = s} -> flo s + | Str {str = s} -> str s + | Arr {content } -> arr (Array.map strip content) + | Obj {map} -> + obj (String_map.map map strip) + +let id_parsing_serializing x = + let normal_s = + Ext_json_noloc.to_string + @@ strip + @@ Ext_json_parse.parse_json_from_string x + in + let normal_ss = + Ext_json_noloc.to_string + @@ strip + @@ Ext_json_parse.parse_json_from_string normal_s + in + if normal_s <> normal_ss then + begin + prerr_endline "ERROR"; + prerr_endline normal_s ; + prerr_endline normal_ss ; + end; + OUnit.assert_equal ~cmp:(fun (x:string) y -> x = y) normal_s normal_ss + +let id_parsing_x2 x = + let stru = Ext_json_parse.parse_json_from_string x |> strip in + let normal_s = Ext_json_noloc.to_string stru in + let normal_ss = strip (Ext_json_parse.parse_json_from_string normal_s) in + if Ext_json_noloc.equal stru normal_ss then + true + else begin + prerr_endline "ERROR"; + prerr_endline normal_s; + Format.fprintf Format.err_formatter + "%a@.%a@." Ext_obj.pp_any stru Ext_obj.pp_any normal_ss; + + prerr_endline (Ext_json_noloc.to_string normal_ss); + false + end + +let test_data = + [{| + {} + |}; + {| [] |}; + {| [1,2,3]|}; + {| ["x", "y", 1,2,3 ]|}; + {| { "x" : 3, "y" : "x", "z" : [1,2,3, "x"] }|}; + {| {"x " : true , "y" : false , "z\"" : 1} |} + ] +exception Parse_error +let suites = + __FILE__ + >::: + [ + + __LOC__ >:: begin fun _ -> + List.iter id_parsing_serializing test_data + end; + + __LOC__ >:: begin fun _ -> + List.iteri (fun i x -> OUnit.assert_bool (__LOC__ ^ string_of_int i ) (id_parsing_x2 x)) test_data + end; + "empty_json" >:: begin fun _ -> + let v =parse_json_from_string "{}" in + match v with + | Obj {map = v} -> OUnit.assert_equal (String_map.is_empty v ) true + | _ -> OUnit.assert_failure "should be empty" + end + ; + "empty_arr" >:: begin fun _ -> + let v =parse_json_from_string "[]" in + match v with + | Arr {content = [||]} -> () + | _ -> OUnit.assert_failure "should be empty" + end + ; + "empty trails" >:: begin fun _ -> + (OUnit.assert_raises Parse_error @@ fun _ -> + try parse_json_from_string {| [,]|} with _ -> raise Parse_error); + OUnit.assert_raises Parse_error @@ fun _ -> + try parse_json_from_string {| {,}|} with _ -> raise Parse_error + end; + "two trails" >:: begin fun _ -> + (OUnit.assert_raises Parse_error @@ fun _ -> + try parse_json_from_string {| [1,2,,]|} with _ -> raise Parse_error); + (OUnit.assert_raises Parse_error @@ fun _ -> + try parse_json_from_string {| { "x": 3, ,}|} with _ -> raise Parse_error) + end; + + "two trails fail" >:: begin fun _ -> + (OUnit.assert_raises Parse_error @@ fun _ -> + try parse_json_from_string {| { "x": 3, 2 ,}|} with _ -> raise Parse_error) + end; + + "trail comma obj" >:: begin fun _ -> + let v = parse_json_from_string {| { "x" : 3 , }|} in + let v1 = parse_json_from_string {| { "x" : 3 , }|} in + let test (v : Ext_json_types.t) = + match v with + | Obj {map = v} -> + v + |? ("x" , `Flo (fun x -> OUnit.assert_equal x "3")) + |> ignore + | _ -> OUnit.assert_failure "trail comma" in + test v ; + test v1 + end + ; + "trail comma arr" >:: begin fun _ -> + let v = parse_json_from_string {| [ 1, 3, ]|} in + let v1 = parse_json_from_string {| [ 1, 3 ]|} in + let test (v : Ext_json_types.t) = + match v with + | Arr { content = [| Flo {flo = "1"} ; Flo { flo = "3"} |] } -> () + | _ -> OUnit.assert_failure "trailing comma array" in + test v ; + test v1 + end + ] + +end +module Ounit_list_test += struct +#1 "ounit_list_test.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal +let printer_int_list = fun xs -> Format.asprintf "%a" + (Format.pp_print_list Format.pp_print_int + ~pp_sep:Format.pp_print_space + ) xs +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_equal + (Ext_list.flat_map [1;2] (fun x -> [x;x]) ) [1;1;2;2] + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal + (Ext_list.flat_map_append + [1;2] [3;4] (fun x -> [x;x]) ) [1;1;2;2;3;4] + end; + __LOC__ >:: begin fun _ -> + + let (=~) = OUnit.assert_equal ~printer:printer_int_list in + (Ext_list.flat_map [] (fun x -> [succ x ])) =~ []; + (Ext_list.flat_map [1] (fun x -> [x;succ x ]) ) =~ [1;2]; + (Ext_list.flat_map [1;2] (fun x -> [x;succ x ])) =~ [1;2;2;3]; + (Ext_list.flat_map [1;2;3] (fun x -> [x;succ x ]) ) =~ [1;2;2;3;3;4] + end + ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal + (Ext_list.stable_group + [1;2;3;4;3] (=) + ) + ([[1];[2];[4];[3;3]]) + end + ; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:printer_int_list in + let f b _v = if b then 1 else 0 in + Ext_list.map_last [] f =~ []; + Ext_list.map_last [0] f =~ [1]; + Ext_list.map_last [0;0] f =~ [0;1]; + Ext_list.map_last [0;0;0] f =~ [0;0;1]; + Ext_list.map_last [0;0;0;0] f =~ [0;0;0;1]; + Ext_list.map_last [0;0;0;0;0] f =~ [0;0;0;0;1]; + Ext_list.map_last [0;0;0;0;0;0] f =~ [0;0;0;0;0;1]; + Ext_list.map_last [0;0;0;0;0;0;0] f =~ [0;0;0;0;0;0;1]; + end + ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal ( + Ext_list.flat_map_append + [1;2] [false;false] + (fun x -> if x mod 2 = 0 then [true] else []) + ) [true;false;false] + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal ( + Ext_list.map_append + [0;1;2] + ["1";"2";"3"] + (fun x -> string_of_int x) + ) + ["0";"1";"2"; "1";"2";"3"] + end; + + __LOC__ >:: begin fun _ -> + let (a,b) = Ext_list.split_at [1;2;3;4;5;6] 3 in + OUnit.assert_equal (a,b) + ([1;2;3],[4;5;6]); + OUnit.assert_equal (Ext_list.split_at [1] 1) + ([1],[]) ; + OUnit.assert_equal (Ext_list.split_at [1;2;3] 2 ) + ([1;2],[3]) + end; + __LOC__ >:: begin fun _ -> + let printer = fun (a,b) -> + Format.asprintf "([%a],%d)" + (Format.pp_print_list Format.pp_print_int ) a + b + in + let (=~) = OUnit.assert_equal ~printer in + (Ext_list.split_at_last [1;2;3]) + =~ ([1;2],3); + (Ext_list.split_at_last [1;2;3;4;5;6;7;8]) + =~ + ([1;2;3;4;5;6;7],8); + (Ext_list.split_at_last [1;2;3;4;5;6;7;]) + =~ + ([1;2;3;4;5;6],7) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (Ext_list.assoc_by_int [2,"x"; 3,"y"; 1, "z"] 1 None) "z" + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_raise_any + (fun _ -> Ext_list.assoc_by_int [2,"x"; 3,"y"; 1, "z"] 11 None ) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal + (Ext_list.length_compare [0;0;0] 3) `Eq ; + OUnit.assert_equal + (Ext_list.length_compare [0;0;0] 1) `Gt ; + OUnit.assert_equal + (Ext_list.length_compare [0;0;0] 4) `Lt ; + OUnit.assert_equal + (Ext_list.length_compare [] (-1)) `Gt ; + OUnit.assert_equal + (Ext_list.length_compare [] (0)) `Eq ; + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_list.length_larger_than_n [1;2] [1] 1 ); + OUnit.assert_bool __LOC__ + (Ext_list.length_larger_than_n [1;2] [1;2] 0); + OUnit.assert_bool __LOC__ + (Ext_list.length_larger_than_n [1;2] [] 2) + + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_list.length_ge [1;2;3] 3 ); + OUnit.assert_bool __LOC__ + (Ext_list.length_ge [] 0 ); + OUnit.assert_bool __LOC__ + (not (Ext_list.length_ge [] 1 )); + + end; + + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal in + + let f p x = Ext_list.exclude_with_val x p in + f (fun x -> x = 1) [1;2;3] =~ (Some [2;3]); + f (fun x -> x = 4) [1;2;3] =~ (None); + f (fun x -> x = 2) [1;2;3;2] =~ (Some [1;3]); + f (fun x -> x = 2) [1;2;2;3;2] =~ (Some [1;3]); + f (fun x -> x = 2) [2;2;2] =~ (Some []); + f (fun x -> x = 3) [2;2;2] =~ (None) + end ; + + ] +end +module Int_map : sig +#1 "int_map.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 Map_gen.S with type key = int + +end = struct +#1 "int_map.ml" + +# 2 "ext/map.cppo.ml" +(* we don't create [map_poly], since some operations require raise an exception which carries [key] *) + + + +# 13 "ext/map.cppo.ml" + type key = int + let compare_key = Ext_int.compare + +# 22 "ext/map.cppo.ml" +type 'a t = (key,'a) Map_gen.t +exception Duplicate_key of key + +let empty = Map_gen.empty +let is_empty = Map_gen.is_empty +let iter = Map_gen.iter +let fold = Map_gen.fold +let for_all = Map_gen.for_all +let exists = Map_gen.exists +let singleton = Map_gen.singleton +let cardinal = Map_gen.cardinal +let bindings = Map_gen.bindings +let to_sorted_array = Map_gen.to_sorted_array +let keys = Map_gen.keys +let choose = Map_gen.choose +let partition = Map_gen.partition +let filter = Map_gen.filter +let map = Map_gen.map +let mapi = Map_gen.mapi +let bal = Map_gen.bal +let height = Map_gen.height +let max_binding_exn = Map_gen.max_binding_exn +let min_binding_exn = Map_gen.min_binding_exn + + +let rec add (tree : _ Map_gen.t as 'a) x data : 'a = match tree with + | Empty -> + Node(Empty, x, data, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, data, r, h) + else if c < 0 then + bal (add l x data ) v d r + else + bal l v d (add r x data ) + + +let rec adjust (tree : _ Map_gen.t as 'a) x replace : 'a = + match tree with + | Empty -> + Node(Empty, x, replace None, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, replace (Some d) , r, h) + else if c < 0 then + bal (adjust l x replace ) v d r + else + bal l v d (adjust r x replace ) + + +let rec find_exn (tree : _ Map_gen.t ) x = match tree with + | Empty -> + raise Not_found + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_exn (if c < 0 then l else r) x + +let rec find_opt (tree : _ Map_gen.t ) x = match tree with + | Empty -> None + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then Some d + else find_opt (if c < 0 then l else r) x + +let rec find_default (tree : _ Map_gen.t ) x default = match tree with + | Empty -> default + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_default (if c < 0 then l else r) x default + +let rec mem (tree : _ Map_gen.t ) x= match tree with + | Empty -> + false + | Node(l, v, d, r, _) -> + let c = compare_key x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : _ Map_gen.t as 'a) x : 'a = match tree with + | Empty -> + Empty + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Map_gen.merge l r + else if c < 0 then + bal (remove l x) v d r + else + bal l v d (remove r x ) + + +let rec split (tree : _ Map_gen.t as 'a) x : 'a * _ option * 'a = match tree with + | Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Map_gen.join rl v d r) + else + let (lr, pres, rr) = split r x in (Map_gen.join l v d lr, pres, rr) + +let rec merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) f : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split s2 v1 in + Map_gen.concat_or_join (merge l1 l2 f) v1 (f v1 (Some d1) d2) (merge r1 r2 f) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split s1 v2 in + Map_gen.concat_or_join (merge l1 l2 f) v2 (f v2 d1 (Some d2)) (merge r1 r2 f) + | _ -> + assert false + +let rec disjoint_merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + begin match split s2 v1 with + | l2, None, r2 -> + Map_gen.join (disjoint_merge l1 l2) v1 d1 (disjoint_merge r1 r2) + | _, Some _, _ -> + raise (Duplicate_key v1) + end + | (_, Node (l2, v2, d2, r2, h2)) -> + begin match split s1 v2 with + | (l1, None, r1) -> + Map_gen.join (disjoint_merge l1 l2) v2 d2 (disjoint_merge r1 r2) + | (_, Some _, _) -> + raise (Duplicate_key v2) + end + | _ -> + assert false + + + +let compare m1 m2 cmp = Map_gen.compare compare_key cmp m1 m2 + +let equal m1 m2 cmp = Map_gen.equal compare_key cmp m1 m2 + +let add_list (xs : _ list ) init = + Ext_list.fold_left xs init (fun acc (k,v) -> add acc k v ) + +let of_list xs = add_list xs empty + +let of_array xs = + Ext_array.fold_left xs empty (fun acc (k,v) -> add acc k v ) + +end +module Ounit_map_tests += struct +#1 "ounit_map_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +let test_sorted_strict arr = + let v = Int_map.of_array arr |> Int_map.to_sorted_array in + let arr_copy = Array.copy arr in + Array.sort (fun ((a:int),_) (b,_) -> compare a b ) arr_copy; + v =~ arr_copy + +let suites = + __MODULE__ >::: + [ + __LOC__ >:: begin fun _ -> + [1,"1"; 2,"2"; 12,"12"; 3, "3"] + |> Int_map.of_list + |> Int_map.keys + |> OUnit.assert_equal [1;2;3;12] + end + ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (Int_map.cardinal Int_map.empty) 0 ; + OUnit.assert_equal ([1,"1"; 2,"2"; 12,"12"; 3, "3"] + |> Int_map.of_list|>Int_map.cardinal ) 4 + end; + __LOC__ >:: begin fun _ -> + let v = + [1,"1"; 2,"2"; 12,"12"; 3, "3"] + |> Int_map.of_list + |> Int_map.to_sorted_array in + Array.length v =~ 4 ; + v =~ [|1,"1"; 2,"2"; 3, "3"; 12,"12"; |] + end; + __LOC__ >:: begin fun _ -> + test_sorted_strict [||]; + test_sorted_strict [|1,""|]; + test_sorted_strict [|2,""; 1,""|]; + test_sorted_strict [|2,""; 1,""; 3, ""|]; + test_sorted_strict [|2,""; 1,""; 3, ""; 4,""|] + end; + __LOC__ >:: begin fun _ -> + Int_map.cardinal (Int_map.of_array (Array.init 1000 (fun i -> (i,i)))) + =~ 1000 + end; + __LOC__ >:: begin fun _ -> + let count = 1000 in + let a = Array.init count (fun x -> x ) in + let v = Int_map.empty in + let u = + begin + let v = Array.fold_left (fun acc key -> Int_map.adjust acc key (fun v -> match v with None -> 1 | Some v -> succ v) ) v a in + Array.fold_left (fun acc key -> Int_map.adjust acc key (fun v -> match v with None -> 1 | Some v -> succ v) ) v a + end + in + Int_map.iter u (fun _ v -> v =~ 2 ) ; + Int_map.cardinal u =~ count + end + ] + +end +module Ounit_ordered_hash_set_tests += struct +#1 "ounit_ordered_hash_set_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + let a = [|"a";"b";"c"|] in + Ordered_hash_set_string.(to_sorted_array (of_array a)) + =~ a + end; + + __LOC__ >:: begin fun _ -> + let a = Array.init 1000 (fun i -> string_of_int i) in + Ordered_hash_set_string.(to_sorted_array (of_array a)) + =~ a + end; + + __LOC__ >:: begin fun _ -> + let a = [|"a";"b";"c"; "a"; "d"|] in + Ordered_hash_set_string.(to_sorted_array (of_array a)) + =~ [| "a" ; "b"; "c"; "d" |] + end; + + __LOC__ >:: begin fun _ -> + let b = Array.init 500 (fun i -> string_of_int i) in + let a = Array.append b b in + Ordered_hash_set_string.(to_sorted_array (of_array a)) + =~ b + end; + + __LOC__ >:: begin fun _ -> + let h = Ordered_hash_set_string.create 1 in + Ordered_hash_set_string.(to_sorted_array h) + =~ [||]; + Ordered_hash_set_string.add h "1"; + print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h)); + Ordered_hash_set_string.(to_sorted_array h) + =~ [|"1"|]; + + end; + + __LOC__ >:: begin fun _ -> + let h = Ordered_hash_set_string.create 1 in + let count = 3000 in + for i = 0 to count - 1 do + Ordered_hash_set_string.add h (string_of_int i) ; + done ; + print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h)); + Ordered_hash_set_string.(to_sorted_array h) + =~ (Array.init count (fun i -> string_of_int i )) + end; + + __LOC__ >:: begin fun _ -> + let h = Ordered_hash_set_string.create 1 in + let count = 1000_000 in + for i = 0 to count - 1 do + Ordered_hash_set_string.add h (string_of_int i) ; + done ; + for i = 0 to count - 1 do + OUnit.assert_bool "exists" (Ordered_hash_set_string.mem h (string_of_int i)) + done; + for i = 0 to count - 1 do + OUnit.assert_equal (Ordered_hash_set_string.rank h (string_of_int i)) i + done; + OUnit.assert_equal + (Ordered_hash_set_string.fold(fun key rank acc -> assert (string_of_int rank = key); (acc + 1) ) h 0) + count + ; + Ordered_hash_set_string.iter (fun key rank -> assert (string_of_int rank = key)) h ; + OUnit.assert_equal (Ordered_hash_set_string.length h) count; + print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h)); + Ordered_hash_set_string.clear h ; + OUnit.assert_equal (Ordered_hash_set_string.length h) 0; + end; + __LOC__ >:: begin fun _ -> + let count = 1000_000 in + let h = Ordered_hash_set_string.create ( count) in + for i = 0 to count - 1 do + Ordered_hash_set_string.add h (string_of_int i) ; + done ; + for i = 0 to count - 1 do + OUnit.assert_bool "exists" (Ordered_hash_set_string.mem h (string_of_int i)) + done; + for i = 0 to count - 1 do + OUnit.assert_equal (Ordered_hash_set_string.rank h (string_of_int i)) i + done; + OUnit.assert_equal + (Ordered_hash_set_string.fold(fun key rank acc -> assert (string_of_int rank = key); (acc + 1) ) h 0) + count + ; + Ordered_hash_set_string.iter (fun key rank -> assert (string_of_int rank = key)) h ; + OUnit.assert_equal (Ordered_hash_set_string.length h) count; + print_endline ("\n"^__LOC__ ^ "\n" ^ Ext_util.stats_to_string (Ordered_hash_set_string.stats h)); + Ordered_hash_set_string.clear h ; + OUnit.assert_equal (Ordered_hash_set_string.length h) 0; + end; + __LOC__ >:: begin fun _ -> + Ordered_hash_set_string.to_sorted_array (Ordered_hash_set_string.of_array [||]) =~ [||]; + Ordered_hash_set_string.to_sorted_array (Ordered_hash_set_string.of_array [|"1"|]) =~ [|"1"|] + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_raises Not_found (fun _ -> Ordered_hash_set_string.choose_exn (Ordered_hash_set_string.of_array [||])) + end; + + + __LOC__ >:: begin fun _ -> + let count = 1000 in + let v = Ordered_hash_set_string.of_array (Array.init count (fun i -> string_of_int i) ) in + for i = 0 to count - 1 do + Ordered_hash_set_string.replace v (string_of_int i) (string_of_int i ^ Ext_string.single_colon) + done ; + OUnit.assert_equal (Ordered_hash_set_string.length v) count; + OUnit.assert_equal + (Ordered_hash_set_string.to_sorted_array v ) + (Array.init count (fun i -> string_of_int i ^ Ext_string.single_colon)) + + end + ] + +end +module Ounit_path_tests += struct +#1 "ounit_path_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + + +let normalize = Ext_path.normalize_absolute_path +let (=~) x y = + OUnit.assert_equal + ~printer:(fun x -> x) + ~cmp:(fun x y -> Ext_string.equal x y ) x y + +let suites = + __FILE__ + >::: + [ + "linux path tests" >:: begin fun _ -> + let norm = + Array.map normalize + [| + "/gsho/./.."; + "/a/b/../c../d/e/f"; + "/a/b/../c/../d/e/f"; + "/gsho/./../.."; + "/a/b/c/d"; + "/a/b/c/d/"; + "/a/"; + "/a"; + "/a.txt/"; + "/a.txt" + |] in + OUnit.assert_equal norm + [| + "/"; + "/a/c../d/e/f"; + "/a/d/e/f"; + "/"; + "/a/b/c/d" ; + "/a/b/c/d"; + "/a"; + "/a"; + "/a.txt"; + "/a.txt" + |] + end; + __LOC__ >:: begin fun _ -> + normalize "/./a/.////////j/k//../////..///././b/./c/d/./." =~ "/a/b/c/d" + end; + __LOC__ >:: begin fun _ -> + normalize "/./a/.////////j/k//../////..///././b/./c/d/././../" =~ "/a/b/c" + end; + + __LOC__ >:: begin fun _ -> + let aux a b result = + + Ext_path.rel_normalized_absolute_path + ~from:a b =~ result ; + + Ext_path.rel_normalized_absolute_path + ~from:(String.sub a 0 (String.length a - 1)) + b =~ result ; + + Ext_path.rel_normalized_absolute_path + ~from:a + (String.sub b 0 (String.length b - 1)) =~ result + ; + + + Ext_path.rel_normalized_absolute_path + ~from:(String.sub a 0 (String.length a - 1 )) + (String.sub b 0 (String.length b - 1)) + =~ result + in + aux + "/a/b/c/" + "/a/b/c/d/" "./d"; + aux + "/a/b/c/" + "/a/b/c/d/e/f/" "./d/e/f" ; + aux + "/a/b/c/d/" + "/a/b/c/" ".." ; + aux + "/a/b/c/d/" + "/a/b/" "../.." ; + aux + "/a/b/c/d/" + "/a/" "../../.." ; + aux + "/a/b/c/d/" + "//" "../../../.." ; + + + end; + (* This is still correct just not optimal depends + on user's perspective *) + __LOC__ >:: begin fun _ -> + Ext_path.rel_normalized_absolute_path + ~from:"/a/b/c/d" + "/x/y" =~ "../../../../x/y" + + end; + + (* used in module system: [es6-global] and [amdjs-global] *) + __LOC__ >:: begin fun _ -> + Ext_path.rel_normalized_absolute_path + ~from:"/usr/local/lib/node_modules/" + "//" =~ "../../../.."; + Ext_path.rel_normalized_absolute_path + ~from:"/usr/local/lib/node_modules/" + "/" =~ "../../../.."; + Ext_path.rel_normalized_absolute_path + ~from:"./" + "./node_modules/xx/./xx.js" =~ "./node_modules/xx/xx.js"; + Ext_path.rel_normalized_absolute_path + ~from:"././" + "./node_modules/xx/./xx.js" =~ "./node_modules/xx/xx.js" + end; + + __LOC__ >:: begin fun _ -> + Ext_path.node_rebase_file + ~to_:( "lib/js/src/a") + ~from:( "lib/js/src") "b" =~ "./a/b" ; + Ext_path.node_rebase_file + ~to_:( "lib/js/src/") + ~from:( "lib/js/src") "b" =~ "./b" ; + Ext_path.node_rebase_file + ~to_:( "lib/js/src") + ~from:("lib/js/src/a") "b" =~ "../b"; + Ext_path.node_rebase_file + ~to_:( "lib/js/src/a") + ~from:("lib/js/") "b" =~ "./src/a/b" ; + Ext_path.node_rebase_file + ~to_:("lib/js/./src/a") + ~from:("lib/js/src/a/") "b" + =~ "./b"; + + Ext_path.node_rebase_file + ~to_:"lib/js/src/a" + ~from: "lib/js/src/a/" "b" + =~ "./b"; + Ext_path.node_rebase_file + ~to_:"lib/js/src/a/" + ~from:"lib/js/src/a/" "b" + =~ "./b" + end + ] + +end +module Resize_array : sig +#1 "resize_array.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. *) + +module Make ( Resize : Vec_gen.ResizeType) : Vec_gen.S with type elt = Resize.t + + + +end = struct +#1 "resize_array.ml" +# 1 "ext/vec.cppo.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. *) +# 25 "ext/vec.cppo.ml" +external unsafe_blit : + 'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit" +module Make ( Resize : Vec_gen.ResizeType) = struct + type elt = Resize.t + + let null = Resize.null + + +# 41 "ext/vec.cppo.ml" +external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub" + +type t = { + mutable arr : elt array ; + mutable len : int ; +} + +let length d = d.len + +let compact d = + let d_arr = d.arr in + if d.len <> Array.length d_arr then + begin + let newarr = unsafe_sub d_arr 0 d.len in + d.arr <- newarr + end +let singleton v = + { + len = 1 ; + arr = [|v|] + } + +let empty () = + { + len = 0; + arr = [||]; + } + +let is_empty d = + d.len = 0 + +let reset d = + d.len <- 0; + d.arr <- [||] + + +(* For [to_*] operations, we should be careful to call {!Array.*} function + in case we operate on the whole array +*) +let to_list d = + let rec loop (d_arr : elt array) idx accum = + if idx < 0 then accum else loop d_arr (idx - 1) (Array.unsafe_get d_arr idx :: accum) + in + loop d.arr (d.len - 1) [] + + +let of_list lst = + let arr = Array.of_list lst in + { arr ; len = Array.length arr} + + +let to_array d = + unsafe_sub d.arr 0 d.len + +let of_array src = + { + len = Array.length src; + arr = Array.copy src; + (* okay to call {!Array.copy}*) + } +let of_sub_array arr off len = + { + len = len ; + arr = Array.sub arr off len + } +let unsafe_internal_array v = v.arr +(* we can not call {!Array.copy} *) +let copy src = + let len = src.len in + { + len ; + arr = unsafe_sub src.arr 0 len ; + } + +(* FIXME *) +let reverse_in_place src = + Ext_array.reverse_range src.arr 0 src.len + + + + +(* {!Array.sub} is not enough for error checking, it + may contain some garbage + *) +let sub (src : t) start len = + let src_len = src.len in + if len < 0 || start > src_len - len then invalid_arg "Vec.sub" + else + { len ; + arr = unsafe_sub src.arr start len } + +let iter d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f (Array.unsafe_get arr i) + done + +let iteri d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f i (Array.unsafe_get arr i) + done + +let iter_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iter_range" + else + let d_arr = d.arr in + for i = from to to_ do + f (Array.unsafe_get d_arr i) + done + +let iteri_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iteri_range" + else + let d_arr = d.arr in + for i = from to to_ do + f i (Array.unsafe_get d_arr i) + done + +let map_into_array f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [||] + else + let first_one = f (Array.unsafe_get src_arr 0) in + let arr = Array.make src_len first_one in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + arr +let map_into_list f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [] + else + let acc = ref [] in + for i = src_len - 1 downto 0 do + acc := f (Array.unsafe_get src_arr i) :: !acc + done; + !acc + +let mapi f src = + let len = src.len in + if len = 0 then { len ; arr = [| |] } + else + let src_arr = src.arr in + let arr = Array.make len (Array.unsafe_get src_arr 0) in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i (Array.unsafe_get src_arr i)) + done; + { + len ; + arr ; + } + +let fold_left f x a = + let rec loop a_len (a_arr : elt array) idx x = + if idx >= a_len then x else + loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx)) + in + loop a.len a.arr 0 x + +let fold_right f a x = + let rec loop (a_arr : elt array) idx x = + if idx < 0 then x + else loop a_arr (idx - 1) (f (Array.unsafe_get a_arr idx) x) + in + loop a.arr (a.len - 1) x + +(** + [filter] and [inplace_filter] +*) +let filter f d = + let new_d = copy d in + let new_d_arr = new_d.arr in + let d_arr = d.arr in + let p = ref 0 in + for i = 0 to d.len - 1 do + let x = Array.unsafe_get d_arr i in + (* TODO: can be optimized for segments blit *) + if f x then + begin + Array.unsafe_set new_d_arr !p x; + incr p; + end; + done; + new_d.len <- !p; + new_d + +let equal eq x y : bool = + if x.len <> y.len then false + else + let rec aux x_arr y_arr i = + if i < 0 then true else + if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then + aux x_arr y_arr (i - 1) + else false in + aux x.arr y.arr (x.len - 1) + +let get d i = + if i < 0 || i >= d.len then invalid_arg "Resize_array.get" + else Array.unsafe_get d.arr i +let unsafe_get d i = Array.unsafe_get d.arr i +let last d = + if d.len <= 0 then invalid_arg "Resize_array.last" + else Array.unsafe_get d.arr (d.len - 1) + +let capacity d = Array.length d.arr + +(* Attention can not use {!Array.exists} since the bound is not the same *) +let exists p d = + let a = d.arr in + let n = d.len in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + +let map f src = + let src_len = src.len in + if src_len = 0 then { len = 0 ; arr = [||]} + (* TODO: we may share the empty array + but sharing mutable state is very challenging, + the tricky part is to avoid mutating the immutable array, + here it looks fine -- + invariant: whenever [.arr] mutated, make sure it is not an empty array + Actually no: since starting from an empty array + {[ + push v (* the address of v should not be changed *) + ]} + *) + else + let src_arr = src.arr in + let first = f (Array.unsafe_get src_arr 0 ) in + let arr = Array.make src_len first in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + { + len = src_len; + arr = arr; + } + +let init len f = + if len < 0 then invalid_arg "Resize_array.init" + else if len = 0 then { len = 0 ; arr = [||] } + else + let first = f 0 in + let arr = Array.make len first in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i) + done; + { + + len ; + arr + } + + + + let make initsize : t = + if initsize < 0 then invalid_arg "Resize_array.make" ; + { + + len = 0; + arr = Array.make initsize null ; + } + + + + let reserve (d : t ) s = + let d_len = d.len in + let d_arr = d.arr in + if s < d_len || s < Array.length d_arr then () + else + let new_capacity = min Sys.max_array_length s in + let new_d_arr = Array.make new_capacity null in + unsafe_blit d_arr 0 new_d_arr 0 d_len; + d.arr <- new_d_arr + + let push (d : t) v = + let d_len = d.len in + let d_arr = d.arr in + let d_arr_len = Array.length d_arr in + if d_arr_len = 0 then + begin + d.len <- 1 ; + d.arr <- [| v |] + end + else + begin + if d_len = d_arr_len then + begin + if d_len >= Sys.max_array_length then + failwith "exceeds max_array_length"; + let new_capacity = min Sys.max_array_length d_len * 2 + (* [d_len] can not be zero, so [*2] will enlarge *) + in + let new_d_arr = Array.make new_capacity null in + d.arr <- new_d_arr; + unsafe_blit d_arr 0 new_d_arr 0 d_len ; + end; + d.len <- d_len + 1; + Array.unsafe_set d.arr d_len v + end + +(** delete element at offset [idx], will raise exception when have invalid input *) + let delete (d : t) idx = + let d_len = d.len in + if idx < 0 || idx >= d_len then invalid_arg "Resize_array.delete" ; + let arr = d.arr in + unsafe_blit arr (idx + 1) arr idx (d_len - idx - 1); + let idx = d_len - 1 in + d.len <- idx + +# 358 "ext/vec.cppo.ml" + ; + Array.unsafe_set arr idx null + +# 362 "ext/vec.cppo.ml" +(** pop the last element, a specialized version of [delete] *) + let pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.pop"; + d.len <- idx + +# 369 "ext/vec.cppo.ml" + ; + Array.unsafe_set d.arr idx null + +# 373 "ext/vec.cppo.ml" +(** pop and return the last element *) + let get_last_and_pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.get_last_and_pop"; + let last = Array.unsafe_get d.arr idx in + d.len <- idx + +# 381 "ext/vec.cppo.ml" + ; + Array.unsafe_set d.arr idx null + +# 384 "ext/vec.cppo.ml" + ; + last + +(** delete elements start from [idx] with length [len] *) + let delete_range (d : t) idx len = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.delete_range" ; + let arr = d.arr in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len + +# 396 "ext/vec.cppo.ml" + ; + for i = d_len - len to d_len - 1 do + Array.unsafe_set arr i null + done + +# 402 "ext/vec.cppo.ml" +(** delete elements from [idx] with length [len] return the deleted elements as a new vec*) + let get_and_delete_range (d : t) idx len : t = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.get_and_delete_range" ; + let arr = d.arr in + let value = unsafe_sub arr idx len in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len; + +# 412 "ext/vec.cppo.ml" + for i = d_len - len to d_len - 1 do + Array.unsafe_set arr i null + done; + +# 416 "ext/vec.cppo.ml" + {len = len ; arr = value} + + + (** Below are simple wrapper around normal Array operations *) + + let clear (d : t ) = + +# 424 "ext/vec.cppo.ml" + for i = 0 to d.len - 1 do + Array.unsafe_set d.arr i null + done; + +# 428 "ext/vec.cppo.ml" + d.len <- 0 + + + + let inplace_filter f (d : t) : unit = + let d_arr = d.arr in + let d_len = d.len in + let p = ref 0 in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 451 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + + +# 454 "ext/vec.cppo.ml" + let inplace_filter_from start f (d : t) : unit = + if start < 0 then invalid_arg "Vec.inplace_filter_from"; + let d_arr = d.arr in + let d_len = d.len in + let p = ref start in + for i = start to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 473 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + + +# 477 "ext/vec.cppo.ml" +(** inplace filter the elements and accumulate the non-filtered elements *) + let inplace_filter_with f ~cb_no acc (d : t) = + let d_arr = d.arr in + let p = ref 0 in + let d_len = d.len in + let acc = ref acc in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + else + acc := cb_no x !acc + done ; + let last = !p in + +# 500 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + +# 502 "ext/vec.cppo.ml" + ; !acc + + + +# 507 "ext/vec.cppo.ml" +end + +end +module Int_vec_vec : sig +#1 "int_vec_vec.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 Vec_gen.S with type elt = Int_vec.t + +end = struct +#1 "int_vec_vec.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. *) + + +include Resize_array.Make(struct type t = Int_vec.t let null = Int_vec.empty () end) + +end +module Ext_scc : sig +#1 "ext_scc.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. *) + + + + +type node = Int_vec.t +(** Assume input is int array with offset from 0 + Typical input + {[ + [| + [ 1 ; 2 ]; // 0 -> 1, 0 -> 2 + [ 1 ]; // 0 -> 1 + [ 2 ] // 0 -> 2 + |] + ]} + Note that we can tell how many nodes by calculating + [Array.length] of the input +*) +val graph : Int_vec.t array -> Int_vec_vec.t + + +(** Used for unit test *) +val graph_check : node array -> int * int list + +end = struct +#1 "ext_scc.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. *) + +type node = Int_vec.t +(** + [int] as data for this algorithm + Pros: + 1. Easy to eoncode algorithm (especially given that the capacity of node is known) + 2. Algorithms itself are much more efficient + 3. Node comparison semantics is clear + 4. Easy to print output + Cons: + 1. post processing input data + *) +let min_int (x : int) y = if x < y then x else y + + +let graph e = + let index = ref 0 in + let s = Int_vec.empty () in + + let output = Int_vec_vec.empty () in (* collect output *) + let node_numes = Array.length e in + + let on_stack_array = Array.make node_numes false in + let index_array = Array.make node_numes (-1) in + let lowlink_array = Array.make node_numes (-1) in + + let rec scc v_data = + let new_index = !index + 1 in + index := new_index ; + Int_vec.push s v_data; + + index_array.(v_data) <- new_index ; + lowlink_array.(v_data) <- new_index ; + on_stack_array.(v_data) <- true ; + let v = e.(v_data) in + Int_vec.iter v (fun w_data -> + if Array.unsafe_get index_array w_data < 0 then (* not processed *) + begin + scc w_data; + Array.unsafe_set lowlink_array v_data + (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data)) + end + else if Array.unsafe_get on_stack_array w_data then + (* successor is in stack and hence in current scc *) + begin + Array.unsafe_set lowlink_array v_data + (min_int (Array.unsafe_get lowlink_array v_data) (Array.unsafe_get lowlink_array w_data)) + end + ) ; + + if Array.unsafe_get lowlink_array v_data = Array.unsafe_get index_array v_data then + (* start a new scc *) + begin + let s_len = Int_vec.length s in + let last_index = ref (s_len - 1) in + let u = ref (Int_vec.unsafe_get s !last_index) in + while !u <> v_data do + Array.unsafe_set on_stack_array (!u) false ; + last_index := !last_index - 1; + u := Int_vec.unsafe_get s !last_index + done ; + on_stack_array.(v_data) <- false; (* necessary *) + Int_vec_vec.push output (Int_vec.get_and_delete_range s !last_index (s_len - !last_index)); + end + in + for i = 0 to node_numes - 1 do + if Array.unsafe_get index_array i < 0 then scc i + done ; + output + +let graph_check v = + let v = graph v in + Int_vec_vec.length v, + Int_vec_vec.fold_left (fun acc x -> Int_vec.length x :: acc ) [] v + +end +module Ounit_scc_tests += struct +#1 "ounit_scc_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +let tiny_test_cases = {| +13 +22 + 4 2 + 2 3 + 3 2 + 6 0 + 0 1 + 2 0 +11 12 +12 9 + 9 10 + 9 11 + 7 9 +10 12 +11 4 + 4 3 + 3 5 + 6 8 + 8 6 + 5 4 + 0 5 + 6 4 + 6 9 + 7 6 +|} + +let medium_test_cases = {| +50 +147 + 0 7 + 0 34 + 1 14 + 1 45 + 1 21 + 1 22 + 1 22 + 1 49 + 2 19 + 2 25 + 2 33 + 3 4 + 3 17 + 3 27 + 3 36 + 3 42 + 4 17 + 4 17 + 4 27 + 5 43 + 6 13 + 6 13 + 6 28 + 6 28 + 7 41 + 7 44 + 8 19 + 8 48 + 9 9 + 9 11 + 9 30 + 9 46 +10 0 +10 7 +10 28 +10 28 +10 28 +10 29 +10 29 +10 34 +10 41 +11 21 +11 30 +12 9 +12 11 +12 21 +12 21 +12 26 +13 22 +13 23 +13 47 +14 8 +14 21 +14 48 +15 8 +15 34 +15 49 +16 9 +17 20 +17 24 +17 38 +18 6 +18 28 +18 32 +18 42 +19 15 +19 40 +20 3 +20 35 +20 38 +20 46 +22 6 +23 11 +23 21 +23 22 +24 4 +24 5 +24 38 +24 43 +25 2 +25 34 +26 9 +26 12 +26 16 +27 5 +27 24 +27 32 +27 31 +27 42 +28 22 +28 29 +28 39 +28 44 +29 22 +29 49 +30 23 +30 37 +31 18 +31 32 +32 5 +32 6 +32 13 +32 37 +32 47 +33 2 +33 8 +33 19 +34 2 +34 19 +34 40 +35 9 +35 37 +35 46 +36 20 +36 42 +37 5 +37 9 +37 35 +37 47 +37 47 +38 35 +38 37 +38 38 +39 18 +39 42 +40 15 +41 28 +41 44 +42 31 +43 37 +43 38 +44 39 +45 8 +45 14 +45 14 +45 15 +45 49 +46 16 +47 23 +47 30 +48 12 +48 21 +48 33 +48 33 +49 34 +49 22 +49 49 +|} +(* +reference output: +http://algs4.cs.princeton.edu/42digraph/KosarajuSharirSCC.java.html +*) + +let handle_lines tiny_test_cases = + match Ext_string.split tiny_test_cases '\n' with + | nodes :: edges :: rest -> + let nodes_num = int_of_string nodes in + let node_array = + Array.init nodes_num + (fun i -> Int_vec.empty () ) + in + begin + Ext_list.iter rest (fun x -> + match Ext_string.split x ' ' with + | [ a ; b] -> + let a , b = int_of_string a , int_of_string b in + Int_vec.push node_array.(a) b + | _ -> assert false + ); + node_array + end + | _ -> assert false + +let read_file file = + let in_chan = open_in_bin file in + let nodes_sum = int_of_string (input_line in_chan) in + let node_array = Array.init nodes_sum (fun i -> Int_vec.empty () ) in + let rec aux () = + match input_line in_chan with + | exception End_of_file -> () + | x -> + begin match Ext_string.split x ' ' with + | [ a ; b] -> + let a , b = int_of_string a , int_of_string b in + Int_vec.push node_array.(a) b + | _ -> (* assert false *) () + end; + aux () in + print_endline "read data into memory"; + aux (); + (fst (Ext_scc.graph_check node_array)) (* 25 *) + + +let test (input : (string * string list) list) = + (* string -> int mapping + *) + let tbl = String_hashtbl.create 32 in + let idx = ref 0 in + let add x = + if not (String_hashtbl.mem tbl x ) then + begin + String_hashtbl.add tbl x !idx ; + incr idx + end in + input |> List.iter + (fun (x,others) -> List.iter add (x::others)); + let nodes_num = String_hashtbl.length tbl in + let node_array = + Array.init nodes_num + (fun i -> Int_vec.empty () ) in + input |> + List.iter (fun (x,others) -> + let idx = String_hashtbl.find_exn tbl x in + others |> + List.iter (fun y -> Int_vec.push node_array.(idx) (String_hashtbl.find_exn tbl y ) ) + ) ; + Ext_scc.graph_check node_array + +let test2 (input : (string * string list) list) = + (* string -> int mapping + *) + let tbl = String_hashtbl.create 32 in + let idx = ref 0 in + let add x = + if not (String_hashtbl.mem tbl x ) then + begin + String_hashtbl.add tbl x !idx ; + incr idx + end in + input |> List.iter + (fun (x,others) -> List.iter add (x::others)); + let nodes_num = String_hashtbl.length tbl in + let other_mapping = Array.make nodes_num "" in + String_hashtbl.iter tbl (fun k v -> other_mapping.(v) <- k ) ; + + let node_array = + Array.init nodes_num + (fun i -> Int_vec.empty () ) in + input |> + List.iter (fun (x,others) -> + let idx = String_hashtbl.find_exn tbl x in + others |> + List.iter (fun y -> Int_vec.push node_array.(idx) (String_hashtbl.find_exn tbl y ) ) + ) ; + let output = Ext_scc.graph node_array in + output |> Int_vec_vec.map_into_array (fun int_vec -> Int_vec.map_into_array (fun i -> other_mapping.(i)) int_vec ) + + +let suites = + __FILE__ + >::: [ + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines tiny_test_cases)) 5 + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (fst @@ Ext_scc.graph_check (handle_lines medium_test_cases)) 10 + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", []; + ]) (3 , [1;2;1]) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", []; + "e", [] + ]) (4, [1;1;2;1]) + (* {[ + a -> b + a -> c + b -> c + b -> d + c -> b + d + e + ]} + {[ + [d ; e ; [b;c] [a] ] + ]} + *) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", ["e"]; + "e", [] + ]) (4 , [1;2;1;1]) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", ["e"]; + "e", ["c"] + ]) (2, [1;4]) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", ["e"]; + "e", ["a"] + ]) (1, [5]) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "a", ["b"]; + "b" , ["c" ]; + "c", [ ]; + "d", []; + "e", [] + ]) (5, [1;1;1;1;1]) + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test [ + "1", ["0"]; + "0" , ["2" ]; + "2", ["1" ]; + "0", ["3"]; + "3", [ "4"] + ]) (3, [3;1;1]) + end ; + (* http://algs4.cs.princeton.edu/42digraph/largeDG.txt *) + (* __LOC__ >:: begin fun _ -> *) + (* OUnit.assert_equal (read_file "largeDG.txt") 25 *) + (* end *) + (* ; *) + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test2 [ + "a", ["b" ; "c"]; + "b" , ["c" ; "d"]; + "c", [ "b"]; + "d", []; + ]) [|[|"d"|]; [|"b"; "c"|]; [|"a"|]|] + end ; + + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (test2 [ + "a", ["b"]; + "b" , ["c" ]; + "c", ["d" ]; + "d", ["e"]; + "e", [] + ]) [|[|"e"|]; [|"d"|]; [|"c"|]; [|"b"|]; [|"a"|]|] + end ; + + ] + +end +module Ext_namespace : sig +#1 "ext_namespace.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + +(** [make ~ns "a" ] + A typical example would return "a-Ns" + Note the namespace comes from the output of [namespace_of_package_name] +*) +val make : ns:string -> string -> string + +val try_split_module_name : + string -> (string * string ) option + +(** [ends_with_bs_suffix_then_chop filename] + is used to help we have dangling modules +*) +val ends_with_bs_suffix_then_chop : + string -> string option + + +(* Note we have to output uncapitalized file Name, + or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` + relevant issues: #1609, #913 + + #1933 when removing ns suffix, don't pass the bound + of basename +*) +val js_name_of_basename : + bool -> + string -> string + +type file_kind = + | Upper_js + | Upper_bs + | Little_js + | Little_bs + (** [js_name_of_modulename ~little A-Ns] + *) +val js_name_of_modulename : file_kind -> string -> string + +(* TODO handle cases like + '@angular/core' + its directory structure is like + {[ + @angular + |-------- core + ]} +*) +val is_valid_npm_package_name : string -> bool + +val namespace_of_package_name : string -> string + +end = struct +#1 "ext_namespace.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. *) + + +(* Note the build system should check the validity of filenames + espeically, it should not contain '-' +*) +let ns_sep_char = '-' +let ns_sep = "-" + +let make ~ns cunit = + cunit ^ ns_sep ^ ns + +let path_char = Filename.dir_sep.[0] + +let rec rindex_rec s i = + if i < 0 then i else + let char = String.unsafe_get s i in + if char = path_char then -1 + else if char = ns_sep_char then i + else + rindex_rec s (i - 1) + +let remove_ns_suffix name = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name + else String.sub name 0 i + +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else + Some (String.sub name (i+1) (len - i - 1), + String.sub name 0 i ) +type file_kind = + | Upper_js + | Upper_bs + | Little_js + | Little_bs + +let suffix_js = ".js" +let bs_suffix_js = ".bs.js" + +let ends_with_bs_suffix_then_chop s = + Ext_string.ends_with_then_chop s bs_suffix_js + +let js_name_of_basename bs_suffix s = + remove_ns_suffix s ^ + (if bs_suffix then bs_suffix_js else suffix_js ) + +let js_name_of_modulename little s = + match little with + | Little_js -> + remove_ns_suffix (Ext_string.uncapitalize_ascii s) ^ suffix_js + | Little_bs -> + remove_ns_suffix (Ext_string.uncapitalize_ascii s) ^ bs_suffix_js + | Upper_js -> + remove_ns_suffix s ^ suffix_js + | Upper_bs -> + remove_ns_suffix s ^ bs_suffix_js + +(* https://docs.npmjs.com/files/package.json + Some rules: + The name must be less than or equal to 214 characters. This includes the scope for scoped packages. + The name can't start with a dot or an underscore. + New packages must not have uppercase letters in the name. + The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. +*) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 && (* magic number forced by npm *) + len > 0 && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 + (fun x -> + match x with + | 'a'..'z' | '0'..'9' | '_' | '-' -> true + | _ -> false ) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Buffer.create len in + let add capital ch = + Buffer.add_char buf + (if capital then + (Ext_char.uppercase_ascii ch) + else ch) in + let rec aux capital off len = + if off >= len then () + else + let ch = String.unsafe_get s off in + match ch with + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + -> + add capital ch ; + aux false (off + 1) len + | '/' + | '-' -> + aux true (off + 1) len + | _ -> aux capital (off+1) len + in + aux true 0 len ; + Buffer.contents buf + +end +module Ounit_data_random += struct +#1 "ounit_data_random.ml" + + +let min_int x y = + if x < y then x else y + +let random_string chars upper = + let len = Array.length chars in + let string_len = (Random.int (min_int upper len)) in + String.init string_len (fun i -> chars.(Random.int len )) +end +module Ounit_string_tests += struct +#1 "ounit_string_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal + +let printer_string = fun x -> x + + +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 _ -> + let nl cur s = Ext_string.extract_until s cur '\n' in + nl (ref 0) "hello\n" =~ "hello"; + nl (ref 0) "\nhell" =~ ""; + nl (ref 0) "hello" =~ "hello"; + let cur = ref 0 in + let b = "a\nb\nc\nd" in + nl cur b =~ "a"; + nl cur b =~ "b"; + nl cur b =~ "c"; + nl cur b =~ "d"; + nl cur b =~ "" ; + nl cur b =~ "" ; + cur := 0 ; + let b = "a\nb\nc\nd\n" in + nl cur b =~ "a"; + nl cur b =~ "b"; + nl cur b =~ "c"; + nl cur b =~ "d"; + nl cur b =~ "" ; + nl cur b =~ "" ; + end ; + __LOC__ >:: begin fun _ -> + let b = "a\nb\nc\nd\n" in + let a = Ext_string.index_count in + a b 0 '\n' 1 =~ 1 ; + a b 0 '\n' 2 =~ 3; + a b 0 '\n' 3 =~ 5; + a b 0 '\n' 4 =~ 7; + a b 0 '\n' 5 =~ -1; + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (not (Ext_string.for_all_from "xABc"1 + (function 'A' .. 'Z' -> true | _ -> false))); + OUnit.assert_bool __LOC__ + ( (Ext_string.for_all_from "xABC" 1 + (function 'A' .. 'Z' -> true | _ -> false))); + OUnit.assert_bool __LOC__ + ( (Ext_string.for_all_from "xABC" 1_000 + (function 'A' .. 'Z' -> true | _ -> false))); + end; + + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ @@ + List.for_all (fun x -> Ext_string.is_valid_source_name x = Good) + ["x.ml"; "x.mli"; "x.re"; "x.rei"; + "A_x.ml"; "ab.ml"; "a_.ml"; "a__.ml"; + "ax.ml"]; + OUnit.assert_bool __LOC__ @@ not @@ + List.exists (fun x -> Ext_string.is_valid_source_name x = Good) + [".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~"; + "...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei"; + ".#hello.ml"; ".#hello.rei"; "a-.ml"; "a-b.ml"; "-a-.ml" + ; "-.ml" + ] + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ @@ + List.for_all Ext_namespace.is_valid_npm_package_name + ["x"; "@angualr"; "test"; "hi-x"; "hi-"] + ; + OUnit.assert_bool __LOC__ @@ + List.for_all + (fun x -> not (Ext_namespace.is_valid_npm_package_name x)) + ["x "; "x'"; "Test"; "hI"] + ; + end; + __LOC__ >:: begin fun _ -> + Ext_string.find ~sub:"hello" "xx hello xx" =~ 3 ; + Ext_string.rfind ~sub:"hello" "xx hello xx" =~ 3 ; + Ext_string.find ~sub:"hello" "xx hello hello xx" =~ 3 ; + Ext_string.rfind ~sub:"hello" "xx hello hello xx" =~ 9 ; + end; + __LOC__ >:: begin fun _ -> + Ext_string.non_overlap_count ~sub:"0" "1000,000" =~ 6; + Ext_string.non_overlap_count ~sub:"0" "000000" =~ 6; + Ext_string.non_overlap_count ~sub:"00" "000000" =~ 3; + Ext_string.non_overlap_count ~sub:"00" "00000" =~ 2 + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "abc"); + OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "a"); + OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "b"); + OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "c"); + OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" ""); + OUnit.assert_bool __LOC__ (not @@ Ext_string.contain_substring "abc" "abcc"); + end; + __LOC__ >:: begin fun _ -> + Ext_string.trim " \t\n" =~ ""; + Ext_string.trim " \t\nb" =~ "b"; + Ext_string.trim "b \t\n" =~ "b"; + Ext_string.trim "\t\n b \t\n" =~ "b"; + end; + __LOC__ >:: begin fun _ -> + Ext_string.starts_with "ab" "a" =~ true; + Ext_string.starts_with "ab" "" =~ true; + Ext_string.starts_with "abb" "abb" =~ true; + Ext_string.starts_with "abb" "abbc" =~ false; + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> string_of_bool x ) in + let k = Ext_string.ends_with in + k "xx.ml" ".ml" =~ true; + k "xx.bs.js" ".js" =~ true ; + k "xx" ".x" =~false; + k "xx" "" =~true + end; + __LOC__ >:: begin fun _ -> + Ext_string.ends_with_then_chop "xx.ml" ".ml" =~ Some "xx"; + Ext_string.ends_with_then_chop "xx.ml" ".mll" =~ None + end; + (* __LOC__ >:: begin fun _ -> + Ext_string.starts_with_and_number "js_fn_mk_01" ~offset:0 "js_fn_mk_" =~ 1 ; + Ext_string.starts_with_and_number "js_fn_run_02" ~offset:0 "js_fn_mk_" =~ -1 ; + Ext_string.starts_with_and_number "js_fn_mk_03" ~offset:6 "mk_" =~ 3 ; + Ext_string.starts_with_and_number "js_fn_mk_04" ~offset:6 "run_" =~ -1; + Ext_string.starts_with_and_number "js_fn_run_04" ~offset:6 "run_" =~ 4; + Ext_string.(starts_with_and_number "js_fn_run_04" ~offset:6 "run_" = 3) =~ false + end; *) + __LOC__ >:: begin fun _ -> + Ext_string.for_all "____" (function '_' -> true | _ -> false) + =~ true; + Ext_string.for_all "___-" (function '_' -> true | _ -> false) + =~ false; + Ext_string.for_all "" (function '_' -> true | _ -> false) + =~ true + end; + __LOC__ >:: begin fun _ -> + Ext_string.tail_from "ghsogh" 1 =~ "hsogh"; + Ext_string.tail_from "ghsogh" 0 =~ "ghsogh" + end; + (* __LOC__ >:: begin fun _ -> + Ext_string.digits_of_str "11_js" ~offset:0 2 =~ 11 + end; *) + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d" = + "a:/b/d" + ) ; + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d\\" = + "a:/b/d/" + ) ; + OUnit.assert_bool __LOC__ + (Ext_string.replace_slash_backward "a:/b/d/"= + "a:\\b\\d\\" + ) ; + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == + old + ) ; + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == + old + ) ; + + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.no_slash "ahgoh" ); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash "" ); + OUnit.assert_bool __LOC__ + (not (Ext_string.no_slash "ahgoh/" )); + OUnit.assert_bool __LOC__ + (not (Ext_string.no_slash "/ahgoh" )); + OUnit.assert_bool __LOC__ + (not (Ext_string.no_slash "/ahgoh/" )); + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.compare "" "" = 0); + OUnit.assert_bool __LOC__ (Ext_string.compare "0" "0" = 0); + OUnit.assert_bool __LOC__ (Ext_string.compare "" "acd" < 0); + OUnit.assert_bool __LOC__ (Ext_string.compare "acd" "" > 0); + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') in + OUnit.assert_bool __LOC__ (Ext_string.compare b a = 0); + OUnit.assert_bool __LOC__ (Ext_string.compare a b = 0) + done ; + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') ^ "\000"in + OUnit.assert_bool __LOC__ (Ext_string.compare a b < 0); + OUnit.assert_bool __LOC__ (Ext_string.compare b a > 0) + done ; + + end; + __LOC__ >:: begin fun _ -> + let slow_compare x y = + let x_len = String.length x in + let y_len = String.length y in + if x_len = y_len then + String.compare x y + else + Pervasives.compare x_len y_len in + let same_sign x y = + if x = 0 then y = 0 + else if x < 0 then y < 0 + else y > 0 in + for i = 0 to 3000 do + let chars = [|'a';'b';'c';'d'|] in + let x = Ounit_data_random.random_string chars 129 in + let y = Ounit_data_random.random_string chars 129 in + let a = Ext_string.compare x y in + let b = slow_compare x y in + if same_sign a b then OUnit.assert_bool __LOC__ true + else failwith ("incosistent " ^ x ^ " " ^ y ^ " " ^ string_of_int a ^ " " ^ string_of_int b) + done + end ; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat3 "a0" "a1" "a2") "a0a1a2" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat3 "a0" "a11" "") "a0a11" + ); + + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat4 "a0" "a1" "a2" "a3") "a0a1a2a3" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat4 "a0" "a11" "" "a33") "a0a11a33" + ); + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.inter2 "a0" "a1") "a0 a1" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.inter3 "a0" "a1" "a2") "a0 a1 a2" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.inter4 "a0" "a1" "a2" "a3") "a0 a1 a2 a3" + ); + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx "" < 0); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx "xxx" < 0); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx "xxx/" = 3); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx "xxx/g/" = 3); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx "/xxx/g/" = 0) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx" 0 < 0); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx/" 1 = 3); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx/g/" 4 = 5); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx/g/" 3 = 3); + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "/xxx/g/" 0 = 0) + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [||]) + Ext_string.empty + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"a0"|]) + "a0" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"|]) + "a0 a1" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2"|]) + "a0 a1 a2" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3"|]) + "a0 a1 a2 a3" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3";""; "a4"|]) + "a0 a1 a2 a3 a4" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"a3";""; "a4"|]) + "0 a1 2 a3 a4" + ); + OUnit.assert_bool __LOC__ + (Ext_string.equal + (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"3";"d"; ""; "e"|]) + "0 a1 2 3 d e" + ); + + end; + + __LOC__ >:: begin fun _ -> + Ext_namespace.namespace_of_package_name "bs-json" + =~ "BsJson" + end; + __LOC__ >:: begin fun _ -> + Ext_namespace.namespace_of_package_name "xx" + =~ "Xx" + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in + Ext_namespace.namespace_of_package_name + "reason-react" + =~ "ReasonReact"; + Ext_namespace.namespace_of_package_name + "reason" + =~ "Reason"; + Ext_namespace.namespace_of_package_name + "@aa/bb" + =~"AaBb"; + Ext_namespace.namespace_of_package_name + "@A/bb" + =~"ABb" + end; + __LOC__ >:: begin fun _ -> + Ext_namespace.js_name_of_basename false "a-b" + =~ "a.js"; + Ext_namespace.js_name_of_basename false "a-" + =~ "a.js"; + Ext_namespace.js_name_of_basename false "a--" + =~ "a-.js"; + Ext_namespace.js_name_of_basename false "AA-b" + =~ "AA.js"; + Ext_namespace.js_name_of_modulename + Little_js "AA-b" + =~ "aA.js"; + Ext_namespace.js_name_of_modulename + Upper_js "AA-b" + =~ "AA.js"; + Ext_namespace.js_name_of_modulename + Upper_bs "AA-b" + =~ "AA.bs.js"; + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> + match x with + | None -> "" + | Some (a,b) -> a ^","^ b + ) in + Ext_namespace.try_split_module_name "Js-X" =~ Some ("X","Js"); + Ext_namespace.try_split_module_name "Js_X" =~ None + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in + let f = Ext_string.capitalize_ascii in + f "x" =~ "X"; + f "X" =~ "X"; + f "" =~ ""; + f "abc" =~ "Abc"; + f "_bc" =~ "_bc"; + let v = "bc" in + f v =~ "Bc"; + v =~ "bc" + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:printer_string in + Ext_path.chop_all_extensions_if_any "a.bs.js" =~ "a" ; + Ext_path.chop_all_extensions_if_any "a.js" =~ "a"; + Ext_path.chop_all_extensions_if_any "a" =~ "a"; + Ext_path.chop_all_extensions_if_any "a.x.bs.js" =~ "a" + end; + let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in + __LOC__ >:: begin fun _ -> + let k = Ext_modulename.js_id_name_of_hint_name in + k "xx" =~ "Xx"; + k "react-dom" =~ "ReactDom"; + k "a/b/react-dom" =~ "ReactDom"; + k "a/b" =~ "B"; + k "a/" =~ "A/" ; (*TODO: warning?*) + k "#moduleid" =~ "Moduleid"; + k "@bundle" =~ "Bundle"; + k "xx#bc" =~ "Xxbc"; + k "hi@myproj" =~ "Himyproj"; + k "ab/c/xx.b.js" =~ "XxBJs"; (* improve it in the future*) + k "c/d/a--b"=~ "AB"; + k "c/d/ac--" =~ "Ac" + end + ] + +end +module Ext_topsort : sig +#1 "ext_topsort.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. *) + + +type edges = { id : int ; deps : Int_vec.t } + +module Edge_vec : Vec_gen.S with type elt = edges + +type t = Edge_vec.t + +(** the input will be modified , +*) +val layered_dfs : t -> Set_int.t Queue.t +end = struct +#1 "ext_topsort.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. *) + +type edges = { id : int ; deps : Int_vec.t } + +module Edge_vec = Resize_array.Make( struct + type t = edges + let null = { id = 0 ; deps = Int_vec.empty ()} + end + ) + +type t = Edge_vec.t + + +(** + This graph is different the graph used in [scc] graph, since + we need dynamic shrink the graph, so for each vector the first node is it self , + it will also change the input. + + TODO: error handling (cycle handling) and defensive bad input (missing edges etc) +*) + +let layered_dfs (g : t) = + let queue = Queue.create () in + let rec aux g = + let new_entries = + Edge_vec.inplace_filter_with + (fun (x : edges) -> not (Int_vec.is_empty x.deps) ) + ~cb_no:(fun x acc -> Set_int.add acc x.id) Set_int.empty g in + if not (Set_int.is_empty new_entries) + then + begin + Queue.push new_entries queue ; + Edge_vec.iter g (fun edges -> Int_vec.inplace_filter + (fun x -> not (Set_int.mem new_entries x)) edges.deps ) ; + aux g + end + in aux g ; queue + + +end +module Ounit_topsort_tests += struct +#1 "ounit_topsort_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let handle graph = + let len = List.length graph in + let result = Ext_topsort.Edge_vec.make len in + List.iter (fun (id,deps) -> + Ext_topsort.Edge_vec.push result {id ; deps = Int_vec.of_list deps } + ) graph; + result + + +let graph1 = + [ + 0, [1;2]; + 1, [2;3]; + 2, [4]; + 3, []; + 4, [] + ], [[0]; [1]; [2] ; [3;4]] + + +let graph2 = + [ + 0, [1;2]; + 1, [2;3]; + 2, [4]; + 3, [5]; + 4, [5]; + 5, [] + ], + [[0]; [1]; [2] ; [3;4]; [5]] + +let graph3 = + [ 0,[1;2;3;4;5]; + 1, [6;7;8] ; + 2, [6;7;8]; + 3, [6;7;8]; + 4, [6;7;8]; + 5, [6;7;8]; + 6, []; + 7, [] ; + 8, [] + ], + [[0]; [1;2;3;4;5]; [6; 7; 8]] + + +let expect loc (graph1, v) = + let graph = handle graph1 in + let queue = Ext_topsort.layered_dfs graph in + OUnit.assert_bool loc + (Queue.fold (fun acc x -> Set_int.elements x::acc) [] queue = + v) + + + + + +let (=~) = OUnit.assert_equal +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + expect __LOC__ graph1; + expect __LOC__ graph2 ; + expect __LOC__ graph3 + end + + ] +end +module Ast_utf8_string : sig +#1 "ast_utf8_string.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. *) + + +type error + + +type exn += Error of int (* offset *) * error + +val pp_error : Format.formatter -> error -> unit + + + +(* module Interp : sig *) +(* val check_and_transform : int -> string -> int -> cxt -> unit *) +(* val transform_test : string -> segments *) +(* end *) +val transform_test : string -> string + +val transform : Location.t -> string -> string + + +end = struct +#1 "ast_utf8_string.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. *) + + + +type error = + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + +let pp_error fmt err = + Format.pp_print_string fmt @@ match err with + | Invalid_code_point -> "Invalid code point" + | Unterminated_backslash -> "\\ ended unexpectedly" + | Invalid_escape_code c -> "Invalid escape code: " ^ String.make 1 c + | Invalid_hex_escape -> + "Invalid \\x escape" + | Invalid_unicode_escape -> "Invalid \\u escape" + + + +type exn += Error of int (* offset *) * error + + + + +let error ~loc error = + raise (Error (loc, error)) + +(** Note the [loc] really should be the utf8-offset, it has nothing to do with our + escaping mechanism +*) +(* we can not just print new line in ES5 + seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since + ocaml multiple-line allows [\n] + visual input while es5 string + does not*) + +let rec check_and_transform (loc : int ) buf s byte_offset s_len = + if byte_offset = s_len then () + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single 92 (* '\\' *) -> + escape_code (loc + 1) buf s (byte_offset+1) s_len + | Single 34 -> + Buffer.add_string buf "\\\""; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 39 -> + Buffer.add_string buf "\\'"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 10 -> + Buffer.add_string buf "\\n"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 13 -> + Buffer.add_string buf "\\r"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single _ -> + Buffer.add_char buf current_char; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + + | Invalid + | Cont _ -> error ~loc Invalid_code_point + | Leading (n,_) -> + let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + error ~loc Invalid_code_point + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform (loc + 1 ) buf s (i' + 1) s_len + end +(* we share the same escape sequence with js *) +and escape_code loc buf s offset s_len = + if offset >= s_len then + error ~loc Unterminated_backslash + else + Buffer.add_char buf '\\'; + let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + begin + Buffer.add_char buf cur_char ; + check_and_transform (loc + 1) buf s (offset + 1) s_len + end + | 'u' -> + begin + Buffer.add_char buf cur_char; + unicode (loc + 1) buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex (loc + 1) buf s (offset + 1) s_len + end + | _ -> error ~loc (Invalid_escape_code cur_char) +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then + error ~loc Invalid_hex_escape; + (*Location.raise_errorf ~loc "\\x need at least two chars";*) + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform (loc + 2) buf s (offset + 2) s_len + end + else + error ~loc Invalid_hex_escape +(*Location.raise_errorf ~loc "%c%c is not a valid hex code" a b*) + +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then + error ~loc Invalid_unicode_escape + (*Location.raise_errorf ~loc "\\u need at least four chars"*) + ; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform (loc + 4) buf s (offset + 4) s_len + end + else + error ~loc Invalid_unicode_escape +(*Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" + a0 a1 a2 a3 *) +(* http://www.2ality.com/2015/01/es6-strings.html + console.log('\uD83D\uDE80'); (* ES6*) + console.log('\u{1F680}'); +*) + + + + + + + + + +let transform_test s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform 0 buf s 0 s_len; + Buffer.contents buf + +let transform loc s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + try + check_and_transform 0 buf s 0 s_len; + Buffer.contents buf + with + Error (offset, error) + -> Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error + + + +end +module Ast_compatible : sig +#1 "ast_compatible.mli" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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. *) + + +type poly_var_label = Asttypes.label Asttypes.loc +type arg_label = Asttypes.arg_label +type label = arg_label +external convert: arg_label -> label = "%identity" + + + + +val no_label: arg_label + +type loc = Location.t +type attrs = Parsetree.attribute list +open Parsetree + + +val const_exp_string: + ?loc:Location.t -> + ?attrs:attrs -> + ?delimiter:string -> + string -> + expression + +val const_exp_int: + ?loc:Location.t -> + ?attrs:attrs -> + int -> + expression + +val const_exp_int_list_as_array: + int list -> + expression + +val const_exp_string_list_as_array: + string list -> + expression + + +val apply_simple: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression list -> + expression + +val app1: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression + +val app2: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression -> + expression + +val app3: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression -> + expression -> + expression + +(** Note this function would slightly + change its semantics depending on compiler versions + for newer version: it means always label + for older version: it could be optional (which we should avoid) +*) +val apply_labels: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + (string * expression) list -> + (* [(label,e)] [label] is strictly interpreted as label *) + expression + +val fun_ : + ?loc:Location.t -> + ?attrs:attrs -> + pattern -> + expression -> + expression + +val is_arg_label_simple : + arg_label -> bool + +val arrow : + ?loc:Location.t -> + ?attrs:attrs -> + core_type -> + core_type -> + core_type + +val label_arrow : + ?loc:Location.t -> + ?attrs:attrs -> + string -> + core_type -> + core_type -> + core_type + +val opt_arrow: + ?loc:Location.t -> + ?attrs:attrs -> + string -> + core_type -> + core_type -> + core_type + +val object_: + ?loc:loc -> + ?attrs:attrs -> + (string * attributes * core_type) list -> + (*FIXME shall we use [string loc] instead?*) + Asttypes.closed_flag -> + core_type + +val rec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val nonrec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val rec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val nonrec_type_sig: + ?loc:loc -> + type_declaration list -> + signature_item + +val rec_type_sig: + ?loc:loc -> + type_declaration list -> + signature_item + +val mk_fn_type: + (arg_label * core_type * attributes * loc) list -> + core_type -> + core_type + +type object_field = + + Parsetree.object_field +val object_field : Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field + + +val hash_label : poly_var_label -> int +val label_of_name : poly_var_label -> string + +type args = + (arg_label * Parsetree.expression) list + +end = struct +#1 "ast_compatible.ml" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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. *) + +type loc = Location.t +type attrs = Parsetree.attribute list +open Parsetree +let default_loc = Location.none + + +type poly_var_label = Asttypes.label Asttypes.loc + +type arg_label = Asttypes.arg_label = + | Nolabel + | Labelled of string + | Optional of string +let no_label : arg_label = Nolabel +let is_arg_label_simple (s : arg_label) = s = (Nolabel : arg_label) +type label = arg_label +external convert : arg_label -> label = "%identity" + + +let arrow ?(loc=default_loc) ?(attrs = []) a b = + Ast_helper.Typ.arrow ~loc ~attrs no_label a b + +let apply_simple + ?(loc = default_loc) + ?(attrs = []) + fn args : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + (Ext_list.map args (fun x -> no_label, x) ) ) } + +let app1 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [no_label, arg1] + ) } + +let app2 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 arg2 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [ + no_label, arg1; + no_label, arg2 ] + ) } + +let app3 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 arg2 arg3 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [ + no_label, arg1; + no_label, arg2; + no_label, arg3 + ] + ) } + +let fun_ + ?(loc = default_loc) + ?(attrs = []) + pat + exp = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_fun(no_label,None, pat, exp) + } + + + + +let const_exp_string + ?(loc = default_loc) + ?(attrs = []) + ?delimiter + (s : string) : expression = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_constant(Pconst_string(s,delimiter)) + } + + +let const_exp_int + ?(loc = default_loc) + ?(attrs = []) + (s : int) : expression = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_constant(Pconst_integer (string_of_int s, None)) + } + + +let apply_labels + ?(loc = default_loc) + ?(attrs = []) + fn (args : (string * expression) list) : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + Ext_list.map args (fun (l,a) -> Asttypes.Labelled l, a) ) } + +let object_ + ?(loc= default_loc) + ?(attrs = []) + (fields : (string * attributes * core_type) list) + (* FIXME after upgrade *) + flg : core_type = + { + ptyp_desc = + Ptyp_object( + Ext_list.map fields (fun (a,b,c) -> + Parsetree.Otag ({txt = a; loc = c.ptyp_loc},b,c)),flg); + ptyp_loc = loc; + ptyp_attributes = attrs + } + + + +let label_arrow ?(loc=default_loc) ?(attrs=[]) s a b : core_type = + { + ptyp_desc = Ptyp_arrow( + + Asttypes.Labelled s + + , + a, + b); + ptyp_loc = loc; + ptyp_attributes = attrs + } + +let opt_arrow ?(loc=default_loc) ?(attrs=[]) s a b : core_type = + { + ptyp_desc = Ptyp_arrow( + + Asttypes.Optional s + + , + a, + b); + ptyp_loc = loc; + ptyp_attributes = attrs + } + +let rec_type_str ?(loc=default_loc) tds : structure_item = + { + pstr_loc = loc; + pstr_desc = Pstr_type ( + + Recursive, + + tds) + } + +let nonrec_type_str ?(loc=default_loc) tds : structure_item = + { + pstr_loc = loc; + pstr_desc = Pstr_type ( + + Nonrecursive, + + tds) + } + +let rec_type_sig ?(loc=default_loc) tds : signature_item = + { + psig_loc = loc; + psig_desc = Psig_type ( + + Recursive, + + tds) + } + +(* FIXME: need address migration of `[@nonrec]` attributes in older ocaml *) +let nonrec_type_sig ?(loc=default_loc) tds : signature_item = + { + psig_loc = loc; + psig_desc = Psig_type ( + + Nonrecursive, + + tds) + } + + +let const_exp_int_list_as_array xs = + Ast_helper.Exp.array + (Ext_list.map xs (fun x -> const_exp_int x )) + +let const_exp_string_list_as_array xs = + Ast_helper.Exp.array + (Ext_list.map xs (fun x -> const_exp_string x ) ) + + + let mk_fn_type + (new_arg_types_ty : (arg_label * core_type * attributes * loc) list) + (result : core_type) : core_type = + Ext_list.fold_right new_arg_types_ty result (fun (label, ty, attrs, loc) acc -> + { + ptyp_desc = Ptyp_arrow(label,ty,acc); + ptyp_loc = loc; + ptyp_attributes = attrs + } + ) + +type object_field = + + Parsetree.object_field + + +let object_field l attrs ty = + + Parsetree.Otag + (l,attrs,ty) + + + +let hash_label (x : poly_var_label) : int = Ext_pervasives.hash_variant x.txt +let label_of_name (x : poly_var_label) : string = x.txt + + +type args = + (arg_label * Parsetree.expression) list + +end +module Bs_loc : sig +#1 "bs_loc.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. *) + +type t = Location.t = { + loc_start : Lexing.position; + loc_end : Lexing.position ; + loc_ghost : bool +} + +val is_ghost : t -> bool +val merge : t -> t -> t +val none : t + + +end = struct +#1 "bs_loc.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. *) + + +type t = Location.t = { + loc_start : Lexing.position; + loc_end : Lexing.position ; + loc_ghost : bool +} + +let is_ghost x = x.loc_ghost + +let merge (l: t) (r : t) = + if is_ghost l then r + else if is_ghost r then l + else match l,r with + | {loc_start ; }, {loc_end; _} (* TODO: improve*) + -> + {loc_start ;loc_end; loc_ghost = false} + +let none = Location.none + +end +module Ast_utf8_string_interp : sig +#1 "ast_utf8_string_interp.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. *) + + + + type kind = + | String + | Var of int * int (* int records its border length *) + +type error = private + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + | Unterminated_variable + | Unmatched_paren + | Invalid_syntax_of_var of string + +(** Note the position is about code point *) +type pos = { lnum : int ; offset : int ; byte_bol : int } + +type segment = { + start : pos; + finish : pos ; + kind : kind; + content : string ; +} + +type segments = segment list + +type cxt = { + mutable segment_start : pos ; + buf : Buffer.t ; + s_len : int ; + mutable segments : segments; + mutable pos_bol : int; (* record the abs position of current beginning line *) + mutable byte_bol : int ; + mutable pos_lnum : int ; (* record the line number *) +} + +type exn += Error of pos * pos * error + +val empty_segment : segment -> bool + +val transform_test : string -> segment list + + + +val transform : + Parsetree.expression -> + string -> + string -> + Parsetree.expression + +val is_unicode_string : + string -> + bool + +val is_unescaped : + string -> + bool +end = struct +#1 "ast_utf8_string_interp.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. *) + +type error = + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + | Unterminated_variable + | Unmatched_paren + | Invalid_syntax_of_var of string + +type kind = + | String + | Var of int * int +(* [Var (loffset, roffset)] + For parens it used to be (2,-1) + for non-parens it used to be (1,0) +*) + +(** Note the position is about code point *) +type pos = { + lnum : int ; + offset : int ; + byte_bol : int (* Note it actually needs to be in sync with OCaml's lexing semantics *) +} + + +type segment = { + start : pos; + finish : pos ; + kind : kind; + content : string ; +} + +type segments = segment list + + +type cxt = { + mutable segment_start : pos ; + buf : Buffer.t ; + s_len : int ; + mutable segments : segments; + mutable pos_bol : int; (* record the abs position of current beginning line *) + mutable byte_bol : int ; + mutable pos_lnum : int ; (* record the line number *) +} + + +type exn += Error of pos * pos * error + +let pp_error fmt err = + Format.pp_print_string fmt @@ match err with + | Invalid_code_point -> "Invalid code point" + | Unterminated_backslash -> "\\ ended unexpectedly" + | Invalid_escape_code c -> "Invalid escape code: " ^ String.make 1 c + | Invalid_hex_escape -> + "Invalid \\x escape" + | Invalid_unicode_escape -> "Invalid \\u escape" + | Unterminated_variable -> "$ unterminated" + | Unmatched_paren -> "Unmatched paren" + | Invalid_syntax_of_var s -> "`" ^s ^ "' is not a valid syntax of interpolated identifer" +let valid_lead_identifier_char x = + match x with + | 'a'..'z' | '_' -> true + | _ -> false + +let valid_identifier_char x = + match x with + | 'a'..'z' + | 'A'..'Z' + | '0'..'9' + | '_' | '\''-> true + | _ -> false +(** Invariant: [valid_lead_identifier] has to be [valid_identifier] *) + +let valid_identifier s = + let s_len = String.length s in + if s_len = 0 then false + else + valid_lead_identifier_char s.[0] && + Ext_string.for_all_from s 1 valid_identifier_char + + +let is_space x = + match x with + | ' ' | '\n' | '\t' -> true + | _ -> false + + + +(** + FIXME: multiple line offset + if there is no line offset. Note {|{j||} border will never trigger a new line +*) +let update_position border + ({lnum ; offset;byte_bol } : pos) + (pos : Lexing.position)= + if lnum = 0 then + {pos with pos_cnum = pos.pos_cnum + border + offset } + (** When no newline, the column number is [border + offset] *) + else + { + pos with + pos_lnum = pos.pos_lnum + lnum ; + pos_bol = pos.pos_cnum + border + byte_bol; + pos_cnum = pos.pos_cnum + border + byte_bol + offset; + (** when newline, the column number is [offset] *) + } +let update border + (start : pos) + (finish : pos) (loc : Location.t) : Location.t = + let start_pos = loc.loc_start in + { loc with + loc_start = + update_position border start start_pos; + loc_end = + update_position border finish start_pos + } + + +(** Note [Var] kind can not be mpty *) +let empty_segment {content } = + Ext_string.is_empty content + + + +let update_newline ~byte_bol loc cxt = + cxt.pos_lnum <- cxt.pos_lnum + 1 ; + cxt.pos_bol <- loc; + cxt.byte_bol <- byte_bol + +let pos_error cxt ~loc error = + raise (Error + (cxt.segment_start, + { lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; byte_bol = cxt.byte_bol}, error)) + +let add_var_segment cxt loc loffset roffset = + let content = Buffer.contents cxt.buf in + Buffer.clear cxt.buf ; + let next_loc = { + lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; + byte_bol = cxt.byte_bol } in + if valid_identifier content then + begin + cxt.segments <- + { start = cxt.segment_start; + finish = next_loc ; + kind = Var (loffset, roffset); + content} :: cxt.segments ; + cxt.segment_start <- next_loc + end + else pos_error cxt ~loc (Invalid_syntax_of_var content) + +let add_str_segment cxt loc = + let content = Buffer.contents cxt.buf in + Buffer.clear cxt.buf ; + let next_loc = { + lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; + byte_bol = cxt.byte_bol } in + cxt.segments <- + { start = cxt.segment_start; + finish = next_loc ; + kind = String; + content} :: cxt.segments ; + cxt.segment_start <- next_loc + + + + + +let rec check_and_transform (loc : int ) s byte_offset ({s_len; buf} as cxt : cxt) = + if byte_offset = s_len then + add_str_segment cxt loc + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single 92 (* '\\' *) -> + escape_code (loc + 1) s (byte_offset+1) cxt + | Single 34 -> + Buffer.add_string buf "\\\""; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 39 -> + Buffer.add_string buf "\\'"; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 10 -> + + Buffer.add_string buf "\\n"; + let loc = loc + 1 in + let byte_offset = byte_offset + 1 in + update_newline ~byte_bol:byte_offset loc cxt ; (* Note variable could not have new-line *) + check_and_transform loc s byte_offset cxt + | Single 13 -> + Buffer.add_string buf "\\r"; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 36 -> (* $ *) + add_str_segment cxt loc ; + let offset = byte_offset + 1 in + if offset >= s_len then + pos_error ~loc cxt Unterminated_variable + else + let cur_char = s.[offset] in + if cur_char = '(' then + expect_var_paren (loc + 2) s (offset + 1) cxt + else + expect_simple_var (loc + 1) s offset cxt + | Single _ -> + Buffer.add_char buf current_char; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + + | Invalid + | Cont _ -> pos_error ~loc cxt Invalid_code_point + | Leading (n,_) -> + let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + pos_error cxt ~loc Invalid_code_point + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform (loc + 1 ) s (i' + 1) cxt + end +(**Lets keep identifier simple, so that we could generating a function easier in the future + for example + let f = [%fn{| $x + $y = $x_add_y |}] +*) +and expect_simple_var loc s offset ({buf; s_len} as cxt) = + let v = ref offset in + (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) + if not (offset < s_len && valid_lead_identifier_char s.[offset]) then + pos_error cxt ~loc (Invalid_syntax_of_var Ext_string.empty) + else + begin + while !v < s_len && valid_identifier_char s.[!v] do (* TODO*) + let cur_char = s.[!v] in + Buffer.add_char buf cur_char; + incr v ; + done; + let added_length = !v - offset in + let loc = added_length + loc in + add_var_segment cxt loc 1 0 ; + check_and_transform loc s (added_length + offset) cxt + end +and expect_var_paren loc s offset ({buf; s_len} as cxt) = + let v = ref offset in + (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) + while !v < s_len && s.[!v] <> ')' do + let cur_char = s.[!v] in + Buffer.add_char buf cur_char; + incr v ; + done; + let added_length = !v - offset in + let loc = added_length + 1 + loc in + if !v < s_len && s.[!v] = ')' then + begin + add_var_segment cxt loc 2 (-1) ; + check_and_transform loc s (added_length + 1 + offset) cxt + end + else + pos_error cxt ~loc Unmatched_paren + + + + + +(* we share the same escape sequence with js *) +and escape_code loc s offset ({ buf; s_len} as cxt) = + if offset >= s_len then + pos_error cxt ~loc Unterminated_backslash + else + Buffer.add_char buf '\\'; + let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + begin + Buffer.add_char buf cur_char ; + check_and_transform (loc + 1) s (offset + 1) cxt + end + | 'u' -> + begin + Buffer.add_char buf cur_char; + unicode (loc + 1) s (offset + 1) cxt + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex (loc + 1) s (offset + 1) cxt + end + | _ -> pos_error cxt ~loc (Invalid_escape_code cur_char) +and two_hex loc s offset ({buf ; s_len} as cxt) = + if offset + 1 >= s_len then + pos_error cxt ~loc Invalid_hex_escape; + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform (loc + 2) s (offset + 2) cxt + end + else + pos_error cxt ~loc Invalid_hex_escape + + +and unicode loc s offset ({buf ; s_len} as cxt) = + if offset + 3 >= s_len then + pos_error cxt ~loc Invalid_unicode_escape + ; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform (loc + 4) s (offset + 4) cxt + end + else + pos_error cxt ~loc Invalid_unicode_escape +let transform_test s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + let cxt = + { segment_start = {lnum = 0; offset = 0; byte_bol = 0}; + buf ; + s_len; + segments = []; + pos_lnum = 0; + byte_bol = 0; + pos_bol = 0; + + } in + check_and_transform 0 s 0 cxt; + List.rev cxt.segments + + +(** TODO: test empty var $() $ failure, + Allow identifers x.A.y *) + +open Ast_helper + +(** Longident.parse "Pervasives.^" *) +let concat_ident : Longident.t = + Ldot (Lident "Pervasives", "^") (* FIXME: remove deps on `Pervasives` *) + (* JS string concatMany *) + (* Ldot (Ldot (Lident "Js", "String2"), "concat") *) + +(* Longident.parse "Js.String.make" *) +let to_string_ident : Longident.t = + Ldot (Ldot (Lident "Js", "String2"), "make") + + +let escaped_j_delimiter = "*j" (* not user level syntax allowed *) +let unescaped_j_delimiter = "j" +let unescaped_js_delimiter = "js" + +let escaped = Some escaped_j_delimiter + +let concat_exp + (a : Parsetree.expression) + (b : Parsetree.expression) : Parsetree.expression = + let loc = Bs_loc.merge a.pexp_loc b.pexp_loc in + Ast_compatible.apply_simple ~loc + (Exp.ident { txt =concat_ident; loc}) + [a ; + b] + +let border = String.length "{j|" + +let aux loc (segment : segment) = + match segment with + | {start ; finish; kind ; content} + -> + begin match kind with + | String -> + let loc = update border start finish loc in + Ast_compatible.const_exp_string + content ?delimiter:escaped ~loc + | Var (soffset, foffset) -> + let loc = { + loc with + loc_start = update_position (soffset + border) start loc.loc_start ; + loc_end = update_position (foffset + border) finish loc.loc_start + } in + Ast_compatible.apply_simple ~loc + (Exp.ident ~loc {loc ; txt = to_string_ident }) + [ + Exp.ident ~loc {loc ; txt = Lident content} + ] + end + + +let transform_interp loc s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2 ) in + try + let cxt : cxt = + { segment_start = {lnum = 0; offset = 0; byte_bol = 0}; + buf ; + s_len; + segments = []; + pos_lnum = 0; + byte_bol = 0; + pos_bol = 0; + + } in + + check_and_transform 0 s 0 cxt; + let rev_segments = cxt.segments in + match rev_segments with + | [] -> + Ast_compatible.const_exp_string ~loc "" ?delimiter:escaped + | [ segment] -> + aux loc segment + | a::rest -> + Ext_list.fold_left rest (aux loc a) (fun acc x -> + concat_exp (aux loc x) acc ) + with + Error (start,pos, error) + -> + Location.raise_errorf ~loc:(update border start pos loc ) + "%a" pp_error error + + +let transform (e : Parsetree.expression) s delim : Parsetree.expression = + if Ext_string.equal delim unescaped_js_delimiter then + let js_str = Ast_utf8_string.transform e.pexp_loc s in + { e with pexp_desc = + Pexp_constant ( + + Pconst_string + + (js_str, escaped))} + else if Ext_string.equal delim unescaped_j_delimiter then + transform_interp e.pexp_loc s + else e + +let is_unicode_string opt = Ext_string.equal opt escaped_j_delimiter + +let is_unescaped s = + Ext_string.equal s unescaped_j_delimiter + || Ext_string.equal s unescaped_js_delimiter +end +module Ounit_unicode_tests += struct +#1 "ounit_unicode_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) a b = + OUnit.assert_equal ~cmp:Ext_string.equal a b + +(** Test for single line *) +let (==~) a b = + OUnit.assert_equal + ( + Ext_list.map (Ast_utf8_string_interp.transform_test a + |> List.filter (fun x -> not @@ Ast_utf8_string_interp.empty_segment x)) + (fun + ({start = {offset = a}; finish = {offset = b}; kind ; content } + : Ast_utf8_string_interp.segment) -> + a,b,kind,content + ) + ) + b + +let (==*) a b = + let segments = + Ext_list.map ( + Ast_utf8_string_interp.transform_test a + |> List.filter (fun x -> not @@ Ast_utf8_string_interp.empty_segment x) + )(fun + ({start = {lnum=la; offset = a}; finish = {lnum = lb; offset = b}; kind ; content } + : Ast_utf8_string_interp.segment) -> + la,a,lb,b,kind,content + ) + in + OUnit.assert_equal segments b + +let varParen : Ast_utf8_string_interp.kind = Var (2,-1) +let var : Ast_utf8_string_interp.kind = Var (1,0) +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Ast_utf8_string.transform_test {|x|} =~ {|x|} + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.transform_test "a\nb" =~ {|a\nb|} + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.transform_test + "\\n" =~ "\\n" + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.transform_test + "\\\\\\b\\t\\n\\v\\f\\r\\0\\$" =~ + "\\\\\\b\\t\\n\\v\\f\\r\\0\\$" + end; + + __LOC__ >:: begin fun _ -> + match Ast_utf8_string.transform_test + {|\|} with + | exception Ast_utf8_string.Error(offset,_) -> + OUnit.assert_equal offset 1 + | _ -> OUnit.assert_failure __LOC__ + end ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string.transform_test + {|你\|} with + | exception Ast_utf8_string.Error(offset,_) -> + OUnit.assert_equal offset 2 + | _ -> OUnit.assert_failure __LOC__ + end ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string.transform_test + {|你BuckleScript,好啊\uffff\|} with + | exception Ast_utf8_string.Error(offset,_) -> + OUnit.assert_equal offset 23 + | _ -> OUnit.assert_failure __LOC__ + end ; + + __LOC__ >:: begin fun _ -> + "hie $x hi 你好" ==~ + [ + 0,4, String, "hie "; + 4,6, var, "x"; + 6,12,String, " hi 你好" + ] + end; + __LOC__ >:: begin fun _ -> + "x" ==~ + [0,1, String, "x"] + end; + + __LOC__ >:: begin fun _ -> + "" ==~ + [] + end; + __LOC__ >:: begin fun _ -> + "你好" ==~ + [0,2,String, "你好"] + end; + __LOC__ >:: begin fun _ -> + "你好$x" ==~ + [0,2,String, "你好"; + 2,4,var, "x"; + + ] + end + ; + __LOC__ >:: begin fun _ -> + "你好$this" ==~ + [ + 0,2,String, "你好"; + 2,7,var, "this"; + ] + end + ; + __LOC__ >:: begin fun _ -> + "你好$(this)" ==~ + [ + 0,2,String, "你好"; + 2,9,varParen, "this" + ]; + + "你好$this)" ==~ + [ + 0,2,String, "你好"; + 2,7,var, "this"; + 7,8,String,")" + ]; + {|\xff\xff你好 $x |} ==~ + [ + 0,11,String, {|\xff\xff你好 |}; + 11,13, var, "x"; + 13,14, String, " " + ]; + {|\xff\xff你好 $x 不吃亏了buckle $y $z = $sum|} + ==~ + [(0, 11, String,{|\xff\xff你好 |} ); + (11, 13, var, "x"); + (13, 25, String,{| 不吃亏了buckle |} ); + (25, 27, var, "y"); + (27, 28, String, " "); + (28, 30, var, "z"); + (30, 33, String, " = "); + (33, 37, var, "sum"); + ] + end + ; + __LOC__ >:: begin fun _ -> + "你好 $(this_is_a_var) x" ==~ + [ + 0,3,String, "你好 "; + 3,19,varParen, "this_is_a_var"; + 19,22, String, " x" + ] + end + ; + + __LOC__ >:: begin fun _ -> + "hi\n$x\n" ==* + [ + 0,0,1,0,String, "hi\\n"; + 1,0,1,2,var, "x" ; + 1,2,2,0,String,"\\n" + ]; + "$x" ==* + [0,0,0,2,var,"x"]; + + + "\n$x\n" ==* + [ + 0,0,1,0,String,"\\n"; + 1,0,1,2,var,"x"; + 1,2,2,0,String,"\\n" + ] + end; + + __LOC__ >:: begin fun _ -> + "\n$(x_this_is_cool) " ==* + [ + 0,0,1,0,String, "\\n"; + 1,0,1,17,varParen, "x_this_is_cool"; + 1,17,1,18,String, " " + ] + end; + __LOC__ >:: begin fun _ -> + " $x + $y = $sum " ==* + [ + 0,0,0,1,String , " "; + 0,1,0,3,var, "x"; + 0,3,0,6,String, " + "; + 0,6,0,8,var, "y"; + 0,8,0,11,String, " = "; + 0,11,0,15,var, "sum"; + 0,15,0,16,String, " " + ] + end; + __LOC__ >:: begin fun _ -> + "中文 | $a " ==* + [ + 0,0,0,5,String, "中文 | "; + 0,5,0,7,var, "a"; + 0,7,0,8,String, " " + ] + end + ; + __LOC__ >:: begin fun _ -> + {|Hello \\$world|} ==* + [ + 0,0,0,8,String,"Hello \\\\"; + 0,8,0,14,var, "world" + ] + end + ; + __LOC__ >:: begin fun _ -> + {|$x)|} ==* + [ + 0,0,0,2,var,"x"; + 0,2,0,3,String,")" + ] + end; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {j| $( ()) |j} + with + |exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 1; byte_bol = 0}, + {lnum = 0; offset = 6; byte_bol = 0}, Invalid_syntax_of_var " (") + -> OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end + ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$()|} + with + | exception Ast_utf8_string_interp.Error ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 3; byte_bol = 0}, Invalid_syntax_of_var "") + -> OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end + ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$ ()|} + with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 1; byte_bol = 0}, Invalid_syntax_of_var "") + -> OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$()|} with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 3; byte_bol = 0}, Invalid_syntax_of_var "") + -> OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end + ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$(hello world)|} with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 14; byte_bol = 0}, Invalid_syntax_of_var "hello world") + -> OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end + + + ; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$( hi*) |} with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 7; byte_bol = 0}, Invalid_syntax_of_var " hi*") + -> + OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end; + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|xx $|} with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 3; byte_bol = 0}, + {lnum = 0; offset = 3; byte_bol = 0}, Unterminated_variable) + -> + OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end ; + + __LOC__ >:: begin fun _ -> + match Ast_utf8_string_interp.transform_test {|$(world |}; with + | exception Ast_utf8_string_interp.Error + ({lnum = 0; offset = 0; byte_bol = 0}, + {lnum = 0; offset = 9; byte_bol = 0}, Unmatched_paren) + -> + OUnit.assert_bool __LOC__ true + | _ -> OUnit.assert_bool __LOC__ false + end + ] + +end +module Union_find : sig +#1 "union_find.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. *) + + + type t + +val init : int -> t + + + +val find : t -> int -> int + +val union : t -> int -> int -> unit + +val count : t -> int + +end = struct +#1 "union_find.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. *) + +type t = { + id : int array; + sz : int array ; + mutable components : int +} + +let init n = + let id = Array.make n 0 in + for i = 0 to n - 1 do + Array.unsafe_set id i i + done ; + { + id ; + sz = Array.make n 1; + components = n + } + +let rec find_aux id_store p = + let parent = Array.unsafe_get id_store p in + if p <> parent then + find_aux id_store parent + else p + +let find store p = find_aux store.id p + +let union store p q = + let id_store = store.id in + let p_root = find_aux id_store p in + let q_root = find_aux id_store q in + if p_root <> q_root then + begin + let () = store.components <- store.components - 1 in + let sz_store = store.sz in + let sz_p_root = Array.unsafe_get sz_store p_root in + let sz_q_root = Array.unsafe_get sz_store q_root in + let bigger = sz_p_root + sz_q_root in + (* Smaller root point to larger to make + it more balanced + it will introduce a cost for small root find, + but major will not be impacted + *) + if sz_p_root < sz_q_root then + begin + Array.unsafe_set id_store p q_root; + Array.unsafe_set id_store p_root q_root; + Array.unsafe_set sz_store q_root bigger; + (* little optimization *) + end + else + begin + Array.unsafe_set id_store q p_root ; + Array.unsafe_set id_store q_root p_root; + Array.unsafe_set sz_store p_root bigger; + (* little optimization *) + end + end + +let count store = store.components + + +end +module Ounit_union_find_tests += struct +#1 "ounit_union_find_tests.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal +let tinyUF = {|10 + 4 3 + 3 8 + 6 5 + 9 4 + 2 1 + 8 9 + 5 0 + 7 2 + 6 1 + 1 0 + 6 7 + |} +let mediumUF = {|625 + 528 503 + 548 523 + 389 414 + 446 421 + 552 553 + 154 155 + 173 174 + 373 348 + 567 542 + 44 43 + 370 345 + 546 547 + 204 229 + 404 429 + 240 215 + 364 389 + 612 611 + 513 512 + 377 376 + 468 443 + 410 435 + 243 218 + 347 322 + 580 581 + 188 163 + 61 36 + 545 546 + 93 68 + 84 83 + 94 69 + 7 8 + 619 618 + 314 339 + 155 156 + 150 175 + 605 580 + 118 93 + 385 360 + 459 458 + 167 168 + 107 108 + 44 69 + 335 334 + 251 276 + 196 197 + 501 502 + 212 187 + 251 250 + 269 270 + 332 331 + 125 150 + 391 416 + 366 367 + 65 40 + 515 540 + 248 273 + 34 9 + 480 479 + 198 173 + 463 488 + 111 86 + 524 499 + 28 27 + 323 324 + 198 199 + 146 147 + 133 158 + 416 415 + 103 102 + 457 482 + 57 82 + 88 113 + 535 560 + 181 180 + 605 606 + 481 456 + 127 102 + 470 445 + 229 254 + 169 170 + 386 385 + 383 384 + 153 152 + 541 542 + 36 37 + 474 473 + 126 125 + 534 509 + 154 129 + 591 592 + 161 186 + 209 234 + 88 87 + 61 60 + 161 136 + 472 447 + 239 240 + 102 101 + 342 343 + 566 565 + 567 568 + 41 42 + 154 153 + 471 496 + 358 383 + 423 448 + 241 242 + 292 293 + 363 364 + 361 362 + 258 283 + 75 100 + 61 86 + 81 106 + 52 27 + 230 255 + 309 334 + 378 379 + 136 111 + 439 464 + 532 533 + 166 191 + 523 522 + 210 211 + 115 140 + 347 346 + 218 217 + 561 560 + 526 501 + 174 149 + 258 259 + 77 52 + 36 11 + 307 306 + 577 552 + 62 61 + 450 425 + 569 570 + 268 293 + 79 78 + 233 208 + 571 570 + 534 535 + 527 552 + 224 199 + 409 408 + 521 520 + 621 622 + 493 518 + 107 106 + 511 510 + 298 299 + 37 62 + 224 249 + 405 380 + 236 237 + 120 121 + 393 418 + 206 231 + 287 288 + 593 568 + 34 59 + 483 484 + 226 227 + 73 74 + 276 277 + 588 587 + 288 313 + 410 385 + 506 505 + 597 598 + 337 312 + 55 56 + 300 325 + 135 134 + 4 29 + 501 500 + 438 437 + 311 312 + 598 599 + 320 345 + 211 236 + 587 562 + 74 99 + 473 498 + 278 279 + 394 369 + 123 148 + 233 232 + 252 277 + 177 202 + 160 185 + 331 356 + 192 191 + 119 118 + 576 601 + 317 316 + 462 487 + 42 43 + 336 311 + 515 490 + 13 14 + 210 235 + 473 448 + 342 341 + 340 315 + 413 388 + 514 515 + 144 143 + 146 145 + 541 566 + 128 103 + 184 159 + 488 489 + 454 455 + 82 83 + 70 45 + 221 222 + 241 240 + 412 411 + 591 590 + 592 593 + 276 301 + 452 453 + 256 255 + 397 372 + 201 200 + 232 207 + 466 465 + 561 586 + 417 442 + 409 434 + 238 239 + 389 390 + 26 1 + 510 485 + 283 282 + 281 306 + 449 474 + 324 349 + 121 146 + 111 112 + 434 435 + 507 508 + 103 104 + 319 294 + 455 480 + 558 557 + 291 292 + 553 578 + 392 391 + 552 551 + 55 80 + 538 539 + 367 392 + 340 365 + 272 297 + 266 265 + 401 376 + 279 280 + 516 515 + 178 177 + 572 571 + 154 179 + 263 262 + 6 31 + 323 348 + 481 506 + 178 179 + 526 527 + 444 469 + 273 274 + 132 133 + 275 300 + 261 236 + 344 369 + 63 38 + 5 30 + 301 300 + 86 87 + 9 10 + 344 319 + 428 427 + 400 375 + 350 375 + 235 236 + 337 336 + 616 615 + 381 380 + 58 59 + 492 493 + 555 556 + 459 434 + 368 369 + 407 382 + 166 141 + 70 95 + 380 355 + 34 35 + 49 24 + 126 127 + 403 378 + 509 484 + 613 588 + 208 207 + 143 168 + 406 431 + 263 238 + 595 596 + 218 193 + 183 182 + 195 220 + 381 406 + 64 65 + 371 372 + 531 506 + 218 219 + 144 145 + 475 450 + 547 548 + 363 362 + 337 362 + 214 239 + 110 111 + 600 575 + 105 106 + 147 148 + 599 574 + 622 623 + 319 320 + 36 35 + 258 233 + 266 267 + 481 480 + 414 439 + 169 168 + 479 478 + 224 223 + 181 182 + 351 326 + 466 441 + 85 60 + 140 165 + 91 90 + 263 264 + 188 187 + 446 447 + 607 606 + 341 316 + 143 142 + 443 442 + 354 353 + 162 137 + 281 256 + 549 574 + 407 408 + 575 550 + 171 170 + 389 388 + 390 391 + 250 225 + 536 537 + 227 228 + 84 59 + 139 140 + 485 484 + 573 598 + 356 381 + 314 315 + 299 324 + 370 395 + 166 165 + 63 62 + 507 506 + 426 425 + 479 454 + 545 570 + 376 375 + 572 597 + 606 581 + 278 277 + 303 302 + 190 165 + 230 205 + 175 200 + 529 528 + 18 17 + 458 457 + 514 513 + 617 616 + 298 323 + 162 161 + 471 472 + 81 56 + 182 207 + 539 564 + 573 572 + 596 621 + 64 39 + 571 546 + 554 555 + 388 363 + 351 376 + 304 329 + 123 122 + 135 160 + 157 132 + 599 624 + 451 426 + 162 187 + 502 477 + 508 483 + 141 140 + 303 328 + 551 576 + 471 446 + 161 160 + 465 490 + 3 2 + 138 113 + 309 284 + 452 451 + 414 413 + 540 565 + 210 185 + 350 325 + 383 382 + 2 1 + 598 623 + 97 72 + 485 460 + 315 316 + 19 20 + 31 32 + 546 521 + 320 321 + 29 54 + 330 331 + 92 67 + 480 505 + 274 249 + 22 47 + 304 279 + 493 468 + 424 423 + 39 40 + 164 165 + 269 268 + 445 446 + 228 203 + 384 409 + 390 365 + 283 308 + 374 399 + 361 386 + 94 119 + 237 262 + 43 68 + 295 270 + 400 425 + 360 335 + 122 121 + 469 468 + 189 188 + 377 352 + 367 342 + 67 42 + 616 591 + 442 467 + 558 533 + 395 394 + 3 28 + 476 477 + 257 258 + 280 281 + 517 542 + 505 504 + 302 301 + 14 15 + 523 498 + 393 368 + 46 71 + 141 142 + 477 452 + 535 510 + 237 238 + 232 231 + 5 6 + 75 50 + 278 253 + 68 69 + 584 559 + 503 504 + 281 282 + 19 44 + 411 410 + 290 265 + 579 554 + 85 84 + 65 66 + 9 8 + 484 459 + 427 402 + 195 196 + 617 618 + 418 443 + 101 126 + 268 243 + 92 117 + 290 315 + 562 561 + 255 280 + 488 487 + 578 603 + 80 79 + 57 58 + 77 78 + 417 418 + 246 271 + 95 96 + 234 233 + 530 555 + 543 568 + 396 397 + 22 23 + 29 28 + 502 527 + 12 13 + 217 216 + 522 547 + 357 332 + 543 518 + 151 176 + 69 70 + 556 557 + 247 248 + 513 538 + 204 205 + 604 605 + 528 527 + 455 456 + 624 623 + 284 285 + 27 26 + 94 95 + 486 511 + 192 167 + 372 347 + 129 104 + 349 374 + 313 314 + 354 329 + 294 293 + 377 378 + 291 290 + 433 408 + 57 56 + 215 190 + 467 492 + 383 408 + 569 594 + 209 208 + 2 27 + 466 491 + 147 122 + 112 113 + 21 46 + 284 259 + 563 538 + 392 417 + 458 433 + 464 465 + 297 298 + 336 361 + 607 582 + 553 554 + 225 200 + 186 211 + 33 34 + 237 212 + 52 51 + 620 595 + 492 517 + 585 610 + 257 282 + 520 545 + 541 540 + 269 244 + 609 584 + 109 84 + 247 246 + 562 537 + 172 197 + 166 167 + 264 265 + 129 130 + 89 114 + 204 179 + 51 76 + 415 390 + 54 53 + 219 244 + 491 490 + 494 493 + 87 62 + 158 183 + 517 518 + 358 359 + 105 104 + 285 260 + 343 318 + 348 347 + 615 614 + 169 144 + 53 78 + 494 495 + 576 577 + 23 24 + 22 21 + 41 40 + 467 466 + 112 87 + 245 220 + 442 441 + 411 436 + 256 257 + 469 494 + 441 416 + 132 107 + 468 467 + 345 344 + 608 609 + 358 333 + 418 419 + 430 429 + 130 131 + 127 128 + 115 90 + 364 365 + 296 271 + 260 235 + 229 228 + 232 257 + 189 190 + 234 235 + 195 170 + 117 118 + 487 486 + 203 204 + 142 117 + 582 583 + 561 536 + 7 32 + 387 388 + 333 334 + 420 421 + 317 292 + 327 352 + 564 563 + 39 14 + 177 152 + 144 119 + 426 401 + 248 223 + 566 567 + 53 28 + 106 131 + 473 472 + 525 526 + 327 302 + 382 381 + 222 197 + 610 609 + 522 521 + 291 316 + 339 338 + 328 329 + 31 56 + 247 222 + 185 186 + 554 529 + 393 392 + 108 83 + 514 489 + 48 23 + 37 12 + 46 45 + 25 0 + 463 462 + 101 76 + 11 10 + 548 573 + 137 112 + 123 124 + 359 360 + 489 490 + 368 367 + 71 96 + 229 230 + 496 495 + 366 365 + 86 85 + 496 497 + 482 481 + 326 301 + 278 303 + 139 114 + 71 70 + 275 276 + 223 198 + 590 565 + 496 521 + 16 41 + 501 476 + 371 370 + 511 536 + 577 602 + 37 38 + 423 422 + 71 72 + 399 424 + 171 146 + 32 33 + 157 182 + 608 583 + 474 499 + 205 206 + 539 514 + 601 600 + 419 420 + 208 183 + 537 538 + 110 85 + 105 130 + 288 289 + 455 430 + 531 532 + 337 338 + 227 202 + 120 145 + 559 534 + 261 262 + 241 216 + 379 354 + 430 405 + 241 266 + 396 421 + 317 318 + 139 164 + 310 285 + 478 477 + 532 557 + 238 213 + 195 194 + 359 384 + 243 242 + 432 457 + 422 447 + 519 518 + 271 272 + 12 11 + 478 453 + 453 428 + 614 613 + 138 139 + 96 97 + 399 398 + 55 54 + 199 174 + 566 591 + 213 188 + 488 513 + 169 194 + 603 602 + 293 318 + 432 431 + 524 523 + 30 31 + 88 63 + 172 173 + 510 509 + 272 273 + 559 558 + 494 519 + 374 373 + 547 572 + 263 288 + 17 16 + 78 103 + 542 543 + 131 132 + 519 544 + 504 529 + 60 59 + 356 355 + 341 340 + 415 414 + 285 286 + 439 438 + 588 563 + 25 50 + 463 438 + 581 556 + 244 245 + 500 475 + 93 92 + 274 299 + 351 350 + 152 127 + 472 497 + 440 415 + 214 215 + 231 230 + 80 81 + 550 525 + 511 512 + 483 458 + 67 68 + 255 254 + 589 588 + 147 172 + 454 453 + 587 612 + 343 368 + 508 509 + 240 265 + 49 48 + 184 183 + 583 558 + 164 189 + 461 436 + 109 134 + 196 171 + 156 181 + 124 99 + 531 530 + 116 91 + 431 430 + 326 325 + 44 45 + 507 482 + 557 582 + 519 520 + 167 142 + 469 470 + 563 562 + 507 532 + 94 93 + 3 4 + 366 391 + 456 431 + 524 549 + 489 464 + 397 398 + 98 97 + 377 402 + 413 412 + 148 149 + 91 66 + 308 333 + 16 15 + 312 287 + 212 211 + 486 461 + 571 596 + 226 251 + 356 357 + 145 170 + 295 294 + 308 309 + 163 138 + 364 339 + 416 417 + 402 401 + 302 277 + 349 348 + 582 581 + 176 175 + 254 279 + 589 614 + 322 297 + 587 586 + 221 246 + 526 551 + 159 158 + 460 461 + 452 427 + 329 330 + 321 322 + 82 107 + 462 461 + 495 520 + 303 304 + 90 65 + 295 320 + 160 159 + 463 464 + 10 35 + 619 594 + 403 402 + |} + + +let process_str tinyUF = + match Ext_string.split tinyUF '\n' with + | number :: rest -> + let n = int_of_string number in + let store = Union_find.init n in + List.iter (fun x -> + match Ext_string.quick_split_by_ws x with + | [a;b] -> + let a,b = int_of_string a , int_of_string b in + Union_find.union store a b + | _ -> ()) rest; + Union_find.count store + | _ -> assert false +;; + +let process_file file = + let ichan = open_in_bin file in + let n = int_of_string (input_line ichan) in + let store = Union_find.init n in + let edges = Int_vec_vec.make n in + let rec aux i = + match input_line ichan with + | exception _ -> () + | v -> + begin + (* if i = 0 then + print_endline "processing 100 nodes start"; + *) + begin match Ext_string.quick_split_by_ws v with + | [a;b] -> + let a,b = int_of_string a , int_of_string b in + Int_vec_vec.push edges (Int_vec.of_array [|a;b|]); + | _ -> () + end; + aux ((i+1) mod 10000); + end + in aux 0; + (* indeed, [unsafe_internal_array] is necessary for real performnace *) + let internal = Int_vec_vec.unsafe_internal_array edges in + for i = 0 to Array.length internal - 1 do + let i = Int_vec.unsafe_internal_array (Array.unsafe_get internal i) in + Union_find.union store (Array.unsafe_get i 0) (Array.unsafe_get i 1) + done; + (* Union_find.union store a b *) + Union_find.count store +;; +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (process_str tinyUF) 2 + end; + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (process_str mediumUF) 3 + end; +(* + __LOC__ >:: begin fun _ -> + OUnit.assert_equal (process_file "largeUF.txt") 6 + end; + *) + + ] +end +module Ounit_utf8_test += struct +#1 "ounit_utf8_test.ml" + + +(* https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt +*) + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +let (=~) = OUnit.assert_equal +let suites = + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "hello 你好，中华民族 hei" =~ + [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] + end ; + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "" =~ [] + end + ] +end +module Ounit_vec_test += struct +#1 "ounit_vec_test.ml" +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + +open Ext_json + +let v = Int_vec.init 10 (fun i -> i);; +let (=~) x y = OUnit.assert_equal ~cmp:(Int_vec.equal (fun (x: int) y -> x=y)) x y +let (=~~) x y + = + OUnit.assert_equal ~cmp:(Int_vec.equal (fun (x: int) y -> x=y)) + x (Int_vec.of_array y) + +let suites = + __FILE__ + >::: + [ + (** idea + [%loc "inplace filter" ] --> __LOC__ ^ "inplace filter" + or "inplace filter" [@bs.loc] + *) + "inplace_filter " ^ __LOC__ >:: begin fun _ -> + v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|]; + + ignore @@ Int_vec.push v 32; + let capacity = Int_vec.capacity v in + v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 32|]; + Int_vec.inplace_filter (fun x -> x mod 2 = 0) v ; + v =~~ [|0; 2; 4; 6; 8; 32|]; + Int_vec.inplace_filter (fun x -> x mod 3 = 0) v ; + v =~~ [|0;6|]; + Int_vec.inplace_filter (fun x -> x mod 3 <> 0) v ; + v =~~ [||]; + OUnit.assert_equal (Int_vec.capacity v ) capacity ; + Int_vec.compact v ; + OUnit.assert_equal (Int_vec.capacity v ) 0 + end + ; + "inplace_filter_from " ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.of_array (Array.init 10 (fun i -> i)) in + v =~~ [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|]; + Int_vec.push v 96 ; + Int_vec.inplace_filter_from 2 (fun x -> x mod 2 = 0) v ; + v =~~ [|0; 1; 2; 4; 6; 8; 96|]; + Int_vec.inplace_filter_from 2 (fun x -> x mod 3 = 0) v ; + v =~~ [|0; 1; 6; 96|]; + Int_vec.inplace_filter (fun x -> x mod 3 <> 0) v ; + v =~~ [|1|]; + Int_vec.compact v ; + OUnit.assert_equal (Int_vec.capacity v ) 1 + end + ; + "map " ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.of_array (Array.init 1000 (fun i -> i )) in + Int_vec.map succ v =~~ (Array.init 1000 succ) ; + OUnit.assert_bool __LOC__ (Int_vec.exists (fun x -> x >= 999) v ); + OUnit.assert_bool __LOC__ (not (Int_vec.exists (fun x -> x > 1000) v )); + OUnit.assert_equal (Int_vec.last v ) 999 + end ; + __LOC__ >:: begin fun _ -> + let count = 1000 in + let init_array = (Array.init count (fun i -> i)) in + let u = Int_vec.of_array init_array in + let v = Int_vec.inplace_filter_with (fun x -> x mod 2 = 0) ~cb_no:(fun a b -> Set_int.add b a)Set_int.empty u in + let (even,odd) = init_array |> Array.to_list |> List.partition (fun x -> x mod 2 = 0) in + OUnit.assert_equal + (Set_int.elements v) odd ; + u =~~ Array.of_list even + end ; + "filter" ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.of_array [|1;2;3;4;5;6|] in + v |> Int_vec.filter (fun x -> x mod 3 = 0) |> (fun x -> x =~~ [|3;6|]); + v =~~ [|1;2;3;4;5;6|]; + Int_vec.pop v ; + v =~~ [|1;2;3;4;5|]; + let count = ref 0 in + let len = Int_vec.length v in + while not (Int_vec.is_empty v ) do + Int_vec.pop v ; + incr count + done; + OUnit.assert_equal len !count + end + ; + __LOC__ >:: begin fun _ -> + let count = 100 in + let v = Int_vec.of_array (Array.init count (fun i -> i)) in + OUnit.assert_bool __LOC__ + (try Int_vec.delete v count; false with _ -> true ); + for i = count - 1 downto 10 do + Int_vec.delete v i ; + done ; + v =~~ [|0;1;2;3;4;5;6;7;8;9|] + end; + "sub" ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.make 5 in + OUnit.assert_bool __LOC__ + (try ignore @@ Int_vec.sub v 0 2 ; false with Invalid_argument _ -> true); + Int_vec.push v 1; + OUnit.assert_bool __LOC__ + (try ignore @@ Int_vec.sub v 0 2 ; false with Invalid_argument _ -> true); + Int_vec.push v 2; + ( Int_vec.sub v 0 2 =~~ [|1;2|]) + end; + "reserve" ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.empty () in + Int_vec.reserve v 1000 ; + for i = 0 to 900 do + Int_vec.push v i + done ; + OUnit.assert_equal (Int_vec.length v) 901 ; + OUnit.assert_equal (Int_vec.capacity v) 1000 + end ; + "capacity" ^ __LOC__ >:: begin fun _ -> + let v = Int_vec.of_array [|3|] in + Int_vec.reserve v 10 ; + v =~~ [|3 |]; + Int_vec.push v 1 ; + Int_vec.push v 2 ; + Int_vec.push v 5; + v=~~ [|3;1;2;5|]; + OUnit.assert_equal (Int_vec.capacity v ) 10 ; + for i = 0 to 5 do + Int_vec.push v i + done; + v=~~ [|3;1;2;5;0;1;2;3;4;5|]; + Int_vec.push v 100; + v=~~[|3;1;2;5;0;1;2;3;4;5;100|]; + OUnit.assert_equal (Int_vec.capacity v ) 20 + end + ; + __LOC__ >:: begin fun _ -> + let empty = Int_vec.empty () in + Int_vec.push empty 3; + empty =~~ [|3|]; + + end + ; + __LOC__ >:: begin fun _ -> + let lst = [1;2;3;4] in + let v = Int_vec.of_list lst in + OUnit.assert_equal + (Int_vec.map_into_list (fun x -> x + 1) v) + (Ext_list.map lst (fun x -> x + 1) ) + end; + __LOC__ >:: begin fun _ -> + let v = Int_vec.make 4 in + Int_vec.push v 1 ; + Int_vec.push v 2; + Int_vec.reverse_in_place v; + v =~~ [|2;1|] + end + ; + ] + +end +module Ounit_tests_main : sig +#1 "ounit_tests_main.mli" + +end = struct +#1 "ounit_tests_main.ml" + + + + +module Int_array = Resize_array.Make(struct type t = int let null = 0 end);; +let v = Int_array.init 10 (fun i -> i);; + +let ((>::), + (>:::)) = OUnit.((>::),(>:::)) + + +let (=~) x y = OUnit.assert_equal ~cmp:(Int_array.equal (fun (x: int) y -> x=y)) x y +let (=~~) x y + = + OUnit.assert_equal ~cmp:(Int_array.equal (fun (x: int) y -> x=y)) x (Int_array.of_array y) + +let suites = + __FILE__ >::: + [ + Ounit_vec_test.suites; + Ounit_json_tests.suites; + Ounit_path_tests.suites; + Ounit_array_tests.suites; + Ounit_scc_tests.suites; + Ounit_list_test.suites; + Ounit_hash_set_tests.suites; + Ounit_union_find_tests.suites; + Ounit_bal_tree_tests.suites; + Ounit_hash_stubs_test.suites; + Ounit_map_tests.suites; + Ounit_ordered_hash_set_tests.suites; + Ounit_hashtbl_tests.suites; + Ounit_string_tests.suites; + Ounit_topsort_tests.suites; + (* Ounit_sexp_tests.suites; *) + Ounit_int_vec_tests.suites; + Ounit_ident_mask_tests.suites; + Ounit_cmd_tests.suites; + Ounit_ffi_error_debug_test.suites; + Ounit_js_regex_checker_tests.suites; + Ounit_utf8_test.suites; + Ounit_unicode_tests.suites; + Ounit_bsb_regex_tests.suites; + Ounit_bsb_pkg_tests.suites; + Ounit_depends_format_test.suites; + ] +let _ = + OUnit.run_test_tt_main suites + +end diff --git a/lib/4.06.1/unstable/all_ounit_tests.ml.d b/lib/4.06.1/unstable/all_ounit_tests.ml.d new file mode 100644 index 0000000000..3555343241 --- /dev/null +++ b/lib/4.06.1/unstable/all_ounit_tests.ml.d @@ -0,0 +1,156 @@ +../lib/4.06.1/unstable/all_ounit_tests.ml: +./bsb/bsb_db.ml +./bsb/bsb_db.mli +./bsb/bsb_db_io.ml +./bsb/bsb_db_io.mli +./bsb/bsb_exception.ml +./bsb/bsb_exception.mli +./bsb/bsb_pkg_types.ml +./bsb/bsb_pkg_types.mli +./bsb/bsb_regex.ml +./bsb/bsb_regex.mli +./common/bs_loc.ml +./common/bs_loc.mli +./common/bs_version.ml +./common/bs_version.mli +./common/js_config.ml +./common/js_config.mli +./common/ml_binary.ml +./common/ml_binary.mli +./depends/ast_extract.ml +./depends/ast_extract.mli +./depends/bs_exception.ml +./depends/bs_exception.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_format.ml +./ext/ext_format.mli +./ext/ext_ident.ml +./ext/ext_ident.mli +./ext/ext_int.ml +./ext/ext_int.mli +./ext/ext_js_regex.ml +./ext/ext_js_regex.mli +./ext/ext_json.ml +./ext/ext_json.mli +./ext/ext_json_noloc.ml +./ext/ext_json_noloc.mli +./ext/ext_json_parse.ml +./ext/ext_json_parse.mli +./ext/ext_json_types.ml +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_modulename.ml +./ext/ext_modulename.mli +./ext/ext_namespace.ml +./ext/ext_namespace.mli +./ext/ext_obj.ml +./ext/ext_obj.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_position.ml +./ext/ext_position.mli +./ext/ext_ref.ml +./ext/ext_ref.mli +./ext/ext_scc.ml +./ext/ext_scc.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_topsort.ml +./ext/ext_topsort.mli +./ext/ext_utf8.ml +./ext/ext_utf8.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hash_set.ml +./ext/hash_set.mli +./ext/hash_set_gen.ml +./ext/hash_set_ident_mask.ml +./ext/hash_set_ident_mask.mli +./ext/hash_set_poly.ml +./ext/hash_set_poly.mli +./ext/hashtbl_gen.ml +./ext/int_hash_set.ml +./ext/int_hash_set.mli +./ext/int_map.ml +./ext/int_map.mli +./ext/int_vec.ml +./ext/int_vec.mli +./ext/int_vec_util.ml +./ext/int_vec_util.mli +./ext/int_vec_vec.ml +./ext/int_vec_vec.mli +./ext/js_reserved_map.ml +./ext/js_reserved_map.mli +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/ordered_hash_set_gen.ml +./ext/ordered_hash_set_string.ml +./ext/ordered_hash_set_string.mli +./ext/resize_array.ml +./ext/resize_array.mli +./ext/set_gen.ml +./ext/set_int.ml +./ext/set_int.mli +./ext/string_hash_set.ml +./ext/string_hash_set.mli +./ext/string_hashtbl.ml +./ext/string_hashtbl.mli +./ext/string_map.ml +./ext/string_map.mli +./ext/union_find.ml +./ext/union_find.mli +./ext/vec_gen.ml +./main/ounit_tests_main.ml +./main/ounit_tests_main.mli +./ounit/oUnit.ml +./ounit/oUnit.mli +./ounit/oUnitChooser.ml +./ounit/oUnitLogger.ml +./ounit/oUnitTypes.ml +./ounit/oUnitUtils.ml +./ounit_tests/ounit_array_tests.ml +./ounit_tests/ounit_bal_tree_tests.ml +./ounit_tests/ounit_bsb_pkg_tests.ml +./ounit_tests/ounit_bsb_regex_tests.ml +./ounit_tests/ounit_cmd_tests.ml +./ounit_tests/ounit_cmd_util.ml +./ounit_tests/ounit_cmd_util.mli +./ounit_tests/ounit_data_random.ml +./ounit_tests/ounit_depends_format_test.ml +./ounit_tests/ounit_ffi_error_debug_test.ml +./ounit_tests/ounit_hash_set_tests.ml +./ounit_tests/ounit_hash_stubs_test.ml +./ounit_tests/ounit_hashtbl_tests.ml +./ounit_tests/ounit_ident_mask_tests.ml +./ounit_tests/ounit_int_vec_tests.ml +./ounit_tests/ounit_js_regex_checker_tests.ml +./ounit_tests/ounit_json_tests.ml +./ounit_tests/ounit_list_test.ml +./ounit_tests/ounit_map_tests.ml +./ounit_tests/ounit_ordered_hash_set_tests.ml +./ounit_tests/ounit_path_tests.ml +./ounit_tests/ounit_scc_tests.ml +./ounit_tests/ounit_string_tests.ml +./ounit_tests/ounit_tests_util.ml +./ounit_tests/ounit_topsort_tests.ml +./ounit_tests/ounit_unicode_tests.ml +./ounit_tests/ounit_union_find_tests.ml +./ounit_tests/ounit_utf8_test.ml +./ounit_tests/ounit_vec_test.ml +./stubs/bs_hash_stubs.ml +./syntax/ast_compatible.ml +./syntax/ast_compatible.mli +./syntax/ast_utf8_string.ml +./syntax/ast_utf8_string.mli +./syntax/ast_utf8_string_interp.ml +./syntax/ast_utf8_string_interp.mli diff --git a/lib/4.06.1/unstable/bsb_native.ml b/lib/4.06.1/unstable/bsb_native.ml new file mode 100644 index 0000000000..5c06dfaa27 --- /dev/null +++ b/lib/4.06.1/unstable/bsb_native.ml @@ -0,0 +1,17254 @@ +module Bs_version : sig +#1 "bs_version.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 version : string + +val header : string + +val package_name : string +end = struct +#1 "bs_version.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 version = "5.0.1" +let header = + "// Generated by BUCKLESCRIPT VERSION 5.0.1, PLEASE EDIT WITH CARE" +let package_name = "bs-platform" + +end +module Bsb_build_schemas += struct +#1 "bsb_build_schemas.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 files = "files" +let version = "version" +let name = "name" +(* let ocaml_config = "ocaml-config" *) +let bsdep = "bsdep" +let ppx_flags = "ppx-flags" +let pp_flags = "pp-flags" +let bsc = "bsc" +let refmt = "refmt" +let refmt_flags = "refmt-flags" +let bs_external_includes = "bs-external-includes" +let bs_lib_dir = "bs-lib-dir" +let bs_dependencies = "bs-dependencies" +let bs_dev_dependencies = "bs-dev-dependencies" + + +let sources = "sources" +let dir = "dir" +let files = "files" +let subdirs = "subdirs" +let bsc_flags = "bsc-flags" +let excludes = "excludes" +let slow_re = "slow-re" +let resources = "resources" +let public = "public" +let js_post_build = "js-post-build" +let cmd = "cmd" +let ninja = "ninja" +let package_specs = "package-specs" + +let generate_merlin = "generate-merlin" + +let type_ = "type" +let dev = "dev" + +let export_all = "all" +let export_none = "none" + +let bsb_dir_group = "bsb_dir_group" +let bsc_lib_includes = "bsc_lib_includes" +let use_stdlib = "use-stdlib" +let reason = "reason" +let react_jsx = "react-jsx" + +let entries = "entries" +let kind = "kind" +let main = "main" +let cut_generators = "cut-generators" +let generators = "generators" +let command = "command" +let edge = "edge" +let namespace = "namespace" +let in_source = "in-source" +let warnings = "warnings" +let number = "number" +let error = "error" +let suffix = "suffix" +let gentypeconfig = "gentypeconfig" +let path = "path" +let ignored_dirs = "ignored-dirs" +end +module Ext_bytes : sig +#1 "ext_bytes.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. *) + + + + + + + +(** Port the {!Bytes.escaped} from trunk to make it not locale sensitive *) + +val escaped : bytes -> bytes + +end = struct +#1 "ext_bytes.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. *) + + + + + + + + +external char_code: char -> int = "%identity" +external char_chr: int -> char = "%identity" + +let escaped s = + let n = Pervasives.ref 0 in + for i = 0 to Bytes.length s - 1 do + n := !n + + (match Bytes.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | ' ' .. '~' -> 1 + | _ -> 4) + done; + if !n = Bytes.length s then Bytes.copy s else begin + let s' = Bytes.create !n in + n := 0; + for i = 0 to Bytes.length s - 1 do + begin match Bytes.unsafe_get s i with + | ('"' | '\\') as c -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c + | '\n' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' + | '\t' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' + | '\r' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' + | '\b' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' + | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c + | c -> + let a = char_code c in + Bytes.unsafe_set s' !n '\\'; + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a / 100)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a mod 10)); + end; + incr n + done; + s' + end + +end +module Ext_pervasives : sig +#1 "ext_pervasives.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. *) + + + + + + + + +(** Extension to standard library [Pervavives] module, safe to open + *) + +external reraise: exn -> 'a = "%reraise" + +val finally : 'a -> ('a -> 'c) -> ('a -> 'b) -> 'b + +val try_it : (unit -> 'a) -> unit + +val with_file_as_chan : string -> (out_channel -> 'a) -> 'a + +val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a + +val is_pos_pow : Int32.t -> int + +val failwithf : loc:string -> ('a, unit, string, 'b) format4 -> 'a + +val invalid_argf : ('a, unit, string, 'b) format4 -> 'a + +val bad_argf : ('a, unit, string, 'b) format4 -> 'a + + + + +external id : 'a -> 'a = "%identity" + +(** Copied from {!Btype.hash_variant}: + need sync up and add test case + *) +val hash_variant : string -> int + +val todo : string -> 'a +end = struct +#1 "ext_pervasives.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. *) + + + + + + +external reraise: exn -> 'a = "%reraise" + +let finally v action f = + match f v with + | exception e -> + action v ; + reraise e + | e -> action v ; e + +let try_it f = + try ignore (f ()) with _ -> () + +let with_file_as_chan filename f = + finally (open_out_bin filename) close_out f + +let with_file_as_pp filename f = + finally (open_out_bin filename) close_out + (fun chan -> + let fmt = Format.formatter_of_out_channel chan in + let v = f fmt in + Format.pp_print_flush fmt (); + v + ) + + +let is_pos_pow n = + let module M = struct exception E end in + let rec aux c (n : Int32.t) = + if n <= 0l then -2 + else if n = 1l then c + else if Int32.logand n 1l = 0l then + aux (c + 1) (Int32.shift_right n 1 ) + else raise M.E in + try aux 0 n with M.E -> -1 + +let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s)) + fmt + +let invalid_argf fmt = Format.ksprintf invalid_arg fmt + +let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt + +external id : 'a -> 'a = "%identity" + + +let hash_variant s = + let accu = ref 0 in + for i = 0 to String.length s - 1 do + accu := 223 * !accu + Char.code s.[i] + done; + (* reduce to 31 bits *) + accu := !accu land (1 lsl 31 - 1); + (* make it signed for 64 bits architectures *) + if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu + +let todo loc = + failwith (loc ^ " Not supported yet") +end +module Ext_string : sig +#1 "ext_string.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. *) + + + + + + + + +(** Extension to the standard library [String] module, fixed some bugs like + avoiding locale sensitivity *) + +(** default is false *) +val split_by : ?keep_empty:bool -> (char -> bool) -> string -> string list + + +(** remove whitespace letters ('\t', '\n', ' ') on both side*) +val trim : string -> string + + +(** default is false *) +val split : ?keep_empty:bool -> string -> char -> string list + +(** split by space chars for quick scripting *) +val quick_split_by_ws : string -> string list + + + +val starts_with : string -> string -> bool + +(** + return [-1] when not found, the returned index is useful + see [ends_with_then_chop] +*) +val ends_with_index : string -> string -> int + +val ends_with : string -> string -> bool + +(** + [ends_with_then_chop name ext] + @example: + {[ + ends_with_then_chop "a.cmj" ".cmj" + "a" + ]} + This is useful in controlled or file case sensitve system +*) +val ends_with_then_chop : string -> string -> string option + + +val escaped : string -> string + +(** + [for_all_from s start p] + if [start] is negative, it raises, + if [start] is too large, it returns true +*) +val for_all_from: + string -> + int -> + (char -> bool) -> + bool + +val for_all : + string -> + (char -> bool) -> + bool + +val is_empty : string -> bool + +val repeat : int -> string -> string + +val equal : string -> string -> bool + +(** + [extract_until s cursor sep] + When [sep] not found, the cursor is updated to -1, + otherwise cursor is increased to 1 + [sep_position] + User can not determine whether it is found or not by + telling the return string is empty since + "\n\n" would result in an empty string too. +*) +val extract_until: + string -> + int ref -> (* cursor to be updated *) + char -> + string + +val index_count: + string -> + int -> + char -> + int -> + int + +(** + [find ~start ~sub s] + returns [-1] if not found +*) +val find : ?start:int -> sub:string -> string -> int + +val contain_substring : string -> string -> bool + +val non_overlap_count : sub:string -> string -> int + +val rfind : sub:string -> string -> int + +(** [tail_from s 1] + return a substring from offset 1 (inclusive) +*) +val tail_from : string -> int -> string + + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option + +type check_result = + | Good | Invalid_module_name | Suffix_mismatch + +val is_valid_source_name : + string -> check_result + + + + + +val no_char : string -> char -> int -> int -> bool + + +val no_slash : string -> bool + +(** return negative means no slash, otherwise [i] means the place for first slash *) +val no_slash_idx : string -> int + +val no_slash_idx_from : string -> int -> int + +(** if no conversion happens, reference equality holds *) +val replace_slash_backward : string -> string + +(** if no conversion happens, reference equality holds *) +val replace_backward_slash : string -> string + +val empty : string + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +val single_space : string + +val concat3 : string -> string -> string -> string +val concat4 : string -> string -> string -> string -> string +val concat5 : string -> string -> string -> string -> string -> string +val inter2 : string -> string -> string +val inter3 : string -> string -> string -> string +val inter4 : string -> string -> string -> string -> string +val concat_array : string -> string array -> string + +val single_colon : string + +val parent_dir_lit : string +val current_dir_lit : string + +val capitalize_ascii : string -> string + +val uncapitalize_ascii : string -> string + +val lowercase_ascii : string -> string +end = struct +#1 "ext_string.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. *) + + + + + + + +(* + {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} +*) +let split_by ?(keep_empty=false) is_delim str = + let len = String.length str in + let rec loop acc last_pos pos = + if pos = -1 then + if last_pos = 0 && not keep_empty then + + acc + else + String.sub str 0 last_pos :: acc + else + if is_delim str.[pos] then + let new_len = (last_pos - pos - 1) in + if new_len <> 0 || keep_empty then + let v = String.sub str (pos + 1) new_len in + loop ( v :: acc) + pos (pos - 1) + else loop acc pos (pos - 1) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) + +let trim s = + let i = ref 0 in + let j = String.length s in + while !i < j && + let u = String.unsafe_get s !i in + u = '\t' || u = '\n' || u = ' ' + do + incr i; + done; + let k = ref (j - 1) in + while !k >= !i && + let u = String.unsafe_get s !k in + u = '\t' || u = '\n' || u = ' ' do + decr k ; + done; + String.sub s !i (!k - !i + 1) + +let split ?keep_empty str on = + if str = "" then [] else + split_by ?keep_empty (fun x -> (x : char) = on) str ;; + +let quick_split_by_ws str : string list = + split_by ~keep_empty:false (fun x -> x = '\t' || x = '\n' || x = ' ') str + +let starts_with s beg = + let beg_len = String.length beg in + let s_len = String.length s in + beg_len <= s_len && + (let i = ref 0 in + while !i < beg_len + && String.unsafe_get s !i = + String.unsafe_get beg !i do + incr i + done; + !i = beg_len + ) + +let rec ends_aux s end_ j k = + if k < 0 then (j + 1) + else if String.unsafe_get s j = String.unsafe_get end_ k then + ends_aux s end_ (j - 1) (k - 1) + else -1 + +(** return an index which is minus when [s] does not + end with [beg] +*) +let ends_with_index s end_ = + let s_finish = String.length s - 1 in + let s_beg = String.length end_ - 1 in + if s_beg > s_finish then -1 + else + ends_aux s end_ s_finish s_beg + +let ends_with s end_ = ends_with_index s end_ >= 0 + +let ends_with_then_chop s beg = + let i = ends_with_index s beg in + if i >= 0 then Some (String.sub s 0 i) + else None + +let check_suffix_case = ends_with +let check_suffix_case_then_chop = ends_with_then_chop + +let check_any_suffix_case s suffixes = + List.exists (fun x -> check_suffix_case s x) suffixes + +let check_any_suffix_case_then_chop s suffixes = + let rec aux suffixes = + match suffixes with + | [] -> None + | x::xs -> + let id = ends_with_index s x in + if id >= 0 then Some (String.sub s 0 id) + else aux xs in + aux suffixes + + + +(** In OCaml 4.02.3, {!String.escaped} is locale senstive, + this version try to make it not locale senstive, this bug is fixed + in the compiler trunk +*) +let escaped s = + let rec needs_escape i = + if i >= String.length s then false else + match String.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true + | ' ' .. '~' -> needs_escape (i+1) + | _ -> true + in + if needs_escape 0 then + Bytes.unsafe_to_string (Ext_bytes.escaped (Bytes.unsafe_of_string s)) + else + s + +(* it is unsafe to expose such API as unsafe since + user can provide bad input range + +*) +let rec unsafe_for_all_range s ~start ~finish p = + start > finish || + p (String.unsafe_get s start) && + unsafe_for_all_range s ~start:(start + 1) ~finish p + +let for_all_from s start p = + let len = String.length s in + if start < 0 then invalid_arg "Ext_string.for_all_from" + else unsafe_for_all_range s ~start ~finish:(len - 1) p + + +let for_all s (p : char -> bool) = + unsafe_for_all_range s ~start:0 ~finish:(String.length s - 1) p + +let is_empty s = String.length s = 0 + + +let repeat n s = + let len = String.length s in + let res = Bytes.create(n * len) in + for i = 0 to pred n do + String.blit s 0 res (i * len) len + done; + Bytes.to_string res + +let equal (x : string) y = x = y + + + +let unsafe_is_sub ~sub i s j ~len = + let rec check k = + if k = len + then true + else + String.unsafe_get sub (i+k) = + String.unsafe_get s (j+k) && check (k+1) + in + j+len <= String.length s && check 0 + + +exception Local_exit +let find ?(start=0) ~sub s = + let n = String.length sub in + let s_len = String.length s in + let i = ref start in + try + while !i + n <= s_len do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + incr i + done; + -1 + with Local_exit -> + !i + +let contain_substring s sub = + find s ~sub >= 0 + +(** TODO: optimize + avoid nonterminating when string is empty +*) +let non_overlap_count ~sub s = + let sub_len = String.length sub in + let rec aux acc off = + let i = find ~start:off ~sub s in + if i < 0 then acc + else aux (acc + 1) (i + sub_len) in + if String.length sub = 0 then invalid_arg "Ext_string.non_overlap_count" + else aux 0 0 + + +let rfind ~sub s = + let n = String.length sub in + let i = ref (String.length s - n) in + let module M = struct exception Exit end in + try + while !i >= 0 do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + decr i + done; + -1 + with Local_exit -> + !i + +let tail_from s x = + let len = String.length s in + if x > len then invalid_arg ("Ext_string.tail_from " ^s ^ " : "^ string_of_int x ) + else String.sub s x (len - x) + +let equal (x : string) y = x = y + +let rec index_rec s lim i c = + if i >= lim then -1 else + if String.unsafe_get s i = c then i + else index_rec s lim (i + 1) c + +let rec index_rec_count s lim i c count = + if i >= lim then -1 else + if String.unsafe_get s i = c then + if count = 1 then i + else index_rec_count s lim (i + 1) c (count - 1) + else index_rec_count s lim (i + 1) c count + +let index_count s i c count = + let lim = String.length s in + if i < 0 || i >= lim || count < 1 then + Ext_pervasives.invalid_argf "index_count: (%d,%d)" i count; + + index_rec_count s lim i c count +let extract_until s cursor c = + let len = String.length s in + let start = !cursor in + if start < 0 || start >= len then ( + cursor := -1; + "" + ) + else + let i = index_rec s len start c in + let finish = + if i < 0 then ( + cursor := -1 ; + len + ) + else ( + cursor := i + 1; + i + ) in + String.sub s start (finish - start) + +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;; + +let is_valid_module_file (s : string) = + let len = String.length s in + len > 0 && + match String.unsafe_get s 0 with + | 'A' .. 'Z' + | 'a' .. 'z' -> + unsafe_for_all_range s ~start:1 ~finish:(len - 1) + (fun x -> + match x with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> true + | _ -> false ) + | _ -> false + + + + +type check_result = + | Good + | Invalid_module_name + | Suffix_mismatch + (** + TODO: move to another module + Make {!Ext_filename} not stateful + *) +let is_valid_source_name name : check_result = + match check_any_suffix_case_then_chop name [ + ".ml"; + ".re"; + ".mli"; + ".rei" + ] with + | None -> Suffix_mismatch + | Some x -> + if is_valid_module_file x then + Good + else Invalid_module_name + +(** TODO: can be improved to return a positive integer instead *) +let rec unsafe_no_char x ch i last_idx = + i > last_idx || + (String.unsafe_get x i <> ch && unsafe_no_char x ch (i + 1) last_idx) + +let rec unsafe_no_char_idx x ch i last_idx = + if i > last_idx then -1 + else + if String.unsafe_get x i <> ch then + unsafe_no_char_idx x ch (i + 1) last_idx + else i + +let no_char x ch i len : bool = + let str_len = String.length x in + if i < 0 || i >= str_len || len >= str_len then invalid_arg "Ext_string.no_char" + else unsafe_no_char x ch i len + + +let no_slash x = + unsafe_no_char x '/' 0 (String.length x - 1) + +let no_slash_idx x = + unsafe_no_char_idx x '/' 0 (String.length x - 1) + +let no_slash_idx_from x from = + let last_idx = String.length x - 1 in + assert (from >= 0); + unsafe_no_char_idx x '/' from last_idx + +let replace_slash_backward (x : string ) = + let len = String.length x in + if unsafe_no_char x '/' 0 (len - 1) then x + else + String.map (function + | '/' -> '\\' + | x -> x ) x + +let replace_backward_slash (x : string)= + let len = String.length x in + if unsafe_no_char x '\\' 0 (len -1) then x + else + String.map (function + |'\\'-> '/' + | x -> x) x + +let empty = "" + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +let single_space = " " +let single_colon = ":" + +let concat_array sep (s : string array) = + let s_len = Array.length s in + match s_len with + | 0 -> empty + | 1 -> Array.unsafe_get s 0 + | _ -> + let sep_len = String.length sep in + let len = ref 0 in + for i = 0 to s_len - 1 do + len := !len + String.length (Array.unsafe_get s i) + done; + let target = + Bytes.create + (!len + (s_len - 1) * sep_len ) in + let hd = (Array.unsafe_get s 0) in + let hd_len = String.length hd in + String.unsafe_blit hd 0 target 0 hd_len; + let current_offset = ref hd_len in + for i = 1 to s_len - 1 do + String.unsafe_blit sep 0 target !current_offset sep_len; + let cur = Array.unsafe_get s i in + let cur_len = String.length cur in + let new_off_set = (!current_offset + sep_len ) in + String.unsafe_blit cur 0 target new_off_set cur_len; + current_offset := + new_off_set + cur_len ; + done; + Bytes.unsafe_to_string target + +let concat3 a b c = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let len = a_len + b_len + c_len in + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + Bytes.unsafe_to_string target + +let concat4 a b c d = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let len = a_len + b_len + c_len + d_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + Bytes.unsafe_to_string target + + +let concat5 a b c d e = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let e_len = String.length e in + let len = a_len + b_len + c_len + d_len + e_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + String.unsafe_blit e 0 target (a_len + b_len + c_len + d_len) e_len; + Bytes.unsafe_to_string target + + + +let inter2 a b = + concat3 a single_space b + + +let inter3 a b c = + concat5 a single_space b single_space c + + + + + +let inter4 a b c d = + concat_array single_space [| a; b ; c; d|] + + +let parent_dir_lit = ".." +let current_dir_lit = "." + + +(* reference {!Bytes.unppercase} *) +let capitalize_ascii (s : string) : string = + if String.length s = 0 then s + else + begin + let c = String.unsafe_get s 0 in + if (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') then + let uc = Char.unsafe_chr (Char.code c - 32) in + let bytes = Bytes.of_string s in + Bytes.unsafe_set bytes 0 uc; + Bytes.unsafe_to_string bytes + else s + end + +let uncapitalize_ascii = + + String.uncapitalize_ascii + + + + +let lowercase_ascii = String.lowercase_ascii + + + + + +end +module Bsb_pkg_types : sig +#1 "bsb_pkg_types.mli" +(* Copyright (C) 2019- Authors of BuckleScript + * + * 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. *) + + +type t = + | Global of string + | Scope of string * scope +and scope = string + +val to_string : t -> string +val print : Format.formatter -> t -> unit +val equal : t -> t -> bool + +(* The second element could be empty or dropped +*) +val extract_pkg_name_and_file : string -> t * string +val string_as_package : string -> t +end = struct +#1 "bsb_pkg_types.ml" + +(* Copyright (C) 2018- Authors of BuckleScript + * + * 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 (//) = Filename.concat + +type t = + | Global of string + | Scope of string * scope +and scope = string + +let to_string (x : t) = + match x with + | Global s -> s + | Scope (s,scope) -> scope // s + +let print fmt (x : t) = + match x with + | Global s -> Format.pp_print_string fmt s + | Scope(name,scope) -> + Format.fprintf fmt "%s/%s" scope name + +let equal (x : t) y = + match x, y with + | Scope(a0,a1), Scope(b0,b1) + -> a0 = b0 && a1 = b1 + | Global a0, Global b0 -> a0 = b0 + | Scope _, Global _ + | Global _, Scope _ -> false + +(** + input: {[ + @hello/yy/xx + hello/yy + ]} + FIXME: fix invalid input + {[ + hello//xh//helo + ]} +*) +let extract_pkg_name_and_file (s : string) = + let len = String.length s in + assert (len > 0 ); + let v = String.unsafe_get s 0 in + if v = '@' then + let scope_id = + Ext_string.no_slash_idx s in + assert (scope_id > 0); + let pkg_id = + Ext_string.no_slash_idx_from + s (scope_id + 1) in + let scope = + String.sub s 0 scope_id in + + if pkg_id < 0 then + (Scope(String.sub s (scope_id + 1) (len - scope_id - 1), scope),"") + else + (Scope( + String.sub s (scope_id + 1) (pkg_id - scope_id - 1), scope), + String.sub s (pkg_id + 1) (len - pkg_id - 1)) + else + let pkg_id = Ext_string.no_slash_idx s in + if pkg_id < 0 then + Global s , "" + else + Global (String.sub s 0 pkg_id), + (String.sub s (pkg_id + 1) (len - pkg_id - 1)) + + +let string_as_package (s : string) : t = + let len = String.length s in + assert (len > 0); + let v = String.unsafe_get s 0 in + if v = '@' then + let scope_id = + Ext_string.no_slash_idx s in + assert (scope_id > 0); + Scope( + String.sub s (scope_id + 1) (len - scope_id - 1), + String.sub s 0 scope_id + ) + else Global s +end +module Ext_array : sig +#1 "ext_array.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. *) + + + + + + +(** Some utilities for {!Array} operations *) +val reverse_range : 'a array -> int -> int -> unit +val reverse_in_place : 'a array -> unit +val reverse : 'a array -> 'a array +val reverse_of_list : 'a list -> 'a array + +val filter : ('a -> bool) -> 'a array -> 'a array + +val filter_map : ('a -> 'b option) -> 'a array -> 'b array + +val range : int -> int -> int array + +val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array + +val to_list_f : ('a -> 'b) -> 'a array -> 'b list +val to_list_map : ('a -> 'b option) -> 'a array -> 'b list + +val to_list_map_acc : + 'a array -> + 'b list -> + ('a -> 'b option) -> + 'b list + +val of_list_map : + 'a list -> + ('a -> 'b) -> + 'b array + +val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int + + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] + +val rfind_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val find_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val exists : ('a -> bool) -> 'a array -> bool + +val is_empty : 'a array -> bool + +val for_all2_no_exn : + 'a array -> + 'b array -> + ('a -> 'b -> bool) -> + bool + +val map : + 'a array -> + ('a -> 'b) -> + 'b array + +val iter : + 'a array -> + ('a -> unit) -> + unit + +val fold_left : + 'b array -> + 'a -> + ('a -> 'b -> 'a) -> + 'a +end = struct +#1 "ext_array.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 reverse_range a i len = + if len = 0 then () + else + for k = 0 to (len-1)/2 do + let t = Array.unsafe_get a (i+k) in + Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k)); + Array.unsafe_set a (i+len-1-k) t; + done + + +let reverse_in_place a = + reverse_range a 0 (Array.length a) + +let reverse a = + let b_len = Array.length a in + if b_len = 0 then [||] else + let b = Array.copy a in + for i = 0 to b_len - 1 do + Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) + done; + b + +let reverse_of_list = function + | [] -> [||] + | hd::tl as l -> + let len = List.length l in + let a = Array.make len hd in + let rec fill i = function + | [] -> a + | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in + fill 0 tl + +let filter f a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + if f v then + aux (v::acc) (i+1) + else aux acc (i + 1) + in aux [] 0 + + +let filter_map (f : _ -> _ option) a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + match f v with + | Some v -> + aux (v::acc) (i+1) + | None -> + aux acc (i + 1) + in aux [] 0 + +let range from to_ = + if from > to_ then invalid_arg "Ext_array.range" + else Array.init (to_ - from + 1) (fun i -> i + from) + +let map2i f a b = + let len = Array.length a in + if len <> Array.length b then + invalid_arg "Ext_array.map2i" + else + Array.mapi (fun i a -> f i a ( Array.unsafe_get b i )) a + +let rec tolist_f_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_f_aux a f (i - 1) + (f v :: res) + +let to_list_f f a = tolist_f_aux a f (Array.length a - 1) [] + +let rec tolist_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_aux a f (i - 1) + (match f v with + | Some v -> v :: res + | None -> res) + +let to_list_map f a = + tolist_aux a f (Array.length a - 1) [] + +let to_list_map_acc a acc f = + tolist_aux a f (Array.length a - 1) acc + + +let of_list_map a f = + match a with + | [] -> [||] + | [a0] -> + let b0 = f a0 in + [|b0|] + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + [|b0;b1|] + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + [|b0;b1;b2|] + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + [|b0;b1;b2;b3|] + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + [|b0;b1;b2;b3;b4|] + + | a0::a1::a2::a3::a4::tl -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + let len = List.length tl + 5 in + let arr = Array.make len b0 in + Array.unsafe_set arr 1 b1 ; + Array.unsafe_set arr 2 b2 ; + Array.unsafe_set arr 3 b3 ; + Array.unsafe_set arr 4 b4 ; + let rec fill i = function + | [] -> arr + | hd :: tl -> + Array.unsafe_set arr i (f hd); + fill (i + 1) tl in + fill 5 tl + +(** + {[ + # rfind_with_index [|1;2;3|] (=) 2;; + - : int = 1 + # rfind_with_index [|1;2;3|] (=) 1;; + - : int = 0 + # rfind_with_index [|1;2;3|] (=) 3;; + - : int = 2 + # rfind_with_index [|1;2;3|] (=) 4;; + - : int = -1 + ]} +*) +let rfind_with_index arr cmp v = + let len = Array.length arr in + let rec aux i = + if i < 0 then i + else if cmp (Array.unsafe_get arr i) v then i + else aux (i - 1) in + aux (len - 1) + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] +let rfind_and_split arr cmp v : _ split = + let i = rfind_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i , Array.sub arr (i + 1 ) (Array.length arr - i - 1 )) + + +let find_with_index arr cmp v = + let len = Array.length arr in + let rec aux i len = + if i >= len then -1 + else if cmp (Array.unsafe_get arr i ) v then i + else aux (i + 1) len in + aux 0 len + +let find_and_split arr cmp v : _ split = + let i = find_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1)) + +(** TODO: available since 4.03, use {!Array.exists} *) + +let exists p a = + let n = Array.length a in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + + +let is_empty arr = + Array.length arr = 0 + + +let rec unsafe_loop index len p xs ys = + if index >= len then true + else + p + (Array.unsafe_get xs index) + (Array.unsafe_get ys index) && + unsafe_loop (succ index) len p xs ys + +let for_all2_no_exn xs ys p = + let len_xs = Array.length xs in + let len_ys = Array.length ys in + len_xs = len_ys && + unsafe_loop 0 len_xs p xs ys + + +let map a f = + let open Array in + let l = length a in + if l = 0 then [||] else begin + let r = make l (f(unsafe_get a 0)) in + for i = 1 to l - 1 do + unsafe_set r i (f(unsafe_get a i)) + done; + r + end + +let iter a f = + let open Array in + for i = 0 to length a - 1 do f(unsafe_get a i) done + + + let fold_left a x f = + let open Array in + let r = ref x in + for i = 0 to length a - 1 do + r := f !r (unsafe_get a i) + done; + !r + +end +module Ext_list : sig +#1 "ext_list.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 map : + 'a list -> + ('a -> 'b) -> + 'b list + +val has_string : + string list -> + string -> + bool +val map_split_opt : + 'a list -> + ('a -> 'b option * 'c option) -> + 'b list * 'c list + +val mapi : + 'a list -> + (int -> 'a -> 'b) -> + 'b list + +val map_snd : ('a * 'b) list -> ('b -> 'c) -> ('a * 'c) list + +(** [map_last f xs ] + will pass [true] to [f] for the last element, + [false] otherwise. + For empty list, it returns empty +*) +val map_last : + 'a list -> + (bool -> 'a -> 'b) -> 'b list + +(** [last l] + return the last element + raise if the list is empty +*) +val last : 'a list -> 'a + +val append : + 'a list -> + 'a list -> + 'a list + +val append_one : + 'a list -> + 'a -> + 'a list + +val map_append : + 'b list -> + 'a list -> + ('b -> 'a) -> + 'a list + +val fold_right : + 'a list -> + 'b -> + ('a -> 'b -> 'b) -> + 'b + +val fold_right2 : + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) -> 'c + +val map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c) -> + 'c list + +val fold_left_with_offset : + 'a list -> + 'acc -> + int -> + ('a -> 'acc -> int -> 'acc) -> + 'acc + + +(** @unused *) +val filter_map : + 'a list -> + ('a -> 'b option) -> + 'b list + +(** [exclude p l] is the opposite of [filter p l] *) +val exclude : + 'a list -> + ('a -> bool) -> + 'a list + +(** [excludes p l] + return a tuple [excluded,newl] + where [exluded] is true indicates that at least one + element is removed,[newl] is the new list where all [p x] for [x] is false + +*) +val exclude_with_val : + 'a list -> + ('a -> bool) -> + 'a list option + + +val same_length : 'a list -> 'b list -> bool + +val init : int -> (int -> 'a) -> 'a list + +(** [split_at n l] + will split [l] into two lists [a,b], [a] will be of length [n], + otherwise, it will raise +*) +val split_at : + 'a list -> + int -> + 'a list * 'a list + + +(** [split_at_last l] + It is equivalent to [split_at (List.length l - 1) l ] +*) +val split_at_last : 'a list -> 'a list * 'a + +val filter_mapi : + 'a list -> + ('a -> int -> 'b option) -> + 'b list + +val filter_map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c option) -> + 'c list + + +val length_compare : 'a list -> int -> [`Gt | `Eq | `Lt ] + +val length_ge : 'a list -> int -> bool + +(** + + {[length xs = length ys + n ]} + input n should be positive + TODO: input checking +*) + +val length_larger_than_n : + 'a list -> + 'a list -> + int -> + bool + + +(** + [rev_map_append f l1 l2] + [map f l1] and reverse it to append [l2] + This weird semantics is due to it is the most efficient operation + we can do +*) +val rev_map_append : + 'a list -> + 'b list -> + ('a -> 'b) -> + 'b list + + +val flat_map : + 'a list -> + ('a -> 'b list) -> + 'b list + +val flat_map_append : + 'a list -> + 'b list -> + ('a -> 'b list) -> + 'b list + + +(** + [stable_group eq lst] + Example: + Input: + {[ + stable_group (=) [1;2;3;4;3] + ]} + Output: + {[ + [[1];[2];[4];[3;3]] + ]} + TODO: this is O(n^2) behavior + which could be improved later +*) +val stable_group : + 'a list -> + ('a -> 'a -> bool) -> + 'a list list + +(** [drop n list] + raise when [n] is negative + raise when list's length is less than [n] +*) +val drop : + 'a list -> + int -> + 'a list + +val find_first : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_first_not p lst ] + if all elements in [lst] pass, return [None] + otherwise return the first element [e] as [Some e] which + fails the predicate +*) +val find_first_not : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_opt f l] returns [None] if all return [None], + otherwise returns the first one. +*) + +val find_opt : + 'a list -> + ('a -> 'b option) -> + 'b option + + +val rev_iter : + 'a list -> + ('a -> unit) -> + unit + +val iter: + 'a list -> + ('a -> unit) -> + unit + +val for_all: + 'a list -> + ('a -> bool) -> + bool +val for_all_snd: + ('a * 'b) list -> + ('b -> bool) -> + bool + +(** [for_all2_no_exn p xs ys] + return [true] if all satisfied, + [false] otherwise or length not equal +*) +val for_all2_no_exn : + 'a list -> + 'b list -> + ('a -> 'b -> bool) -> + bool + + + +(** [f] is applied follow the list order *) +val split_map : + 'a list -> + ('a -> 'b * 'c) -> + 'b list * 'c list + +(** [fn] is applied from left to right *) +val reduce_from_left : + 'a list -> + ('a -> 'a -> 'a) -> + 'a + +val sort_via_array : + 'a list -> + ('a -> 'a -> int) -> + 'a list + + + + +(** [assoc_by_string default key lst] + if [key] is found in the list return that val, + other unbox the [default], + otherwise [assert false ] +*) +val assoc_by_string : + (string * 'a) list -> + string -> + 'a option -> + 'a + +val assoc_by_int : + (int * 'a) list -> + int -> + 'a option -> + 'a + + +val nth_opt : 'a list -> int -> 'a option + +val iter_snd : ('a * 'b) list -> ('b -> unit) -> unit + +val iter_fst : ('a * 'b) list -> ('a -> unit) -> unit + +val exists : 'a list -> ('a -> bool) -> bool +val exists_snd : ('a * 'b) list -> ('b -> bool) -> bool + +val concat_append: + 'a list list -> + 'a list -> + 'a list + +val fold_left2: + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) + -> 'c + +val fold_left: + 'a list -> + 'b -> + ('b -> 'a -> 'b) -> + 'b + +val singleton_exn: + 'a list -> 'a +end = struct +#1 "ext_list.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 rec map l f = + match l with + | [] -> + [] + | [x1] -> + let y1 = f x1 in + [y1] + | [x1; x2] -> + let y1 = f x1 in + let y2 = f x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::x5::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + y1::y2::y3::y4::y5::(map tail f) + +let rec has_string l f = + match l with + | [] -> + false + | [x1] -> + x1 = f + | [x1; x2] -> + x1 = f || x2 = f + | [x1; x2; x3] -> + x1 = f || x2 = f || x3 = f + | x1 :: x2 :: x3 :: x4 -> + x1 = f || x2 = f || x3 = f || has_string x4 f + + +let rec map_split_opt + (xs : 'a list) (f : 'a -> 'b option * 'c option) + : 'b list * 'c list = + match xs with + | [] -> [], [] + | x::xs -> + let c,d = f x in + let cs,ds = map_split_opt xs f in + (match c with Some c -> c::cs | None -> cs), + (match d with Some d -> d::ds | None -> ds) + +let rec map_snd l f = + match l with + | [] -> + [] + | [ v1,x1 ] -> + let y1 = f x1 in + [v1,y1] + | [v1, x1; v2, x2] -> + let y1 = f x1 in + let y2 = f x2 in + [v1, y1; v2, y2] + | [ v1, x1; v2, x2; v3, x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [v1, y1; v2, y2; v3, y3] + | [ v1, x1; v2, x2; v3, x3; v4, x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [v1, y1; v2, y2; v3, y3; v4, y4] + | (v1, x1) ::(v2, x2) :: (v3, x3)::(v4, x4) :: (v5, x5) ::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + (v1, y1)::(v2, y2) :: (v3, y3) :: (v4, y4) :: (v5, y5) :: (map_snd tail f) + + +let rec map_last l f= + match l with + | [] -> + [] + | [x1] -> + let y1 = f true x1 in + [y1] + | [x1; x2] -> + let y1 = f false x1 in + let y2 = f true x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f true x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f true x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::tail -> + (* make sure that tail is not empty *) + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f false x4 in + y1::y2::y3::y4::(map_last tail f) + +let rec mapi_aux lst i f = + match lst with + [] -> [] + | a::l -> + let r = f i a in r :: mapi_aux l (i + 1) f + +let mapi lst f = mapi_aux lst 0 f + +let rec last xs = + match xs with + | [x] -> x + | _ :: tl -> last tl + | [] -> invalid_arg "Ext_list.last" + + + +let rec append_aux l1 l2 = + match l1 with + | [] -> l2 + | [a0] -> a0::l2 + | [a0;a1] -> a0::a1::l2 + | [a0;a1;a2] -> a0::a1::a2::l2 + | [a0;a1;a2;a3] -> a0::a1::a2::a3::l2 + | [a0;a1;a2;a3;a4] -> a0::a1::a2::a3::a4::l2 + | a0::a1::a2::a3::a4::rest -> a0::a1::a2::a3::a4::append_aux rest l2 + +let append l1 l2 = + match l2 with + | [] -> l1 + | _ -> append_aux l1 l2 + +let append_one l1 x = append_aux l1 [x] + +let rec map_append l1 l2 f = + match l1 with + | [] -> l2 + | [a0] -> f a0::l2 + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + b0::b1::l2 + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + b0::b1::b2::l2 + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + b0::b1::b2::b3::l2 + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::l2 + + | a0::a1::a2::a3::a4::rest -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::map_append rest l2 f + + + +let rec fold_right l acc f = + match l with + | [] -> acc + | [a0] -> f a0 acc + | [a0;a1] -> f a0 (f a1 acc) + | [a0;a1;a2] -> f a0 (f a1 (f a2 acc)) + | [a0;a1;a2;a3] -> f a0 (f a1 (f a2 (f a3 acc))) + | [a0;a1;a2;a3;a4] -> + f a0 (f a1 (f a2 (f a3 (f a4 acc)))) + | a0::a1::a2::a3::a4::rest -> + f a0 (f a1 (f a2 (f a3 (f a4 (fold_right rest acc f ))))) + +let rec fold_right2 l r acc f = + match l,r with + | [],[] -> acc + | [a0],[b0] -> f a0 b0 acc + | [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc) + | [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc)) + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc))) + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc)))) + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f ))))) + | _, _ -> invalid_arg "Ext_list.fold_right2" + +let rec map2 l r f = + match l,r with + | [],[] -> [] + | [a0],[b0] -> [f a0 b0] + | [a0;a1],[b0;b1] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + [c0; c1] + | [a0;a1;a2],[b0;b1;b2] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + [c0;c1;c2] + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + [c0;c1;c2;c3] + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + [c0;c1;c2;c3;c4] + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + c0::c1::c2::c3::c4::map2 arest brest f + | _, _ -> invalid_arg "Ext_list.map2" + +let rec fold_left_with_offset l accu i f = + match l with + | [] -> accu + | a::l -> + fold_left_with_offset + l + (f a accu i) + (i + 1) + f + + +let rec filter_map xs (f: 'a -> 'b option)= + match xs with + | [] -> [] + | y :: ys -> + begin match f y with + | None -> filter_map ys f + | Some z -> z :: filter_map ys f + end + +let rec exclude (xs : 'a list) (p : 'a -> bool) : 'a list = + match xs with + | [] -> [] + | x::xs -> + if p x then exclude xs p + else x:: exclude xs p + +let rec exclude_with_val l p = + match l with + | [] -> None + | a0::xs -> + if p a0 then Some (exclude xs p) + else + match xs with + | [] -> None + | a1::rest -> + if p a1 then + Some (a0:: exclude rest p) + else + match exclude_with_val rest p with + | None -> None + | Some rest -> Some (a0::a1::rest) + + + +let rec same_length xs ys = + match xs, ys with + | [], [] -> true + | _::xs, _::ys -> same_length xs ys + | _, _ -> false + + +let init n f = + match n with + | 0 -> [] + | 1 -> + let a0 = f 0 in + [a0] + | 2 -> + let a0 = f 0 in + let a1 = f 1 in + [a0; a1] + | 3 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + [a0; a1; a2] + | 4 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + [a0; a1; a2; a3] + | 5 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + let a4 = f 4 in + [a0; a1; a2; a3; a4] + | _ -> + Array.to_list (Array.init n f) + +let rec small_split_at n acc l = + if n <= 0 then List.rev acc , l + else + match l with + | x::xs -> small_split_at (n - 1) (x ::acc) xs + | _ -> invalid_arg "Ext_list.split_at" + +let split_at l n = + small_split_at n [] l + +let rec split_at_last_aux acc x = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [ x] -> List.rev acc, x + | y0::ys -> split_at_last_aux (y0::acc) ys + +let split_at_last (x : 'a list) = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [a0] -> + [], a0 + | [a0;a1] -> + [a0], a1 + | [a0;a1;a2] -> + [a0;a1], a2 + | [a0;a1;a2;a3] -> + [a0;a1;a2], a3 + | [a0;a1;a2;a3;a4] -> + [a0;a1;a2;a3], a4 + | a0::a1::a2::a3::a4::rest -> + let rev, last = split_at_last_aux [] rest + in + a0::a1::a2::a3::a4:: rev , last + +(** + can not do loop unroll due to state combination +*) +let filter_mapi xs f = + let rec aux i xs = + match xs with + | [] -> [] + | y :: ys -> + begin match f y i with + | None -> aux (i + 1) ys + | Some z -> z :: aux (i + 1) ys + end in + aux 0 xs + +let rec filter_map2 xs ys (f: 'a -> 'b -> 'c option) = + match xs,ys with + | [],[] -> [] + | u::us, v :: vs -> + begin match f u v with + | None -> filter_map2 us vs f (* idea: rec f us vs instead? *) + | Some z -> z :: filter_map2 us vs f + end + | _ -> invalid_arg "Ext_list.filter_map2" + + +let rec rev_map_append l1 l2 f = + match l1 with + | [] -> l2 + | a :: l -> rev_map_append l (f a :: l2) f + + +let rec rev_append l1 l2 = + match l1 with + [] -> l2 + | a :: l -> rev_append l (a :: l2) + +(** It is not worth loop unrolling, + it is already tail-call, and we need to be careful + about evaluation order when unroll +*) +let rec flat_map_aux f acc append lx = + match lx with + | [] -> rev_append acc append + | a0::rest -> flat_map_aux f (rev_append (f a0) acc ) append rest + +let flat_map lx f = + flat_map_aux f [] [] lx + +let flat_map_append lx append f = + flat_map_aux f [] append lx + + +let rec length_compare l n = + if n < 0 then `Gt + else + begin match l with + | _ ::xs -> length_compare xs (n - 1) + | [] -> + if n = 0 then `Eq + else `Lt + end + +let rec length_ge l n = + if n > 0 then + match l with + | _ :: tl -> length_ge tl (n - 1) + | [] -> false + else true +(** + + {[length xs = length ys + n ]} +*) +let rec length_larger_than_n xs ys n = + match xs, ys with + | _, [] -> length_compare xs n = `Eq + | _::xs, _::ys -> + length_larger_than_n xs ys n + | [], _ -> false + + + + +let rec group (eq : 'a -> 'a -> bool) lst = + match lst with + | [] -> [] + | x::xs -> + aux eq x (group eq xs ) + +and aux eq (x : 'a) (xss : 'a list list) : 'a list list = + match xss with + | [] -> [[x]] + | (y0::_ as y)::ys -> (* cannot be empty *) + if eq x y0 then + (x::y) :: ys + else + y :: aux eq x ys + | _ :: _ -> assert false + +let stable_group lst eq = group eq lst |> List.rev + +let rec drop h n = + if n < 0 then invalid_arg "Ext_list.drop" + else + if n = 0 then h + else + match h with + | [] -> + invalid_arg "Ext_list.drop" + | _ :: tl -> + drop tl (n - 1) + +let rec find_first x p = + match x with + | [] -> None + | x :: l -> + if p x then Some x + else find_first l p + +let rec find_first_not xs p = + match xs with + | [] -> None + | a::l -> + if p a + then find_first_not l p + else Some a + + +let rec rev_iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x2 ; f x1 + | [x1; x2; x3] -> + f x3 ; f x2 ; f x1 + | [x1; x2; x3; x4] -> + f x4; f x3; f x2; f x1 + | x1::x2::x3::x4::x5::tail -> + rev_iter tail f; + f x5; f x4 ; f x3; f x2 ; f x1 + +let rec iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x1 ; f x2 + | [x1; x2; x3] -> + f x1 ; f x2 ; f x3 + | [x1; x2; x3; x4] -> + f x1; f x2; f x3; f x4 + | x1::x2::x3::x4::x5::tail -> + f x1; f x2 ; f x3; f x4 ; f x5; + iter tail f + + +let rec for_all lst p = + match lst with + [] -> true + | a::l -> p a && for_all l p + +let rec for_all_snd lst p = + match lst with + [] -> true + | (_,a)::l -> p a && for_all_snd l p + + +let rec for_all2_no_exn l1 l2 p = + match (l1, l2) with + | ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_no_exn l1 l2 p + | (_, _) -> false + + +let rec find_opt xs p = + match xs with + | [] -> None + | x :: l -> + match p x with + | Some _ as v -> v + | None -> find_opt l p + + + +let rec split_map l f = + match l with + | [] -> + [],[] + | [x1] -> + let a0,b0 = f x1 in + [a0],[b0] + | [x1; x2] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + [a1;a2],[b1;b2] + | [x1; x2; x3] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + [a1;a2;a3], [b1;b2;b3] + | [x1; x2; x3; x4] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + [a1;a2;a3;a4], [b1;b2;b3;b4] + | x1::x2::x3::x4::x5::tail -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + let a5,b5 = f x5 in + let ass,bss = split_map tail f in + a1::a2::a3::a4::a5::ass, + b1::b2::b3::b4::b5::bss + + + + +let sort_via_array lst cmp = + let arr = Array.of_list lst in + Array.sort cmp arr; + Array.to_list arr + + + + +let rec assoc_by_string lst (k : string) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if Ext_string.equal k1 k then v1 else + assoc_by_string rest k def + +let rec assoc_by_int lst (k : int) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if k1 = k then v1 else + assoc_by_int rest k def + + +let rec nth_aux l n = + match l with + | [] -> None + | a::l -> if n = 0 then Some a else nth_aux l (n-1) + +let nth_opt l n = + if n < 0 then None + else + nth_aux l n + +let rec iter_snd lst f = + match lst with + | [] -> () + | (_,x)::xs -> + f x ; + iter_snd xs f + +let rec iter_fst lst f = + match lst with + | [] -> () + | (x,_)::xs -> + f x ; + iter_fst xs f + +let rec exists l p = + match l with + [] -> false + | x :: xs -> p x || exists xs p + +let rec exists_snd l p = + match l with + [] -> false + | (_, a)::l -> p a || exists_snd l p + +let rec concat_append + (xss : 'a list list) + (xs : 'a list) : 'a list = + match xss with + | [] -> xs + | l::r -> append l (concat_append r xs) + +let rec fold_left l accu f = + match l with + [] -> accu + | a::l -> fold_left l (f accu a) f + +let reduce_from_left lst fn = + match lst with + | first :: rest -> fold_left rest first fn + | _ -> invalid_arg "Ext_list.reduce_from_left" + +let rec fold_left2 l1 l2 accu f = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> fold_left2 l1 l2 (f a1 a2 accu) f + | (_, _) -> invalid_arg "List.fold_left2" + +let singleton_exn xs = match xs with [x] -> x | _ -> assert false + + +end +module Map_gen += struct +#1 "map_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. *) +(* *) +(***********************************************************************) +(** adapted from stdlib *) + +type ('key,'a) t = + | Empty + | Node of ('key,'a) t * 'key * 'a * ('key,'a) t * int + +type ('key,'a) enumeration = + | End + | More of 'key * 'a * ('key,'a) t * ('key, 'a) enumeration + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec bindings_aux accu = function + | Empty -> accu + | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l + +let bindings s = + bindings_aux [] s + + +let rec fill_array_aux (s : _ t) i arr : int = + match s with + | Empty -> i + | Node (l,k,v,r,_) -> + let inext = fill_array_aux l i arr in + Array.unsafe_set arr inext (k,v); + fill_array_aux r (inext + 1) arr + +let to_sorted_array (s : ('key,'a) t) : ('key * 'a ) array = + match s with + | Empty -> [||] + | Node(l,k,v,r,_) -> + let len = + cardinal_aux (cardinal_aux 1 r) l in + let arr = + Array.make len (k,v) in + ignore (fill_array_aux s 0 arr : int); + arr +let rec keys_aux accu = function + Empty -> accu + | Node(l, v, _, r, _) -> keys_aux (v :: keys_aux accu r) l + +let keys s = keys_aux [] s + + + +let rec cons_enum m e = + match m with + Empty -> e + | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e)) + + +let height = function + | Empty -> 0 + | Node(_,_,_,_,h) -> h + +let create l x d r = + let hl = height l and hr = height r in + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let singleton x d = Node(Empty, x, d, Empty, 1) + +let bal l x d r = + let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> invalid_arg "Map.bal" + | Node(ll, lv, ld, lr, _) -> + if height ll >= height lr then + create ll lv ld (create lr x d r) + else begin + match lr with + Empty -> invalid_arg "Map.bal" + | Node(lrl, lrv, lrd, lrr, _)-> + create (create ll lv ld lrl) lrv lrd (create lrr x d r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> invalid_arg "Map.bal" + | Node(rl, rv, rd, rr, _) -> + if height rr >= height rl then + create (create l x d rl) rv rd rr + else begin + match rl with + Empty -> invalid_arg "Map.bal" + | Node(rll, rlv, rld, rlr, _) -> + create (create l x d rll) rlv rld (create rlr rv rd rr) + end + end else + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec min_binding_exn = function + Empty -> raise Not_found + | Node(Empty, x, d, r, _) -> (x, d) + | Node(l, x, d, r, _) -> min_binding_exn l + +let choose = min_binding_exn + +let rec max_binding_exn = function + Empty -> raise Not_found + | Node(l, x, d, Empty, _) -> (x, d) + | Node(l, x, d, r, _) -> max_binding_exn r + +let rec remove_min_binding = function + Empty -> invalid_arg "Map.remove_min_elt" + | Node(Empty, x, d, r, _) -> r + | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r + +let merge t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + bal t1 x d (remove_min_binding t2) + + +let rec iter x f = match x with + Empty -> () + | Node(l, v, d, r, _) -> + iter l f; f v d; iter r f + +let rec map x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = map l f in + let d' = f d in + let r' = map r f in + Node(l', v, d', r', h) + +let rec mapi x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = mapi l f in + let d' = f v d in + let r' = mapi r f in + Node(l', v, d', r', h) + +let rec fold m accu f = + match m with + Empty -> accu + | Node(l, v, d, r, _) -> + fold r (f v d (fold l accu f)) f + +let rec for_all x p = match x with + Empty -> true + | Node(l, v, d, r, _) -> p v d && for_all l p && for_all r p + +let rec exists x p = match x with + Empty -> false + | Node(l, v, d, r, _) -> p v d || exists l p || exists r p + +(* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal (add_min_binding k v l) x d r + +let rec add_max_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal l x d (add_max_binding k v r) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v d r = + match (l, r) with + (Empty, _) -> add_min_binding v d r + | (_, Empty) -> add_max_binding v d l + | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) -> + if lh > rh + 2 then bal ll lv ld (join lr v d r) else + if rh > lh + 2 then bal (join l v d rl) rv rd rr else + create l v d r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + join t1 x d (remove_min_binding t2) + +let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + +let rec filter x p = match x with + Empty -> Empty + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pvd = p v d in + let r' = filter r p in + if pvd then join l' v d r' else concat l' r' + +let rec partition x p = match x with + Empty -> (Empty, Empty) + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pvd = p v d in + let (rt, rf) = partition r p in + if pvd + then (join lt v d rt, concat lf rf) + else (concat lt rt, join lf v d rf) + +let compare compare_key cmp_val m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + let c = compare_key v1 v2 in + if c <> 0 then c else + let c = cmp_val d1 d2 in + if c <> 0 then c else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in compare_aux (cons_enum m1 End) (cons_enum m2 End) + +let equal compare_key cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + compare_key v1 v2 = 0 && cmp d1 d2 && + equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in equal_aux (cons_enum m1 End) (cons_enum m2 End) + + + + +module type S = + sig + type key + type +'a t + val empty: 'a t + val compare_key: key -> key -> int + val is_empty: 'a t -> bool + val mem: 'a t -> key -> bool + val to_sorted_array : + 'a t -> (key * 'a ) array + val add: 'a t -> key -> 'a -> 'a t + (** [add x y m] + If [x] was already bound in [m], its previous binding disappears. *) + val adjust: 'a t -> key -> ('a option-> 'a) -> 'a t + (** [adjust acc k replace ] if not exist [add (replace None ], otherwise + [add k v (replace (Some old))] + *) + val singleton: key -> 'a -> 'a t + + val remove: 'a t -> key -> 'a t + (** [remove x m] returns a map containing the same bindings as + [m], except for [x] which is unbound in the returned map. *) + + val merge: + 'a t -> 'b t -> + (key -> 'a option -> 'b option -> 'c option) -> 'c t + (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + and of [m2]. The presence of each such binding, and the corresponding + value, is determined with the function [f]. + @since 3.12.0 + *) + + val disjoint_merge : 'a t -> 'a t -> 'a t + (* merge two maps, will raise if they have the same key *) + val compare: 'a t -> 'a t -> ('a -> 'a -> int) -> int + (** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. *) + + val equal: 'a t -> 'a t -> ('a -> 'a -> bool) -> bool + + val iter: 'a t -> (key -> 'a -> unit) -> unit + (** [iter f m] applies [f] to all bindings in map [m]. + The bindings are passed to [f] in increasing order. *) + + val fold: 'a t -> 'b -> (key -> 'a -> 'b -> 'b) -> 'b + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1 ... kN] are the keys of all bindings in [m] + (in increasing order) *) + + val for_all: 'a t -> (key -> 'a -> bool) -> bool + (** [for_all p m] checks if all the bindings of the map. + order unspecified + *) + + val exists: 'a t -> (key -> 'a -> bool) -> bool + (** [exists p m] checks if at least one binding of the map + satisfy the predicate [p]. + order unspecified + *) + + val filter: 'a t -> (key -> 'a -> bool) -> 'a t + (** [filter p m] returns the map with all the bindings in [m] + that satisfy predicate [p]. + order unspecified + *) + + val partition: 'a t -> (key -> 'a -> bool) -> 'a t * 'a t + (** [partition p m] returns a pair of maps [(m1, m2)], where + [m1] contains all the bindings of [s] that satisfy the + predicate [p], and [m2] is the map with all the bindings of + [s] that do not satisfy [p]. + *) + + val cardinal: 'a t -> int + (** Return the number of bindings of a map. *) + + val bindings: 'a t -> (key * 'a) list + (** Return the list of all bindings of the given map. + The returned list is sorted in increasing order with respect + to the ordering *) + val keys : 'a t -> key list + (* Increasing order *) + + val min_binding_exn: 'a t -> (key * 'a) + (** raise [Not_found] if the map is empty. *) + + val max_binding_exn: 'a t -> (key * 'a) + (** Same as {!Map.S.min_binding} *) + + val choose: 'a t -> (key * 'a) + (** Return one binding of the given map, or raise [Not_found] if + the map is empty. Which binding is chosen is unspecified, + but equal bindings will be chosen for equal maps. + *) + + val split: 'a t -> key -> 'a t * 'a option * 'a t + (** [split x m] returns a triple [(l, data, r)], where + [l] is the map with all the bindings of [m] whose key + is strictly less than [x]; + [r] is the map with all the bindings of [m] whose key + is strictly greater than [x]; + [data] is [None] if [m] contains no binding for [x], + or [Some v] if [m] binds [v] to [x]. + @since 3.12.0 + *) + + val find_exn: 'a t -> key -> 'a + (** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. *) + val find_opt: 'a t -> key ->'a option + val find_default: 'a t -> key -> 'a -> 'a + val map: 'a t -> ('a -> 'b) -> 'b t + (** [map f m] returns a map with same domain as [m], where the + associated value [a] of all bindings of [m] has been + replaced by the result of the application of [f] to [a]. + The bindings are passed to [f] in increasing order + with respect to the ordering over the type of the keys. *) + + val mapi: 'a t -> (key -> 'a -> 'b) -> 'b t + (** Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. *) + + val of_list : (key * 'a) list -> 'a t + val of_array : (key * 'a ) array -> 'a t + val add_list : (key * 'b) list -> 'b t -> 'b t + + end + +end +module String_map : sig +#1 "string_map.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 Map_gen.S with type key = string + +end = struct +#1 "string_map.ml" + +# 2 "ext/map.cppo.ml" +(* we don't create [map_poly], since some operations require raise an exception which carries [key] *) + + + +# 10 "ext/map.cppo.ml" + type key = string + let compare_key = Ext_string.compare + +# 22 "ext/map.cppo.ml" +type 'a t = (key,'a) Map_gen.t +exception Duplicate_key of key + +let empty = Map_gen.empty +let is_empty = Map_gen.is_empty +let iter = Map_gen.iter +let fold = Map_gen.fold +let for_all = Map_gen.for_all +let exists = Map_gen.exists +let singleton = Map_gen.singleton +let cardinal = Map_gen.cardinal +let bindings = Map_gen.bindings +let to_sorted_array = Map_gen.to_sorted_array +let keys = Map_gen.keys +let choose = Map_gen.choose +let partition = Map_gen.partition +let filter = Map_gen.filter +let map = Map_gen.map +let mapi = Map_gen.mapi +let bal = Map_gen.bal +let height = Map_gen.height +let max_binding_exn = Map_gen.max_binding_exn +let min_binding_exn = Map_gen.min_binding_exn + + +let rec add (tree : _ Map_gen.t as 'a) x data : 'a = match tree with + | Empty -> + Node(Empty, x, data, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, data, r, h) + else if c < 0 then + bal (add l x data ) v d r + else + bal l v d (add r x data ) + + +let rec adjust (tree : _ Map_gen.t as 'a) x replace : 'a = + match tree with + | Empty -> + Node(Empty, x, replace None, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, replace (Some d) , r, h) + else if c < 0 then + bal (adjust l x replace ) v d r + else + bal l v d (adjust r x replace ) + + +let rec find_exn (tree : _ Map_gen.t ) x = match tree with + | Empty -> + raise Not_found + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_exn (if c < 0 then l else r) x + +let rec find_opt (tree : _ Map_gen.t ) x = match tree with + | Empty -> None + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then Some d + else find_opt (if c < 0 then l else r) x + +let rec find_default (tree : _ Map_gen.t ) x default = match tree with + | Empty -> default + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_default (if c < 0 then l else r) x default + +let rec mem (tree : _ Map_gen.t ) x= match tree with + | Empty -> + false + | Node(l, v, d, r, _) -> + let c = compare_key x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : _ Map_gen.t as 'a) x : 'a = match tree with + | Empty -> + Empty + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Map_gen.merge l r + else if c < 0 then + bal (remove l x) v d r + else + bal l v d (remove r x ) + + +let rec split (tree : _ Map_gen.t as 'a) x : 'a * _ option * 'a = match tree with + | Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Map_gen.join rl v d r) + else + let (lr, pres, rr) = split r x in (Map_gen.join l v d lr, pres, rr) + +let rec merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) f : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split s2 v1 in + Map_gen.concat_or_join (merge l1 l2 f) v1 (f v1 (Some d1) d2) (merge r1 r2 f) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split s1 v2 in + Map_gen.concat_or_join (merge l1 l2 f) v2 (f v2 d1 (Some d2)) (merge r1 r2 f) + | _ -> + assert false + +let rec disjoint_merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + begin match split s2 v1 with + | l2, None, r2 -> + Map_gen.join (disjoint_merge l1 l2) v1 d1 (disjoint_merge r1 r2) + | _, Some _, _ -> + raise (Duplicate_key v1) + end + | (_, Node (l2, v2, d2, r2, h2)) -> + begin match split s1 v2 with + | (l1, None, r1) -> + Map_gen.join (disjoint_merge l1 l2) v2 d2 (disjoint_merge r1 r2) + | (_, Some _, _) -> + raise (Duplicate_key v2) + end + | _ -> + assert false + + + +let compare m1 m2 cmp = Map_gen.compare compare_key cmp m1 m2 + +let equal m1 m2 cmp = Map_gen.equal compare_key cmp m1 m2 + +let add_list (xs : _ list ) init = + Ext_list.fold_left xs init (fun acc (k,v) -> add acc k v ) + +let of_list xs = add_list xs empty + +let of_array xs = + Ext_array.fold_left xs empty (fun acc (k,v) -> add acc k v ) + +end +module Ext_json_types += struct +#1 "ext_json_types.ml" +(* Copyright (C) 2015-2017 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. *) + +type loc = Lexing.position +type json_str = + { str : string ; loc : loc} + +type json_flo = + { flo : string ; loc : loc} +type json_array = + { content : t array ; + loc_start : loc ; + loc_end : loc ; + } + +and json_map = + { map : t String_map.t ; loc : loc } +and t = + | True of loc + | False of loc + | Null of loc + | Flo of json_flo + | Str of json_str + | Arr of json_array + | Obj of json_map + + +end +module Ext_position : sig +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +(** [offset pos newpos] + return a new position + here [newpos] is zero based, the use case is that + at position [pos], we get a string and Lexing from that string, + therefore, we get a [newpos] and we need rebase it on top of + [pos] +*) +val offset : t -> t -> t + +val lexbuf_from_channel_with_fname: + in_channel -> string -> + Lexing.lexbuf + +val print : Format.formatter -> t -> unit +end = struct +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +let offset (x : t) (y:t) = + { + x with + pos_lnum = + x.pos_lnum + y.pos_lnum - 1; + pos_cnum = + x.pos_cnum + y.pos_cnum; + pos_bol = + if y.pos_lnum = 1 then + x.pos_bol + else x.pos_cnum + y.pos_bol + } + +let print fmt (pos : t) = + Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) + + + +let lexbuf_from_channel_with_fname ic fname = + let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in + let pos : t = { + pos_fname = fname ; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0 (* copied from zero_pos*) + } in + x.lex_start_p <- pos; + x.lex_curr_p <- pos ; + x + + +end +module Ext_json : sig +#1 "ext_json.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. *) + + +type path = string list +type status = + | No_path + | Found of Ext_json_types.t + | Wrong_type of path + + +type callback = + [ + `Str of (string -> unit) + | `Str_loc of (string -> Lexing.position -> unit) + | `Flo of (string -> unit ) + | `Flo_loc of (string -> Lexing.position -> unit ) + | `Bool of (bool -> unit ) + | `Obj of (Ext_json_types.t String_map.t -> unit) + | `Arr of (Ext_json_types.t array -> unit ) + | `Arr_loc of + (Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit) + | `Null of (unit -> unit) + | `Not_found of (unit -> unit) + | `Id of (Ext_json_types.t -> unit ) + ] + +val test: + ?fail:(unit -> unit) -> + string -> callback + -> Ext_json_types.t String_map.t + -> Ext_json_types.t String_map.t + +val query : path -> Ext_json_types.t -> status + +val loc_of : Ext_json_types.t -> Ext_position.t + +val equal : Ext_json_types.t -> Ext_json_types.t -> bool + +end = struct +#1 "ext_json.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. *) + +type callback = + [ + `Str of (string -> unit) + | `Str_loc of (string -> Lexing.position -> unit) + | `Flo of (string -> unit ) + | `Flo_loc of (string -> Lexing.position -> unit ) + | `Bool of (bool -> unit ) + | `Obj of (Ext_json_types.t String_map.t -> unit) + | `Arr of (Ext_json_types.t array -> unit ) + | `Arr_loc of (Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit) + | `Null of (unit -> unit) + | `Not_found of (unit -> unit) + | `Id of (Ext_json_types.t -> unit ) + ] + + +type path = string list + +type status = + | No_path + | Found of Ext_json_types.t + | Wrong_type of path + +let test ?(fail=(fun () -> ())) key + (cb : callback) (m : Ext_json_types.t String_map.t) + = + begin match String_map.find_exn m key, cb with + | exception Not_found -> + begin match cb with `Not_found f -> f () + | _ -> fail () + end + | True _, `Bool cb -> cb true + | False _, `Bool cb -> cb false + | Flo {flo = s} , `Flo cb -> cb s + | Flo {flo = s; loc} , `Flo_loc cb -> cb s loc + | Obj {map = b} , `Obj cb -> cb b + | Arr {content}, `Arr cb -> cb content + | Arr {content; loc_start ; loc_end}, `Arr_loc cb -> + cb content loc_start loc_end + | Null _, `Null cb -> cb () + | Str {str = s }, `Str cb -> cb s + | Str {str = s ; loc }, `Str_loc cb -> cb s loc + | any , `Id cb -> cb any + | _, _ -> fail () + end; + m +let query path (json : Ext_json_types.t ) = + let rec aux acc paths json = + match path with + | [] -> Found json + | p :: rest -> + match json with + | Obj {map } -> + (match String_map.find_opt map p with + | Some m -> aux (p::acc) rest m + | None -> No_path) + | _ -> Wrong_type acc + in aux [] path json + + +let loc_of (x : Ext_json_types.t) = + match x with + | True p | False p | Null p -> p + | Str p -> p.loc + | Arr p -> p.loc_start + | Obj p -> p.loc + | Flo p -> p.loc + + +let rec equal + (x : Ext_json_types.t) + (y : Ext_json_types.t) = + match x with + | Null _ -> (* [%p? Null _ ] *) + begin match y with + | Null _ -> true + | _ -> false end + | Str {str } -> + begin match y with + | Str {str = str2} -> str = str2 + | _ -> false end + | Flo {flo} + -> + begin match y with + | Flo {flo = flo2} -> + flo = flo2 + | _ -> false + end + | True _ -> + begin match y with + | True _ -> true + | _ -> false + end + | False _ -> + begin match y with + | False _ -> true + | _ -> false + end + | Arr {content} + -> + begin match y with + | Arr {content = content2} + -> + Ext_array.for_all2_no_exn content content2 equal + | _ -> false + end + + | Obj {map} -> + begin match y with + | Obj { map = map2} -> + String_map.equal map map2 equal + | _ -> false + end + + +end +module Bsb_exception : sig +#1 "bsb_exception.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. *) + + +(** + This module is used for fatal errros +*) +type error +exception Error of error + +val print : Format.formatter -> error -> unit +val package_not_found : pkg:Bsb_pkg_types.t -> json:string option -> 'a + +val conflict_module: + string -> string -> string -> 'a + +val errorf : loc:Ext_position.t -> ('a, unit, string, 'b) format4 -> 'a + +val config_error : Ext_json_types.t -> string -> 'a + +val invalid_spec : string -> 'a + +val invalid_json : string -> 'a +end = struct +#1 "bsb_exception.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. *) + + + +type error = + | Package_not_found of Bsb_pkg_types.t * string option (* json file *) + | Json_config of Ext_position.t * string + | Invalid_json of string + | Invalid_spec of string + | Conflict_module of string * string * string + + +exception Error of error + +let error err = raise (Error err) +let package_not_found ~pkg ~json = + error (Package_not_found(pkg,json)) + +let print (fmt : Format.formatter) (x : error) = + match x with + | Conflict_module (modname,dir1,dir2) -> + Format.fprintf fmt + "@{Error:@} %s found in two directories: (%s, %s)\n\ + File names must be unique per project" + modname dir1 dir2 + | Package_not_found (name,json_opt) -> + let in_json = match json_opt with + | None -> Ext_string.empty + | Some x -> " in " ^ x in + let name = Bsb_pkg_types.to_string name in + if Ext_string.equal name Bs_version.package_name then + Format.fprintf fmt + "File \"bsconfig.json\", line 1\n\ + @{Error:@} package @{bs-platform@} is not found %s\n\ + It's the basic, required package. If you have it installed globally,\n\ + Please run `npm link bs-platform` to make it available" in_json + else + Format.fprintf fmt + "File \"bsconfig.json\", line 1\n\ + @{Error:@} package @{%s@} not found or built %s\n\ + - Did you install it?\n\ + - If you did, did you run `bsb -make-world`?" + name + in_json + + | Json_config (pos,s) -> + Format.fprintf fmt "File \"bsconfig.json\", line %d:\n\ + @{Error:@} %s \n\ + For more details, please checkout the schema http://bucklescript.github.io/bucklescript/docson/#build-schema.json" + pos.pos_lnum s + | Invalid_spec s -> + Format.fprintf fmt + "@{Error: Invalid bsconfig.json%s@}" s + | Invalid_json s -> + Format.fprintf fmt + "File %S, line 1\n\ + @{Error: Invalid json format@}" s + +let conflict_module modname dir1 dir2 = + error (Conflict_module (modname,dir1,dir2)) +let errorf ~loc fmt = + Format.ksprintf (fun s -> error (Json_config (loc,s))) fmt + + +let config_error config fmt = + let loc = Ext_json.loc_of config in + + error (Json_config (loc,fmt)) + +let invalid_spec s = error (Invalid_spec s) + +let invalid_json s = error (Invalid_json s) + +let () = + Printexc.register_printer (fun x -> + match x with + | Error x -> + Some (Format.asprintf "%a" print x ) + | _ -> None + ) + +end +module Ext_color : sig +#1 "ext_color.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. *) + +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + +type style + = FG of color + | BG of color + | Bold + | Dim + +(** Input is the tag for example `@{@}` return escape code *) +val ansi_of_tag : string -> string + +val reset_lit : string + +end = struct +#1 "ext_color.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. *) + + + + +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + +type style + = FG of color + | BG of color + | Bold + | Dim + + +let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" + +let code_of_style = function + | FG Black -> "30" + | FG Red -> "31" + | FG Green -> "32" + | FG Yellow -> "33" + | FG Blue -> "34" + | FG Magenta -> "35" + | FG Cyan -> "36" + | FG White -> "37" + + | BG Black -> "40" + | BG Red -> "41" + | BG Green -> "42" + | BG Yellow -> "43" + | BG Blue -> "44" + | BG Magenta -> "45" + | BG Cyan -> "46" + | BG White -> "47" + + | Bold -> "1" + | Dim -> "2" + + + +(** TODO: add more styles later *) +let style_of_tag s = match s with + | "error" -> [Bold; FG Red] + | "warning" -> [Bold; FG Magenta] + | "info" -> [Bold; FG Yellow] + | "dim" -> [Dim] + | "filename" -> [FG Cyan] + | _ -> [] + +let ansi_of_tag s = + let l = style_of_tag s in + let s = String.concat ";" (Ext_list.map l code_of_style) in + "\x1b[" ^ s ^ "m" + + + +let reset_lit = "\x1b[0m" + + + + + +end +module Bsb_log : sig +#1 "bsb_log.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 setup : unit -> unit + +type 'a fmt = Format.formatter -> ('a, Format.formatter, unit) format -> 'a + +type 'a log = ('a, Format.formatter, unit) format -> 'a + +val verbose : unit -> unit +val debug : 'a log +val info : 'a log +val warn : 'a log +val error : 'a log + +val info_args : string array -> unit +end = struct +#1 "bsb_log.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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 ninja_ansi_forced = lazy + (try Sys.getenv "NINJA_ANSI_FORCED" with + Not_found ->"" + ) +let color_enabled = lazy (Unix.isatty Unix.stdout) + +(* same logic as [ninja.exe] *) +let get_color_enabled () = + let colorful = + match ninja_ansi_forced with + | lazy "1" -> true + | lazy ("0" | "false") -> false + | _ -> + Lazy.force color_enabled in + colorful + + + +let color_functions : Format.formatter_tag_functions = { + mark_open_tag = (fun s -> if get_color_enabled () then Ext_color.ansi_of_tag s else Ext_string.empty) ; + mark_close_tag = (fun _ -> if get_color_enabled () then Ext_color.reset_lit else Ext_string.empty); + print_open_tag = (fun _ -> ()); + print_close_tag = (fun _ -> ()) +} + +let set_color ppf = + Format.pp_set_formatter_tag_functions ppf color_functions + + +let setup () = + begin + Format.pp_set_mark_tags Format.std_formatter true ; + Format.pp_set_mark_tags Format.err_formatter true; + Format.pp_set_formatter_tag_functions + Format.std_formatter color_functions; + Format.pp_set_formatter_tag_functions + Format.err_formatter color_functions + end + +type level = + | Debug + | Info + | Warn + | Error + +let int_of_level (x : level) = + match x with + | Debug -> 0 + | Info -> 1 + | Warn -> 2 + | Error -> 3 + +let log_level = ref Warn + +let verbose () = + log_level := Debug +let dfprintf level fmt = + if int_of_level level >= int_of_level !log_level then + Format.fprintf fmt + else Format.ifprintf fmt + +type 'a fmt = + Format.formatter -> ('a, Format.formatter, unit) format -> 'a +type 'a log = + ('a, Format.formatter, unit) format -> 'a + +let debug fmt = dfprintf Debug Format.std_formatter fmt +let info fmt = dfprintf Info Format.std_formatter fmt +let warn fmt = dfprintf Warn Format.err_formatter fmt +let error fmt = dfprintf Error Format.err_formatter fmt + + +let info_args (args : string array) = + if int_of_level Info >= int_of_level !log_level then + begin + for i = 0 to Array.length args - 1 do + Format.pp_print_string Format.std_formatter (Array.unsafe_get args i) ; + Format.pp_print_string Format.std_formatter Ext_string.single_space; + done ; + Format.pp_print_newline Format.std_formatter () + end + else () + + +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 + + (** return the key found in the hashtbl. + Use case: when you find the key existed in hashtbl, + you want to use the one stored in the hashtbl. + (they are semantically equivlanent, but may have other information different) + *) + val find_key_opt: 'a t -> key -> key option + + val find_default: 'a t -> key -> 'a -> 'a + + val replace: 'a t -> key -> 'a -> unit + val mem: 'a t -> key -> bool + val iter: 'a t -> (key -> 'a -> unit) -> 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 h f = + 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 = + Ext_array.fold_left h.data 0 (fun m b -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + {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_key_opt eq key (lst : _ bucketlist) : _ option = + match lst with + | Empty -> None + | Cons(k1,d1,rest1) -> + if eq key k1 then Some k1 else + match rest1 with + | Empty -> None + | Cons(k2,d2,rest2) -> + if eq key k2 then Some k2 else + match rest2 with + | Empty -> None + | Cons(k3,d3,rest3) -> + if eq key k3 then Some k3 else + small_bucket_key_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 Hashtbl_make : sig +#1 "hashtbl_make.mli" + + +module Make (Key : Hashtbl.HashedType) : Hashtbl_gen.S with type key = Key.t + +end = 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 "ext/hashtbl.cppo.ml" +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 h_data = h.data in + Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); + 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 + let h_data = h.data in + if find_bucket (Array.unsafe_get h_data i) then + begin + Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get 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 rec remove_bucket key (h : _ t) (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 key h next) + +let remove (h : _ t ) key = + let i = key_index h key in + let h_data = h.data in + let old_h_szie = h.size in + let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in + if old_h_szie <> h.size then + Array.unsafe_set h_data i new_bucket + +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 Array.unsafe_get 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_key_opt (h : _ t) key = + Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in + let l = Array.unsafe_get h_data i in + try + Array.unsafe_set h_data i (replace_bucket l) + with Not_found -> + begin + Array.unsafe_set 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; + end + +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 (Array.unsafe_get h.data (key_index h key)) + + +let of_list2 ks vs = + let len = List.length ks in + let map = create len in + List.iter2 (fun k v -> add map k v) ks vs ; + map + +# 161 "ext/hashtbl.cppo.ml" +end + +end +module Literals : sig +#1 "literals.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 js_array_ctor : string +val js_type_number : string +val js_type_string : string +val js_type_object : string +val js_type_boolean : string +val js_undefined : string +val js_prop_length : string + +val param : string +val partial_arg : string +val prim : string + +(**temporary varaible used in {!Js_ast_util} *) +val tmp : string + +val create : string +val runtime : string +val stdlib : string +val imul : string + +val setter_suffix : string +val setter_suffix_len : int + + +val debugger : string +val raw_expr : string +val raw_stmt : string +val raw_function : string +val unsafe_downgrade : string +val fn_run : string +val method_run : string +val fn_method : string +val fn_mk : string + +(** callback actually, not exposed to user yet *) +(* val js_fn_runmethod : string *) + +val bs_deriving : string +val bs_deriving_dot : string +val bs_type : string + +(** nodejs *) + +val node_modules : string +val node_modules_length : int +val package_json : string +val bsconfig_json : string +val build_ninja : string + +(* Name of the library file created for each external dependency. *) +val library_file : string + +val suffix_a : string +val suffix_cmj : string +val suffix_cmo : string +val suffix_cma : string +val suffix_cmi : string +val suffix_cmx : string +val suffix_cmxa : string +val suffix_ml : string +val suffix_mlast : string +val suffix_mlast_simple : string +val suffix_mliast : string +val suffix_mliast_simple : string +val suffix_mlmap : string +val suffix_mll : string +val suffix_re : string +val suffix_rei : string + +val suffix_d : string +val suffix_js : string +val suffix_bs_js : string +(* val suffix_re_js : string *) +val suffix_gen_js : string +val suffix_gen_tsx: string + +val suffix_tsx : string +val suffix_mlastd : string +val suffix_mliastd : string + +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string + +val commonjs : string +val amdjs : string +val es6 : string +val es6_global : string +val amdjs_global : string +val unused_attribute : string +val dash_nostdlib : string + +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string + +val native : string +val bytecode : string +val js : string + +val node_sep : string +val node_parent : string +val node_current : string +val gentype_import : string +end = struct +#1 "literals.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 js_array_ctor = "Array" +let js_type_number = "number" +let js_type_string = "string" +let js_type_object = "object" +let js_type_boolean = "boolean" +let js_undefined = "undefined" +let js_prop_length = "length" + +let prim = "prim" +let param = "param" +let partial_arg = "partial_arg" +let tmp = "tmp" + +let create = "create" (* {!Caml_exceptions.create}*) + +let runtime = "runtime" (* runtime directory *) + +let stdlib = "stdlib" + +let imul = "imul" (* signed int32 mul *) + +let setter_suffix = "#=" +let setter_suffix_len = String.length setter_suffix + +let debugger = "debugger" +let raw_expr = "raw_expr" +let raw_stmt = "raw_stmt" +let raw_function = "raw_function" +let unsafe_downgrade = "unsafe_downgrade" +let fn_run = "fn_run" +let method_run = "method_run" + +let fn_method = "fn_method" +let fn_mk = "fn_mk" +(*let js_fn_runmethod = "js_fn_runmethod"*) + +let bs_deriving = "bs.deriving" +let bs_deriving_dot = "bs.deriving." +let bs_type = "bs.type" + + +(** nodejs *) +let node_modules = "node_modules" +let node_modules_length = String.length "node_modules" +let package_json = "package.json" +let bsconfig_json = "bsconfig.json" +let build_ninja = "build.ninja" + +(* Name of the library file created for each external dependency. *) +let library_file = "lib" + +let suffix_a = ".a" +let suffix_cmj = ".cmj" +let suffix_cmo = ".cmo" +let suffix_cma = ".cma" +let suffix_cmi = ".cmi" +let suffix_cmx = ".cmx" +let suffix_cmxa = ".cmxa" +let suffix_mll = ".mll" +let suffix_ml = ".ml" +let suffix_mli = ".mli" +let suffix_re = ".re" +let suffix_rei = ".rei" +let suffix_mlmap = ".mlmap" + +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" +let suffix_mlast = ".mlast" +let suffix_mlast_simple = ".mlast_simple" +let suffix_mliast = ".mliast" +let suffix_mliast_simple = ".mliast_simple" +let suffix_d = ".d" +let suffix_mlastd = ".mlast.d" +let suffix_mliastd = ".mliast.d" +let suffix_js = ".js" +let suffix_bs_js = ".bs.js" +(* let suffix_re_js = ".re.js" *) +let suffix_gen_js = ".gen.js" +let suffix_gen_tsx = ".gen.tsx" +let suffix_tsx = ".tsx" + +let commonjs = "commonjs" +let amdjs = "amdjs" +let es6 = "es6" +let es6_global = "es6-global" +let amdjs_global = "amdjs-global" +let unused_attribute = "Unused attribute " +let dash_nostdlib = "-nostdlib" + +let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" +let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" + +let native = "native" +let bytecode = "bytecode" +let js = "js" + + + +(** Used when produce node compatible paths *) +let node_sep = "/" +let node_parent = ".." +let node_current = "." + +let gentype_import = "genType.import" +end +module Bsb_pkg : sig +#1 "bsb_pkg.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. *) + + +(** [resolve cwd module_name], + [cwd] is current working directory, absolute path + Trying to find paths to load [module_name] + it is sepcialized for option [-bs-package-include] which requires + [npm_package_name/lib/ocaml] + + it relies on [npm_config_prefix] env variable for global npm modules +*) + +(** @raise when not found *) +val resolve_bs_package : + cwd:string -> Bsb_pkg_types.t -> string + + + +end = struct +#1 "bsb_pkg.ml" + +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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 (//) = Filename.concat + +type t = Bsb_pkg_types.t + +(* TODO: be more restrict + [bsconfig.json] does not always make sense, + when resolving [ppx-flags] +*) +let make_sub_path (x : t) : string = + Literals.node_modules // Bsb_pkg_types.to_string x + + +(** It makes sense to have this function raise, when [bsb] could not resolve a package, it used to mean + a failure +*) +let resolve_bs_package_aux ~cwd (pkg : t) = + let sub_path = make_sub_path pkg in + let rec aux cwd = + let abs_marker = cwd // sub_path in + if Sys.file_exists abs_marker then abs_marker + else + let another_cwd = Filename.dirname cwd in (* TODO: may non-terminating when see symlinks *) + if String.length another_cwd < String.length cwd then + aux another_cwd + else (* To the end try other possiblilities *) + begin match Sys.getenv "npm_config_prefix" + // "lib" // sub_path with + | abs_marker when Sys.file_exists abs_marker -> + abs_marker + | _ -> + Bsb_exception.package_not_found ~pkg ~json:None + | exception Not_found -> + Bsb_exception.package_not_found ~pkg ~json:None + end + in + aux cwd + +module Coll = Hashtbl_make.Make(struct + type nonrec t = t + let equal = Bsb_pkg_types.equal + let hash (x : t) = Hashtbl.hash x +end) +let cache : string Coll.t = Coll.create 0 + +(** TODO: collect all warnings and print later *) +let resolve_bs_package ~cwd (package : t) = + match Coll.find_opt cache package with + | None -> + let result = resolve_bs_package_aux ~cwd package in + Bsb_log.info "@{Package@} %a -> %s@." Bsb_pkg_types.print package result ; + Coll.add cache package result ; + result + | Some x + -> + let result = resolve_bs_package_aux ~cwd package in + if result <> x then + begin + Bsb_log.warn + "@{Duplicated package:@} %a %s (chosen) vs %s in %s @." + Bsb_pkg_types.print package x result cwd; + end; + x + + + + +(** The package does not need to be a bspackage + example: + {[ + resolve_npm_package_file ~cwd "reason/refmt";; + resolve_npm_package_file ~cwd "reason/refmt/xx/yy" + ]} + It also returns the path name + Note the input [sub_path] is already converted to physical meaning path according to OS +*) +(* let resolve_npm_package_file ~cwd sub_path = *) +(* let rec aux cwd = *) +(* let abs_marker = cwd // Literals.node_modules // sub_path in *) +(* if Sys.file_exists abs_marker then Some abs_marker *) +(* else *) +(* let cwd' = Filename.dirname cwd in *) +(* if String.length cwd' < String.length cwd then *) +(* aux cwd' *) +(* else *) +(* try *) +(* let abs_marker = *) +(* Sys.getenv "npm_config_prefix" *) +(* // "lib" // Literals.node_modules // sub_path in *) +(* if Sys.file_exists abs_marker *) +(* then Some abs_marker *) +(* else None *) +(* (\* Bs_exception.error (Bs_package_not_found name) *\) *) +(* with *) +(* Not_found -> None *) +(* (\* Bs_exception.error (Bs_package_not_found name) *\) *) +(* in *) +(* aux cwd *) + +end +module Ext_json_parse : sig +#1 "ext_json_parse.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. *) + +type error + +val report_error : Format.formatter -> error -> unit + +exception Error of Lexing.position * Lexing.position * error + +val parse_json_from_string : string -> Ext_json_types.t + +val parse_json_from_chan : + string -> in_channel -> Ext_json_types.t + +val parse_json_from_file : string -> Ext_json_types.t + + +end = struct +#1 "ext_json_parse.ml" +# 1 "ext/ext_json_parse.mll" + +type error = + | Illegal_character of char + | Unterminated_string + | Unterminated_comment + | Illegal_escape of string + | Unexpected_token + | Expect_comma_or_rbracket + | Expect_comma_or_rbrace + | Expect_colon + | Expect_string_or_rbrace + | Expect_eof + (* | Trailing_comma_in_obj *) + (* | Trailing_comma_in_array *) + + +let fprintf = Format.fprintf +let report_error ppf = function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_escape s -> + fprintf ppf "Illegal backslash escape in string or character (%s)" s + | Unterminated_string -> + fprintf ppf "Unterminated_string" + | Expect_comma_or_rbracket -> + fprintf ppf "Expect_comma_or_rbracket" + | Expect_comma_or_rbrace -> + fprintf ppf "Expect_comma_or_rbrace" + | Expect_colon -> + fprintf ppf "Expect_colon" + | Expect_string_or_rbrace -> + fprintf ppf "Expect_string_or_rbrace" + | Expect_eof -> + fprintf ppf "Expect_eof" + | Unexpected_token + -> + fprintf ppf "Unexpected_token" + (* | Trailing_comma_in_obj *) + (* -> fprintf ppf "Trailing_comma_in_obj" *) + (* | Trailing_comma_in_array *) + (* -> fprintf ppf "Trailing_comma_in_array" *) + | Unterminated_comment + -> fprintf ppf "Unterminated_comment" + + +exception Error of Lexing.position * Lexing.position * error + + +let () = + Printexc.register_printer + (function x -> + match x with + | Error (loc_start,loc_end,error) -> + Some (Format.asprintf + "@[%a:@ %a@ -@ %a)@]" + report_error error + Ext_position.print loc_start + Ext_position.print loc_end + ) + + | _ -> None + ) + + + + + +type token = + | Comma + | Eof + | False + | Lbrace + | Lbracket + | Null + | Colon + | Number of string + | Rbrace + | Rbracket + | String of string + | True + +let error (lexbuf : Lexing.lexbuf) e = + raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) + + +let lexeme_len (x : Lexing.lexbuf) = + x.lex_curr_pos - x.lex_start_pos + +let update_loc ({ lex_curr_p; _ } as lexbuf : Lexing.lexbuf) diff = + lexbuf.lex_curr_p <- + { + lex_curr_p with + pos_lnum = lex_curr_p.pos_lnum + 1; + pos_bol = lex_curr_p.pos_cnum - diff; + } + +let char_for_backslash = function + | 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + +let dec_code c1 c2 c3 = + 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) + +let hex_code c1 c2 = + let d1 = Char.code c1 in + let val1 = + if d1 >= 97 then d1 - 87 + else if d1 >= 65 then d1 - 55 + else d1 - 48 in + let d2 = Char.code c2 in + let val2 = + if d2 >= 97 then d2 - 87 + else if d2 >= 65 then d2 - 55 + else d2 - 48 in + val1 * 16 + val2 + +let lf = '\010' + +# 124 "ext/ext_json_parse.ml" +let __ocaml_lex_tables = { + Lexing.lex_base = + "\000\000\239\255\240\255\241\255\000\000\025\000\011\000\244\255\ + \245\255\246\255\247\255\248\255\249\255\000\000\000\000\000\000\ + \041\000\001\000\254\255\005\000\005\000\253\255\001\000\002\000\ + \252\255\000\000\000\000\003\000\251\255\001\000\003\000\250\255\ + \079\000\089\000\099\000\121\000\131\000\141\000\153\000\163\000\ + \001\000\253\255\254\255\023\000\255\255\006\000\246\255\189\000\ + \248\255\215\000\255\255\249\255\249\000\181\000\252\255\009\000\ + \063\000\075\000\234\000\251\255\032\001\250\255"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\255\255\013\000\013\000\016\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\ + \016\000\016\000\255\255\000\000\012\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\013\000\255\255\013\000\255\255\013\000\255\255\ + \255\255\255\255\255\255\001\000\255\255\255\255\255\255\008\000\ + \255\255\255\255\255\255\255\255\006\000\006\000\255\255\006\000\ + \001\000\002\000\255\255\255\255\255\255\255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\000\000\255\255\255\255\255\255\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\ + \255\255\255\255\000\000\255\255\020\000\000\000\255\255\255\255\ + \000\000\255\255\255\255\255\255\000\000\255\255\255\255\000\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \042\000\000\000\000\000\255\255\000\000\047\000\000\000\047\000\ + \000\000\051\000\000\000\000\000\255\255\255\255\000\000\255\255\ + \255\255\255\255\255\255\000\000\255\255\000\000"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\019\000\018\000\018\000\019\000\017\000\019\000\255\255\ + \048\000\019\000\255\255\057\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \019\000\000\000\003\000\000\000\000\000\019\000\000\000\000\000\ + \050\000\000\000\000\000\043\000\008\000\006\000\033\000\016\000\ + \004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\007\000\004\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\005\000\005\000\032\000\044\000\033\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\021\000\057\000\000\000\000\000\000\000\ + \020\000\000\000\000\000\012\000\000\000\011\000\032\000\056\000\ + \000\000\025\000\049\000\000\000\000\000\032\000\014\000\024\000\ + \028\000\000\000\000\000\057\000\026\000\030\000\013\000\031\000\ + \000\000\000\000\022\000\027\000\015\000\029\000\023\000\000\000\ + \000\000\000\000\039\000\010\000\039\000\009\000\032\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\ + \035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\255\255\ + \035\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\000\000\000\000\255\255\ + \000\000\056\000\000\000\000\000\055\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\054\000\ + \000\000\054\000\000\000\000\000\000\000\000\000\054\000\000\000\ + \002\000\041\000\000\000\000\000\000\000\255\255\046\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\ + \053\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\255\255\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\000\000\000\000\000\000\000\000\ + \000\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\054\000\000\000\000\000\000\000\000\000\ + \000\000\054\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\000\000\000\000\000\000\000\000\054\000\000\000\000\000\ + \000\000\054\000\000\000\054\000\000\000\000\000\000\000\052\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\017\000\000\000\000\000\019\000\020\000\ + \045\000\019\000\020\000\055\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \000\000\255\255\000\000\255\255\255\255\019\000\255\255\255\255\ + \045\000\255\255\255\255\040\000\000\000\000\000\004\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\ + \006\000\006\000\006\000\006\000\006\000\004\000\043\000\005\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\016\000\057\000\255\255\255\255\255\255\ + \016\000\255\255\255\255\000\000\255\255\000\000\005\000\056\000\ + \255\255\014\000\045\000\255\255\255\255\004\000\000\000\023\000\ + \027\000\255\255\255\255\057\000\025\000\029\000\000\000\030\000\ + \255\255\255\255\015\000\026\000\000\000\013\000\022\000\255\255\ + \255\255\255\255\032\000\000\000\032\000\000\000\005\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\035\000\255\255\035\000\255\255\ + \034\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\047\000\ + \034\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\039\000\039\000\039\000\039\000\039\000\ + \039\000\039\000\039\000\039\000\039\000\255\255\255\255\047\000\ + \255\255\049\000\255\255\255\255\049\000\053\000\053\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\049\000\255\255\255\255\255\255\255\255\049\000\255\255\ + \000\000\040\000\255\255\255\255\255\255\020\000\045\000\049\000\ + \049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\ + \049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\047\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\255\255\255\255\255\255\255\255\ + \255\255\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\049\000\255\255\255\255\255\255\255\255\ + \255\255\049\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\ + \255\255\049\000\255\255\049\000\255\255\255\255\255\255\049\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\047\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255"; + Lexing.lex_base_code = + ""; + Lexing.lex_backtrk_code = + ""; + Lexing.lex_default_code = + ""; + Lexing.lex_trans_code = + ""; + Lexing.lex_check_code = + ""; + Lexing.lex_code = + ""; +} + +let rec lex_json buf lexbuf = + __ocaml_lex_lex_json_rec buf lexbuf 0 +and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 142 "ext/ext_json_parse.mll" + ( lex_json buf lexbuf) +# 314 "ext/ext_json_parse.ml" + + | 1 -> +# 143 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + lex_json buf lexbuf + ) +# 322 "ext/ext_json_parse.ml" + + | 2 -> +# 147 "ext/ext_json_parse.mll" + ( comment buf lexbuf) +# 327 "ext/ext_json_parse.ml" + + | 3 -> +# 148 "ext/ext_json_parse.mll" + ( True) +# 332 "ext/ext_json_parse.ml" + + | 4 -> +# 149 "ext/ext_json_parse.mll" + (False) +# 337 "ext/ext_json_parse.ml" + + | 5 -> +# 150 "ext/ext_json_parse.mll" + (Null) +# 342 "ext/ext_json_parse.ml" + + | 6 -> +# 151 "ext/ext_json_parse.mll" + (Lbracket) +# 347 "ext/ext_json_parse.ml" + + | 7 -> +# 152 "ext/ext_json_parse.mll" + (Rbracket) +# 352 "ext/ext_json_parse.ml" + + | 8 -> +# 153 "ext/ext_json_parse.mll" + (Lbrace) +# 357 "ext/ext_json_parse.ml" + + | 9 -> +# 154 "ext/ext_json_parse.mll" + (Rbrace) +# 362 "ext/ext_json_parse.ml" + + | 10 -> +# 155 "ext/ext_json_parse.mll" + (Comma) +# 367 "ext/ext_json_parse.ml" + + | 11 -> +# 156 "ext/ext_json_parse.mll" + (Colon) +# 372 "ext/ext_json_parse.ml" + + | 12 -> +# 157 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 377 "ext/ext_json_parse.ml" + + | 13 -> +# 159 "ext/ext_json_parse.mll" + ( Number (Lexing.lexeme lexbuf)) +# 382 "ext/ext_json_parse.ml" + + | 14 -> +# 161 "ext/ext_json_parse.mll" + ( + let pos = Lexing.lexeme_start_p lexbuf in + scan_string buf pos lexbuf; + let content = (Buffer.contents buf) in + Buffer.clear buf ; + String content +) +# 393 "ext/ext_json_parse.ml" + + | 15 -> +# 168 "ext/ext_json_parse.mll" + (Eof ) +# 398 "ext/ext_json_parse.ml" + + | 16 -> +let +# 169 "ext/ext_json_parse.mll" + c +# 404 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in +# 169 "ext/ext_json_parse.mll" + ( error lexbuf (Illegal_character c )) +# 408 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state + +and comment buf lexbuf = + __ocaml_lex_comment_rec buf lexbuf 40 +and __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 171 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 420 "ext/ext_json_parse.ml" + + | 1 -> +# 172 "ext/ext_json_parse.mll" + (comment buf lexbuf) +# 425 "ext/ext_json_parse.ml" + + | 2 -> +# 173 "ext/ext_json_parse.mll" + (error lexbuf Unterminated_comment) +# 430 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state + +and scan_string buf start lexbuf = + __ocaml_lex_scan_string_rec buf start lexbuf 45 +and __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 177 "ext/ext_json_parse.mll" + ( () ) +# 442 "ext/ext_json_parse.ml" + + | 1 -> +# 179 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 2 in + update_loc lexbuf len; + + scan_string buf start lexbuf + ) +# 452 "ext/ext_json_parse.ml" + + | 2 -> +# 186 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 3 in + update_loc lexbuf len; + scan_string buf start lexbuf + ) +# 461 "ext/ext_json_parse.ml" + + | 3 -> +let +# 191 "ext/ext_json_parse.mll" + c +# 467 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 192 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf (char_for_backslash c); + scan_string buf start lexbuf + ) +# 474 "ext/ext_json_parse.ml" + + | 4 -> +let +# 196 "ext/ext_json_parse.mll" + c1 +# 480 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) +and +# 196 "ext/ext_json_parse.mll" + c2 +# 485 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 196 "ext/ext_json_parse.mll" + c3 +# 490 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) +and +# 196 "ext/ext_json_parse.mll" + s +# 495 "ext/ext_json_parse.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_start_pos + 4) in +# 197 "ext/ext_json_parse.mll" + ( + let v = dec_code c1 c2 c3 in + if v > 255 then + error lexbuf (Illegal_escape s) ; + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 506 "ext/ext_json_parse.ml" + + | 5 -> +let +# 205 "ext/ext_json_parse.mll" + c1 +# 512 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 205 "ext/ext_json_parse.mll" + c2 +# 517 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) in +# 206 "ext/ext_json_parse.mll" + ( + let v = hex_code c1 c2 in + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 526 "ext/ext_json_parse.ml" + + | 6 -> +let +# 212 "ext/ext_json_parse.mll" + c +# 532 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 213 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf '\\'; + Buffer.add_char buf c; + + scan_string buf start lexbuf + ) +# 541 "ext/ext_json_parse.ml" + + | 7 -> +# 220 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + Buffer.add_char buf lf; + + scan_string buf start lexbuf + ) +# 551 "ext/ext_json_parse.ml" + + | 8 -> +# 227 "ext/ext_json_parse.mll" + ( + let ofs = lexbuf.lex_start_pos in + let len = lexbuf.lex_curr_pos - ofs in + Buffer.add_subbytes buf lexbuf.lex_buffer ofs len; + + scan_string buf start lexbuf + ) +# 562 "ext/ext_json_parse.ml" + + | 9 -> +# 235 "ext/ext_json_parse.mll" + ( + error lexbuf Unterminated_string + ) +# 569 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state + +;; + +# 239 "ext/ext_json_parse.mll" + + + + + + + +let rec parse_json lexbuf = + let buf = Buffer.create 64 in + let look_ahead = ref None in + let token () : token = + match !look_ahead with + | None -> + lex_json buf lexbuf + | Some x -> + look_ahead := None ; + x + in + let push e = look_ahead := Some e in + let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = + match token () with + | True -> True lexbuf.lex_start_p + | False -> False lexbuf.lex_start_p + | Null -> Null lexbuf.lex_start_p + | Number s -> Flo {flo = s; loc = lexbuf.lex_start_p} + | String s -> Str { str = s; loc = lexbuf.lex_start_p} + | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf + | Lbrace -> parse_map lexbuf.lex_start_p String_map.empty lexbuf + | _ -> error lexbuf Unexpected_token +(** Note if we remove [trailing_comma] support + we should report errors (actually more work), for example + {[ + match token () with + | Rbracket -> + if trailing_comma then + error lexbuf Trailing_comma_in_array + else + ]} + {[ + match token () with + | Rbrace -> + if trailing_comma then + error lexbuf Trailing_comma_in_obj + else + + ]} + *) + and parse_array loc_start loc_finish acc lexbuf + : Ext_json_types.t = + match token () with + | Rbracket -> + Arr {loc_start ; content = Ext_array.reverse_of_list acc ; + loc_end = lexbuf.lex_curr_p } + | x -> + push x ; + let new_one = json lexbuf in + begin match token () with + | Comma -> + parse_array loc_start loc_finish (new_one :: acc) lexbuf + | Rbracket + -> Arr {content = (Ext_array.reverse_of_list (new_one::acc)); + loc_start ; + loc_end = lexbuf.lex_curr_p } + | _ -> + error lexbuf Expect_comma_or_rbracket + end + and parse_map loc_start acc lexbuf : Ext_json_types.t = + match token () with + | Rbrace -> + Obj { map = acc ; loc = loc_start} + | String key -> + begin match token () with + | Colon -> + let value = json lexbuf in + begin match token () with + | Rbrace -> Obj {map = String_map.add acc key value ; loc = loc_start} + | Comma -> + parse_map loc_start (String_map.add acc key value ) lexbuf + | _ -> error lexbuf Expect_comma_or_rbrace + end + | _ -> error lexbuf Expect_colon + end + | _ -> error lexbuf Expect_string_or_rbrace + in + let v = json lexbuf in + match token () with + | Eof -> v + | _ -> error lexbuf Expect_eof + +let parse_json_from_string s = + parse_json (Lexing.from_string s ) + +let parse_json_from_chan fname in_chan = + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan fname in + parse_json lexbuf + +let parse_json_from_file s = + let in_chan = open_in s in + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan s in + match parse_json lexbuf with + | exception e -> close_in in_chan ; raise e + | v -> close_in in_chan; v + + + + + +# 688 "ext/ext_json_parse.ml" + +end +module Ext_sys : sig +#1 "ext_sys.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. *) + + +(* Not used yet *) +(* val is_directory_no_exn : string -> bool *) + + +val is_windows_or_cygwin : bool + +val getenv_opt : + string -> + string option +end = struct +#1 "ext_sys.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. *) + +(** TODO: not exported yet, wait for Windows Fix*) +let is_directory_no_exn f = + try Sys.is_directory f with _ -> false + + +let is_windows_or_cygwin = Sys.win32 || Sys.cygwin + + +let getenv_opt = Sys.getenv_opt + +end +module Ext_path : sig +#1 "ext_path.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t + + + + + +(** + [combine path1 path2] + 1. add some simplifications when concatenating + 2. when [path2] is absolute, return [path2] +*) +val combine : + string -> + string -> + string + + + +val chop_extension : ?loc:string -> string -> string + + +val chop_extension_if_any : string -> string + +val chop_all_extensions_if_any : + string -> string + +(** + {[ + get_extension "a.txt" = ".txt" + get_extension "a" = "" + ]} +*) +val get_extension : string -> string + + + + +val node_rebase_file : + from:string -> + to_:string -> + string -> + string + +(** + TODO: could be highly optimized + if [from] and [to] resolve to the same path, a zero-length string is returned + Given that two paths are directory + + A typical use case is + {[ + Filename.concat + (rel_normalized_absolute_path cwd (Filename.dirname a)) + (Filename.basename a) + ]} +*) +val rel_normalized_absolute_path : from:string -> string -> string + + +val normalize_absolute_path : string -> string + +val absolute_path : string Lazy.t -> string -> string + +(** [concat dirname filename] + The same as {!Filename.concat} except a tiny optimization + for current directory simplification +*) +val concat : string -> string -> string + +val check_suffix_case : + string -> string -> bool +end = struct +#1 "ext_path.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t = + | File of string + | Dir of string + + + + + + +let split_by_sep_per_os : string -> string list = + if Ext_sys.is_windows_or_cygwin then + fun x -> + (* on Windows, we can still accept -bs-package-output lib/js *) + Ext_string.split_by + (fun x -> match x with |'/' |'\\' -> true | _ -> false) x + else + fun x -> Ext_string.split x '/' + +(** example + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + ]} + + The other way + {[ + + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + ]} + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib//ocaml_array.ml" + ]} + {[ + /a/b + /c/d + ]} +*) +let node_relative_path + ~from:(file_or_dir_2 : t ) + (file_or_dir_1 : t) + = + let relevant_dir1 = + match file_or_dir_1 with + | Dir x -> x + | File file1 -> Filename.dirname file1 in + let relevant_dir2 = + match file_or_dir_2 with + | Dir x -> x + | File file2 -> Filename.dirname file2 in + let dir1 = split_by_sep_per_os relevant_dir1 in + let dir2 = split_by_sep_per_os relevant_dir2 in + let rec go (dir1 : string list) (dir2 : string list) = + match dir1, dir2 with + | "." :: xs, ys -> go xs ys + | xs , "." :: ys -> go xs ys + | x::xs , y :: ys when x = y + -> go xs ys + | _, _ -> + Ext_list.map_append dir2 dir1 (fun _ -> Literals.node_parent) + in + match go dir1 dir2 with + | (x :: _ ) as ys when x = Literals.node_parent -> + String.concat Literals.node_sep ys + | ys -> + String.concat Literals.node_sep + @@ Literals.node_current :: ys + + +let node_concat ~dir base = + dir ^ Literals.node_sep ^ base + +let node_rebase_file ~from ~to_ file = + + node_concat + ~dir:( + if from = to_ then Literals.node_current + else node_relative_path ~from:(Dir from) (Dir to_)) + file + + +(*** + {[ + Filename.concat "." "";; + "./" + ]} +*) +let combine path1 path2 = + if Filename.is_relative path2 then + if Ext_string.is_empty path2 then + path1 + else + if path1 = Filename.current_dir_name then + path2 + else + if path2 = Filename.current_dir_name + then path1 + else + Filename.concat path1 path2 + else + path2 + + +let chop_extension ?(loc="") name = + try Filename.chop_extension name + with Invalid_argument _ -> + Ext_pervasives.invalid_argf + "Filename.chop_extension ( %s : %s )" loc name + +let chop_extension_if_any fname = + try Filename.chop_extension fname with Invalid_argument _ -> fname + +let rec chop_all_extensions_if_any fname = + match Filename.chop_extension fname with + | x -> chop_all_extensions_if_any x + | exception _ -> fname + +let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos + + +let (//) x y = + if x = Filename.current_dir_name then y + else if y = Filename.current_dir_name then x + else Filename.concat x y + +(** + {[ + split_aux "//ghosg//ghsogh/";; + - : string * string list = ("/", ["ghosg"; "ghsogh"]) + ]} + Note that + {[ + Filename.dirname "/a/" = "/" + Filename.dirname "/a/b/" = Filename.dirname "/a/b" = "/a" + ]} + Special case: + {[ + basename "//" = "/" + basename "///" = "/" + ]} + {[ + basename "" = "." + basename "" = "." + dirname "" = "." + dirname "" = "." + ]} +*) +let split_aux p = + let rec go p acc = + let dir = Filename.dirname p in + if dir = p then dir, acc + else + let new_path = Filename.basename p in + if Ext_string.equal new_path Filename.dir_sep then + go dir acc + (* We could do more path simplification here + leave to [rel_normalized_absolute_path] + *) + else + go dir (new_path :: acc) + + in go p [] + + + + + +(** + TODO: optimization + if [from] and [to] resolve to the same path, a zero-length string is returned + + This function is useed in [es6-global] and + [amdjs-global] format and tailored for `rollup` +*) +let rel_normalized_absolute_path ~from to_ = + let root1, paths1 = split_aux from in + let root2, paths2 = split_aux to_ in + if root1 <> root2 then root2 + else + let rec go xss yss = + match xss, yss with + | x::xs, y::ys -> + if Ext_string.equal x y then go xs ys + else if x = Filename.current_dir_name then go xs yss + else if y = Filename.current_dir_name then go xss ys + else + let start = + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + Ext_list.fold_left yss start (fun acc v -> acc // v) + | [], [] -> Ext_string.empty + | [], y::ys -> Ext_list.fold_left ys y (fun acc x -> acc // x) + | x::xs, [] -> + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + let v = go paths1 paths2 in + + if Ext_string.is_empty v then Literals.node_current + else + if + v = "." + || v = ".." + || Ext_string.starts_with v "./" + || Ext_string.starts_with v "../" + then v + else "./" ^ v + +(*TODO: could be hgighly optimized later + {[ + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/a/b/../c../d/e/f";; + + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/gsho/./../..";; + + normalize_absolute_path "/a/b/c/d";; + + normalize_absolute_path "/a/b/c/d/";; + + normalize_absolute_path "/a/";; + + normalize_absolute_path "/a";; + ]} +*) +(** See tests in {!Ounit_path_tests} *) +let normalize_absolute_path x = + let drop_if_exist xs = + match xs with + | [] -> [] + | _ :: xs -> xs in + let rec normalize_list acc paths = + match paths with + | [] -> acc + | x :: xs -> + if Ext_string.equal x Ext_string.current_dir_lit then + normalize_list acc xs + else if Ext_string.equal x Ext_string.parent_dir_lit then + normalize_list (drop_if_exist acc ) xs + else + normalize_list (x::acc) xs + in + let root, paths = split_aux x in + let rev_paths = normalize_list [] paths in + let rec go acc rev_paths = + match rev_paths with + | [] -> Filename.concat root acc + | last::rest -> go (Filename.concat last acc ) rest in + match rev_paths with + | [] -> root + | last :: rest -> go last rest + + + + +let absolute_path cwd s = + let process s = + let s = + if Filename.is_relative s then + Lazy.force cwd // s + else s in + (* Now simplify . and .. components *) + let rec aux s = + let base,dir = Filename.basename s, Filename.dirname s in + if dir = s then dir + else if base = Filename.current_dir_name then aux dir + else if base = Filename.parent_dir_name then Filename.dirname (aux dir) + else aux dir // base + in aux s in + process s + + +let absolute cwd s = + match s with + | File x -> File (absolute_path cwd x ) + | Dir x -> Dir (absolute_path cwd x) + +let concat dirname filename = + if filename = Filename.current_dir_name then dirname + else if dirname = Filename.current_dir_name then filename + else Filename.concat dirname filename + + +let check_suffix_case = + Ext_string.ends_with +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" + + (* not suporting nested if here..*) +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];; + +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + + +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; + + + +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 "ext/hashtbl.cppo.ml" +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 h_data = h.data in + Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); + 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 + let h_data = h.data in + if find_bucket (Array.unsafe_get h_data i) then + begin + Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get 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 rec remove_bucket key (h : _ t) (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 key h next) + +let remove (h : _ t ) key = + let i = key_index h key in + let h_data = h.data in + let old_h_szie = h.size in + let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in + if old_h_szie <> h.size then + Array.unsafe_set h_data i new_bucket + +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 Array.unsafe_get 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_key_opt (h : _ t) key = + Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in + let l = Array.unsafe_get h_data i in + try + Array.unsafe_set h_data i (replace_bucket l) + with Not_found -> + begin + Array.unsafe_set 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; + end + +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 (Array.unsafe_get h.data (key_index h key)) + + +let of_list2 ks vs = + let len = List.length ks in + let map = create len in + List.iter2 (fun k v -> add map k v) ks vs ; + map + + +end +module Bsb_build_util : sig +#1 "bsb_build_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. *) + +(** +Build quoted commandline arguments for bsc.exe for the given ppx flags + +Use: +{[ +ppx_flags [ppxs] +]} +*) +val ppx_flags : string list -> string + +val pp_flag : string -> string + +(** +Build unquoted command line arguments for bsc.exe for the given include dirs + +Use: +{[ +include_dirs [dirs] +]} +*) +val include_dirs : string list -> string + + +val mkp : string -> unit + + +(* The path of [bsc] and [bsdep] is normalized so that the invokation of [./jscomp/bin/bsb.exe] + and [bsb.exe] (combined with a dirty bsconfig.json) will not trigger unnecessary rebuild. + + The location of [bsc] and [bsdep] is configured by the combination of [Sys.executable_name] + and [cwd]. + + In theory, we should also check the integrity of [bsb.exe], if it is changed, the rebuild + should be regen, but that is too much in practice, not only you need check the integrity of + path of [bsb.exe] but also the timestamp, to make it 100% correct, also the integrity of + [bsdep.exe] [bsc.exe] etc. +*) +val get_bsc_bsdep : string -> string * string + + +(** + if [Sys.executable_name] gives an absolute path, + nothing needs to be done + if it is a relative path + + there are two cases: + - bsb.exe + - ./bsb.exe + The first should also not be touched + Only the latter need be adapted based on project root +*) +val get_bsc_dir : cwd:string -> string + + +val get_list_string_acc : + Ext_json_types.t array -> + string list -> + string list + +val get_list_string : + Ext_json_types.t array -> + string list + +(* [resolve_bsb_magic_file] + returns a tuple (path,checked) + when checked is true, it means such file should exist without depending on env +*) +val resolve_bsb_magic_file : + cwd:string -> + desc:string -> + string -> + string * bool + +type package_context = { + cwd : string ; + top : bool ; +} + +val walk_all_deps : string -> (package_context -> unit) -> unit + +end = struct +#1 "bsb_build_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 flag_concat flag xs = + String.concat Ext_string.single_space + (Ext_list.flat_map xs (fun x -> [flag ; x])) + +let (//) = Ext_path.combine + + +(*TODO: optimize *) +let ppx_flags xs = + flag_concat "-ppx" + (Ext_list.map xs Filename.quote) + +let pp_flag (xs : string) = + "-pp " ^ Filename.quote xs + +let include_dirs = flag_concat "-I" + + +(* we use lazy $src_root_dir *) + + + +(* It does several conversion: + First, it will convert unix path to windows backward on windows platform. + Then if it is absolute path, it will do thing + Else if it is relative path, it will be rebased on project's root directory *) + +let convert_and_resolve_path : string -> string -> string = + if Sys.unix then (//) + else fun cwd path -> + if Ext_sys.is_windows_or_cygwin then + let p = Ext_string.replace_slash_backward path in + cwd // p + else failwith ("Unknown OS :" ^ Sys.os_type) +(* we only need convert the path in the beginning *) + + +(* Magic path resolution: + foo => foo + foo/ => /absolute/path/to/projectRoot/node_modules/foo + foo/bar => /absolute/path/to/projectRoot/node_modules/foo/bar + /foo/bar => /foo/bar + ./foo/bar => /absolute/path/to/projectRoot/./foo/bar + Input is node path, output is OS dependent (normalized) path +*) +let resolve_bsb_magic_file ~cwd ~desc p : string * bool = + + let no_slash = Ext_string.no_slash_idx p in + if no_slash < 0 then + (* Single file FIXME: better error message for "" input *) + p, false + else + let first_char = String.unsafe_get p 0 in + if Filename.is_relative p && + first_char <> '.' then + let package_name, rest = + Bsb_pkg_types.extract_pkg_name_and_file p + in + let relative_path = + if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward rest + else rest in + (* let p = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward p else p in *) + let package_dir = Bsb_pkg.resolve_bs_package ~cwd package_name in + let path = package_dir // relative_path in + if Sys.file_exists path then path, true + else + begin + Bsb_log.error "@{Could not resolve @} %s in %s@." p cwd ; + failwith (p ^ " not found when resolving " ^ desc) + end + + else + (* relative path [./x/y]*) + convert_and_resolve_path cwd p, true + + + +(** converting a file from Linux path format to Windows *) + +(** + If [Sys.executable_name] gives an absolute path, + nothing needs to be done. + + If [Sys.executable_name] is not an absolute path, for example + (rlwrap ./ocaml) + it is a relative path, + it needs be adapted based on cwd +*) + +let get_bsc_dir ~cwd = + Filename.dirname + (Ext_path.normalize_absolute_path + (Ext_path.combine cwd Sys.executable_name)) + + +let get_bsc_bsdep cwd = + let dir = get_bsc_dir ~cwd in + Filename.concat dir "bsc.exe", + Filename.concat dir "bsb_helper.exe" + +(** + {[ + mkp "a/b/c/d";; + mkp "/a/b/c/d" + ]} +*) +let rec mkp dir = + if not (Sys.file_exists dir) then + let parent_dir = Filename.dirname dir in + if parent_dir = Filename.current_dir_name then + Unix.mkdir dir 0o777 (* leaf node *) + else + begin + mkp parent_dir ; + Unix.mkdir dir 0o777 + end + else if not @@ Sys.is_directory dir then + failwith ( dir ^ " exists but it is not a directory, plz remove it first") + else () + + +let get_list_string_acc (s : Ext_json_types.t array) acc = + Ext_array.to_list_map_acc s acc (fun x -> + match x with + | Str x -> Some x.str + | _ -> None + ) + +let get_list_string s = get_list_string_acc s [] + + +(* Key is the path *) +let (|?) m (key, cb) = + m |> Ext_json.test key cb + +type package_context = { + cwd : string ; + top : bool ; +} + +(** + TODO: check duplicate package name + ?use path as identity? + + Basic requirements + 1. cycle detection + 2. avoid duplication + 3. deterministic, since -make-world will also comes with -clean-world + +*) + +let pp_packages_rev ppf lst = + Ext_list.rev_iter lst (fun s -> Format.fprintf ppf "%s " s) + +let rec walk_all_deps_aux visited paths top dir cb = + let bsconfig_json = (dir // Literals.bsconfig_json) in + match Ext_json_parse.parse_json_from_file bsconfig_json with + | Obj {map; loc} -> + let cur_package_name = + match String_map.find_opt map Bsb_build_schemas.name with + | Some (Str {str }) -> str + | Some _ + | None -> Bsb_exception.errorf ~loc "package name missing in %s/bsconfig.json" dir + in + let package_stacks = cur_package_name :: paths in + let () = + Bsb_log.info "@{Package stack:@} %a @." pp_packages_rev + package_stacks + in + if List.mem cur_package_name paths then + begin + Bsb_log.error "@{Cyclic dependencies in package stack@}@."; + exit 2 + end; + if String_hashtbl.mem visited cur_package_name then + Bsb_log.info + "@{Visited before@} %s@." cur_package_name + else + begin + map + |? + (Bsb_build_schemas.bs_dependencies, + `Arr (fun (new_packages : Ext_json_types.t array) -> + Ext_array.iter new_packages(fun js -> + begin match js with + | Str {str = new_package} -> + let package_dir = + Bsb_pkg.resolve_bs_package ~cwd:dir + (Bsb_pkg_types.string_as_package new_package) in + walk_all_deps_aux visited package_stacks false package_dir cb ; + | _ -> + Bsb_exception.errorf ~loc + "%s expect an array" + Bsb_build_schemas.bs_dependencies + end + ))) + |> ignore ; + if top then begin + map + |? + (Bsb_build_schemas.bs_dev_dependencies, + `Arr (fun (new_packages : Ext_json_types.t array) -> + Ext_array.iter new_packages (fun (js : Ext_json_types.t) -> + match js with + | Str {str = new_package} -> + let package_dir = + Bsb_pkg.resolve_bs_package ~cwd:dir + (Bsb_pkg_types.string_as_package new_package) in + walk_all_deps_aux visited package_stacks false package_dir cb ; + | _ -> + Bsb_exception.errorf ~loc + "%s expect an array" + Bsb_build_schemas.bs_dev_dependencies + + ))) + |> ignore ; + end + ; + cb {top ; cwd = dir}; + String_hashtbl.add visited cur_package_name dir; + end + | _ -> () + | exception _ -> + Bsb_exception.invalid_json bsconfig_json + + +let walk_all_deps dir cb = + let visited = String_hashtbl.create 0 in + walk_all_deps_aux visited [] true dir cb + +end +module Bsb_config : sig +#1 "bsb_config.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 ocaml_bin_install_prefix : string -> string +val proj_rel : string -> string + +val lib_js : string +val lib_amd : string +val lib_bs : string +val lib_es6 : string +val lib_es6_global : string +val lib_amd_global : string +val lib_ocaml : string +val all_lib_artifacts : string list +(* we need generate path relative to [lib/bs] directory in the opposite direction *) +val rev_lib_bs_prefix : string -> string + + +(** default not install, only when -make-world, its dependencies will be installed *) + + +end = struct +#1 "bsb_config.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 (//) = Ext_path.combine + +let lib_lit = "lib" +let lib_js = lib_lit //"js" +let lib_amd = lib_lit //"amdjs" +let lib_ocaml = lib_lit // "ocaml" +let lib_bs = lib_lit // "bs" +let lib_es6 = lib_lit // "es6" +let lib_es6_global = lib_lit // "es6_global" +let lib_amd_global = lib_lit // "amdjs_global" +let all_lib_artifacts = + [ lib_js ; + lib_amd ; + lib_ocaml; + lib_bs ; + lib_es6 ; + lib_es6_global; + lib_amd_global + ] +let rev_lib_bs = ".."// ".." + + +let rev_lib_bs_prefix p = rev_lib_bs // p + +let ocaml_bin_install_prefix p = lib_ocaml // p + +let lazy_src_root_dir = "$src_root_dir" +let proj_rel path = lazy_src_root_dir // path + +(** it may not be a bad idea to hard code the binary path + of bsb in configuration time +*) + + + + + + +let cmd_package_specs = ref None + + +end +module Ext_char : sig +#1 "ext_char.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. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool + +val is_lower_case : char -> bool + +val uppercase_ascii : char -> char + +val lowercase_ascii : char -> char +end = struct +#1 "ext_char.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. *) + + + + + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) + +let escaped = Char.escaped + + +let valid_hex x = + match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> true + | _ -> false + + + +let is_lower_case c = + (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') +let uppercase_ascii = + + Char.uppercase_ascii + + +let lowercase_ascii = + + Char.lowercase_ascii + + +end +module Ext_modulename : sig +#1 "ext_modulename.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file : string -> string + + +val module_name_of_file_if_any : string -> string + +(** [modulename, upper] + if [upper = true] then it means it is indeed uppercase +*) +val module_name_of_file_if_any_with_upper : string -> string * bool + + +(** Given an JS bundle name, generate a meaningful + bounded module name +*) +val js_id_name_of_hint_name : string -> string +end = struct +#1 "ext_modulename.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file file = + Ext_string.capitalize_ascii + (Filename.chop_extension @@ Filename.basename file) + +let module_name_of_file_if_any file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + Ext_string.capitalize_ascii v + +let module_name_of_file_if_any_with_upper file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + let res = Ext_string.capitalize_ascii v in + res, res == v + + + + +let good_hint_name module_name offset = + let len = String.length module_name in + len > offset && + (function | 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false) + (String.unsafe_get module_name offset) && + Ext_string.for_all_from module_name (offset + 1) + (function + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + -> true + | _ -> false) + +let rec collect_start buf s off len = + if off >= len then () + else + let next = succ off in + match String.unsafe_get s off with + | 'a' .. 'z' as c -> + Buffer.add_char buf (Ext_char.uppercase_ascii c) + ; + collect_next buf s next len + | 'A' .. 'Z' as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | _ -> collect_start buf s next len +and collect_next buf s off len = + if off >= len then () + else + let next = off + 1 in + match String.unsafe_get s off with + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | '.' + | '-' -> + collect_start buf s next len + | _ -> + collect_next buf s next len + +(** This is for a js exeternal module, we can change it when printing + for example + {[ + var React$1 = require('react'); + React$1.render(..) + ]} + Given a name, if duplicated, they should have the same id +*) +let js_id_name_of_hint_name module_name = + let i = Ext_string.rindex_neg module_name '/' in + if i >= 0 then + let offset = succ i in + if good_hint_name module_name offset then + Ext_string.capitalize_ascii + (Ext_string.tail_from module_name offset) + else + let str_len = String.length module_name in + let buf = Buffer.create str_len in + collect_start buf module_name offset str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then + Ext_string.capitalize_ascii module_name + else res + else + if good_hint_name module_name 0 then + Ext_string.capitalize_ascii module_name + else + let str_len = (String.length module_name) in + let buf = Buffer.create str_len in + collect_start buf module_name 0 str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then module_name + else res + +end +module Bsb_db : sig +#1 "bsb_db.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. *) + +(** Store a file called [.bsbuild] that can be communicated + between [bsb.exe] and [bsb_helper.exe]. + [bsb.exe] stores such data which would be retrieved by + [bsb_helper.exe]. It is currently used to combine with + ocamldep to figure out which module->file it depends on +*) + +type case = bool + + +type ml_info = + | Ml_source of bool * bool + (* No extension stored + Ml_source(name,is_re) + [is_re] default to false + *) + + | Ml_empty +type mli_info = + | Mli_source of bool * bool + | Mli_empty + +type module_info = + { + mli_info : mli_info ; + ml_info : ml_info ; + name_sans_extension : string + } + +type t = module_info String_map.t + +type ts = t array + +(** store the meta data indexed by {!Bsb_dir_index} + {[ + 0 --> lib group + 1 --> dev 1 group + . + + ]} +*) + +val dir_of_module_info : module_info -> string + + +val filename_sans_suffix_of_module_info : module_info -> string + + +(** + Currently it is okay to have duplicated module, + In the future, we may emit a warning +*) +val collect_module_by_filename : + dir:string -> t -> string -> t + +(** + return [boolean] to indicate whether reason file exists or not + will raise if it fails sanity check +*) +val sanity_check : t -> bool +end = struct +#1 "bsb_db.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. *) + +type case = bool +(** true means upper case*) + +type ml_info = + | Ml_source of bool * case (* Ml_source(is_re, case) default to false *) + | Ml_empty +type mli_info = + | Mli_source of bool * case + | Mli_empty + +type module_info = + { + mli_info : mli_info ; + ml_info : ml_info ; + name_sans_extension : string ; + } + + +type t = module_info String_map.t + +type ts = t array +(** indexed by the group *) + + + +let dir_of_module_info (x : module_info) + = + Filename.dirname x.name_sans_extension + + +let filename_sans_suffix_of_module_info (x : module_info) = + x.name_sans_extension + +let check (x : module_info) name_sans_extension = + if x.name_sans_extension <> name_sans_extension then + Bsb_exception.invalid_spec + (Printf.sprintf + "implementation and interface have different path names or different cases %s vs %s" + x.name_sans_extension name_sans_extension) + +let adjust_module_info (x : _ option) suffix name_sans_extension upper = + match suffix with + | ".ml" -> + let ml_info = Ml_source ( false, upper) in + (match x with + | None -> + {name_sans_extension ; ml_info ; mli_info = Mli_empty} + | Some x -> + check x name_sans_extension; + {x with ml_info }) + | ".re" -> + let ml_info = Ml_source ( true, upper)in + (match x with None -> + {name_sans_extension; ml_info ; mli_info = Mli_empty} + | Some x -> + check x name_sans_extension; + {x with ml_info}) + | ".mli" -> + let mli_info = Mli_source (false, upper) in + (match x with None -> + {name_sans_extension; mli_info ; ml_info = Ml_empty} + | Some x -> + check x name_sans_extension; + {x with mli_info }) + | ".rei" -> + let mli_info = Mli_source (true, upper) in + (match x with None -> + { name_sans_extension; mli_info ; ml_info = Ml_empty} + | Some x -> + check x name_sans_extension; + { x with mli_info}) + | _ -> + Ext_pervasives.failwithf ~loc:__LOC__ + "don't know what to do with %s%s" + name_sans_extension suffix + +let collect_module_by_filename ~dir (map : t) file_name : t = + let module_name, upper = + Ext_modulename.module_name_of_file_if_any_with_upper file_name in + let suffix = Ext_path.get_extension file_name in + let name_sans_extension = + Ext_path.chop_extension (Filename.concat dir file_name) in + String_map.adjust + map + module_name + (fun opt_module_info -> + adjust_module_info + opt_module_info + suffix + name_sans_extension upper ) + + + +let sanity_check (map : t ) = + String_map.exists map (fun _ module_info -> + match module_info with + | { ml_info = Ml_source(is_re,_); + mli_info = Mli_source(is_rei,_) } -> + is_re || is_rei + | {ml_info = Ml_source(is_re,_); mli_info = Mli_empty} + | {mli_info = Mli_source(is_re,_); ml_info = Ml_empty} + -> is_re + | {ml_info = Ml_empty ; mli_info = Mli_empty } -> false + ) + +end +module Bsb_dir_index : sig +#1 "bsb_dir_index.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +(** Used to index [.bsbuildcache] may not be needed if we flatten dev + into a single group +*) +type t = private int + +val lib_dir_index : t + +val is_lib_dir : t -> bool + +val get_dev_index : unit -> t + +val of_int : int -> t + +val get_current_number_of_dev_groups : unit -> int + + +val string_of_bsb_dev_include : t -> string + +(** TODO: Need reset + when generating each ninja file to provide stronger guarantee. + Here we get a weak guarantee because only dev group is + inside the toplevel project + *) +val reset : unit -> unit +end = struct +#1 "bsb_dir_index.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t = int + +(** + 0 : lib + 1 : dev 1 + 2 : dev 2 +*) +external of_int : int -> t = "%identity" +let lib_dir_index = 0 + +let is_lib_dir x = x = lib_dir_index + +let dir_index = ref 0 + +let get_dev_index ( ) = + incr dir_index ; !dir_index + +let get_current_number_of_dev_groups = + (fun () -> !dir_index ) + + +(** bsb generate pre-defined variables [bsc_group_i_includes] + for each rule, there is variable [bsc_extra_excludes] + [bsc_extra_includes] are for app test etc + it will be like + {[ + bsc_extra_includes = ${bsc_group_1_includes} + ]} + where [bsc_group_1_includes] will be pre-calcuated +*) +let bsc_group_1_includes = "bsc_group_1_includes" +let bsc_group_2_includes = "bsc_group_2_includes" +let bsc_group_3_includes = "bsc_group_3_includes" +let bsc_group_4_includes = "bsc_group_4_includes" +let string_of_bsb_dev_include i = + match i with + | 1 -> bsc_group_1_includes + | 2 -> bsc_group_2_includes + | 3 -> bsc_group_3_includes + | 4 -> bsc_group_4_includes + | _ -> + "bsc_group_" ^ string_of_int i ^ "_includes" + + +let reset () = dir_index := 0 +end +module Vec_gen += struct +#1 "vec_gen.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. *) + + +module type ResizeType = +sig + type t + val null : t (* used to populate new allocated array checkout {!Obj.new_block} for more performance *) +end + +module type S = +sig + type elt + type t + val length : t -> int + val compact : t -> unit + val singleton : elt -> t + val empty : unit -> t + val make : int -> t + val init : int -> (int -> elt) -> t + val is_empty : t -> bool + val of_array : elt array -> t + val of_sub_array : elt array -> int -> int -> t + + (** Exposed for some APIs which only take array as input, + when exposed + *) + val unsafe_internal_array : t -> elt array + val reserve : t -> int -> unit + val push : t -> elt -> unit + val delete : t -> int -> unit + val pop : t -> unit + val get_last_and_pop : t -> elt + val delete_range : t -> int -> int -> unit + val get_and_delete_range : t -> int -> int -> t + val clear : t -> unit + val reset : t -> unit + val to_list : t -> elt list + val of_list : elt list -> t + val to_array : t -> elt array + val of_array : elt array -> t + val copy : t -> t + val reverse_in_place : t -> unit + val iter : t -> (elt -> unit) -> unit + val iteri : t -> (int -> elt -> unit ) -> unit + val iter_range : t -> from:int -> to_:int -> (elt -> unit) -> unit + val iteri_range : t -> from:int -> to_:int -> (int -> elt -> unit) -> unit + val map : (elt -> elt) -> t -> t + val mapi : (int -> elt -> elt) -> t -> t + val map_into_array : (elt -> 'f) -> t -> 'f array + val map_into_list : (elt -> 'f) -> t -> 'f list + val fold_left : ('f -> elt -> 'f) -> 'f -> t -> 'f + val fold_right : (elt -> 'g -> 'g) -> t -> 'g -> 'g + val filter : (elt -> bool) -> t -> t + val inplace_filter : (elt -> bool) -> t -> unit + val inplace_filter_with : (elt -> bool) -> cb_no:(elt -> 'a -> 'a) -> 'a -> t -> 'a + val inplace_filter_from : int -> (elt -> bool) -> t -> unit + val equal : (elt -> elt -> bool) -> t -> t -> bool + val get : t -> int -> elt + val unsafe_get : t -> int -> elt + val last : t -> elt + val capacity : t -> int + val exists : (elt -> bool) -> t -> bool + val sub : t -> int -> int -> t +end + + +end +module Resize_array : sig +#1 "resize_array.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. *) + +module Make ( Resize : Vec_gen.ResizeType) : Vec_gen.S with type elt = Resize.t + + + +end = struct +#1 "resize_array.ml" +# 1 "ext/vec.cppo.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. *) +# 25 "ext/vec.cppo.ml" +external unsafe_blit : + 'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit" +module Make ( Resize : Vec_gen.ResizeType) = struct + type elt = Resize.t + + let null = Resize.null + + +# 41 "ext/vec.cppo.ml" +external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub" + +type t = { + mutable arr : elt array ; + mutable len : int ; +} + +let length d = d.len + +let compact d = + let d_arr = d.arr in + if d.len <> Array.length d_arr then + begin + let newarr = unsafe_sub d_arr 0 d.len in + d.arr <- newarr + end +let singleton v = + { + len = 1 ; + arr = [|v|] + } + +let empty () = + { + len = 0; + arr = [||]; + } + +let is_empty d = + d.len = 0 + +let reset d = + d.len <- 0; + d.arr <- [||] + + +(* For [to_*] operations, we should be careful to call {!Array.*} function + in case we operate on the whole array +*) +let to_list d = + let rec loop (d_arr : elt array) idx accum = + if idx < 0 then accum else loop d_arr (idx - 1) (Array.unsafe_get d_arr idx :: accum) + in + loop d.arr (d.len - 1) [] + + +let of_list lst = + let arr = Array.of_list lst in + { arr ; len = Array.length arr} + + +let to_array d = + unsafe_sub d.arr 0 d.len + +let of_array src = + { + len = Array.length src; + arr = Array.copy src; + (* okay to call {!Array.copy}*) + } +let of_sub_array arr off len = + { + len = len ; + arr = Array.sub arr off len + } +let unsafe_internal_array v = v.arr +(* we can not call {!Array.copy} *) +let copy src = + let len = src.len in + { + len ; + arr = unsafe_sub src.arr 0 len ; + } + +(* FIXME *) +let reverse_in_place src = + Ext_array.reverse_range src.arr 0 src.len + + + + +(* {!Array.sub} is not enough for error checking, it + may contain some garbage + *) +let sub (src : t) start len = + let src_len = src.len in + if len < 0 || start > src_len - len then invalid_arg "Vec.sub" + else + { len ; + arr = unsafe_sub src.arr start len } + +let iter d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f (Array.unsafe_get arr i) + done + +let iteri d f = + let arr = d.arr in + for i = 0 to d.len - 1 do + f i (Array.unsafe_get arr i) + done + +let iter_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iter_range" + else + let d_arr = d.arr in + for i = from to to_ do + f (Array.unsafe_get d_arr i) + done + +let iteri_range d ~from ~to_ f = + if from < 0 || to_ >= d.len then invalid_arg "Resize_array.iteri_range" + else + let d_arr = d.arr in + for i = from to to_ do + f i (Array.unsafe_get d_arr i) + done + +let map_into_array f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [||] + else + let first_one = f (Array.unsafe_get src_arr 0) in + let arr = Array.make src_len first_one in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + arr +let map_into_list f src = + let src_len = src.len in + let src_arr = src.arr in + if src_len = 0 then [] + else + let acc = ref [] in + for i = src_len - 1 downto 0 do + acc := f (Array.unsafe_get src_arr i) :: !acc + done; + !acc + +let mapi f src = + let len = src.len in + if len = 0 then { len ; arr = [| |] } + else + let src_arr = src.arr in + let arr = Array.make len (Array.unsafe_get src_arr 0) in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i (Array.unsafe_get src_arr i)) + done; + { + len ; + arr ; + } + +let fold_left f x a = + let rec loop a_len (a_arr : elt array) idx x = + if idx >= a_len then x else + loop a_len a_arr (idx + 1) (f x (Array.unsafe_get a_arr idx)) + in + loop a.len a.arr 0 x + +let fold_right f a x = + let rec loop (a_arr : elt array) idx x = + if idx < 0 then x + else loop a_arr (idx - 1) (f (Array.unsafe_get a_arr idx) x) + in + loop a.arr (a.len - 1) x + +(** + [filter] and [inplace_filter] +*) +let filter f d = + let new_d = copy d in + let new_d_arr = new_d.arr in + let d_arr = d.arr in + let p = ref 0 in + for i = 0 to d.len - 1 do + let x = Array.unsafe_get d_arr i in + (* TODO: can be optimized for segments blit *) + if f x then + begin + Array.unsafe_set new_d_arr !p x; + incr p; + end; + done; + new_d.len <- !p; + new_d + +let equal eq x y : bool = + if x.len <> y.len then false + else + let rec aux x_arr y_arr i = + if i < 0 then true else + if eq (Array.unsafe_get x_arr i) (Array.unsafe_get y_arr i) then + aux x_arr y_arr (i - 1) + else false in + aux x.arr y.arr (x.len - 1) + +let get d i = + if i < 0 || i >= d.len then invalid_arg "Resize_array.get" + else Array.unsafe_get d.arr i +let unsafe_get d i = Array.unsafe_get d.arr i +let last d = + if d.len <= 0 then invalid_arg "Resize_array.last" + else Array.unsafe_get d.arr (d.len - 1) + +let capacity d = Array.length d.arr + +(* Attention can not use {!Array.exists} since the bound is not the same *) +let exists p d = + let a = d.arr in + let n = d.len in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + +let map f src = + let src_len = src.len in + if src_len = 0 then { len = 0 ; arr = [||]} + (* TODO: we may share the empty array + but sharing mutable state is very challenging, + the tricky part is to avoid mutating the immutable array, + here it looks fine -- + invariant: whenever [.arr] mutated, make sure it is not an empty array + Actually no: since starting from an empty array + {[ + push v (* the address of v should not be changed *) + ]} + *) + else + let src_arr = src.arr in + let first = f (Array.unsafe_get src_arr 0 ) in + let arr = Array.make src_len first in + for i = 1 to src_len - 1 do + Array.unsafe_set arr i (f (Array.unsafe_get src_arr i)) + done; + { + len = src_len; + arr = arr; + } + +let init len f = + if len < 0 then invalid_arg "Resize_array.init" + else if len = 0 then { len = 0 ; arr = [||] } + else + let first = f 0 in + let arr = Array.make len first in + for i = 1 to len - 1 do + Array.unsafe_set arr i (f i) + done; + { + + len ; + arr + } + + + + let make initsize : t = + if initsize < 0 then invalid_arg "Resize_array.make" ; + { + + len = 0; + arr = Array.make initsize null ; + } + + + + let reserve (d : t ) s = + let d_len = d.len in + let d_arr = d.arr in + if s < d_len || s < Array.length d_arr then () + else + let new_capacity = min Sys.max_array_length s in + let new_d_arr = Array.make new_capacity null in + unsafe_blit d_arr 0 new_d_arr 0 d_len; + d.arr <- new_d_arr + + let push (d : t) v = + let d_len = d.len in + let d_arr = d.arr in + let d_arr_len = Array.length d_arr in + if d_arr_len = 0 then + begin + d.len <- 1 ; + d.arr <- [| v |] + end + else + begin + if d_len = d_arr_len then + begin + if d_len >= Sys.max_array_length then + failwith "exceeds max_array_length"; + let new_capacity = min Sys.max_array_length d_len * 2 + (* [d_len] can not be zero, so [*2] will enlarge *) + in + let new_d_arr = Array.make new_capacity null in + d.arr <- new_d_arr; + unsafe_blit d_arr 0 new_d_arr 0 d_len ; + end; + d.len <- d_len + 1; + Array.unsafe_set d.arr d_len v + end + +(** delete element at offset [idx], will raise exception when have invalid input *) + let delete (d : t) idx = + let d_len = d.len in + if idx < 0 || idx >= d_len then invalid_arg "Resize_array.delete" ; + let arr = d.arr in + unsafe_blit arr (idx + 1) arr idx (d_len - idx - 1); + let idx = d_len - 1 in + d.len <- idx + +# 358 "ext/vec.cppo.ml" + ; + Array.unsafe_set arr idx null + +# 362 "ext/vec.cppo.ml" +(** pop the last element, a specialized version of [delete] *) + let pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.pop"; + d.len <- idx + +# 369 "ext/vec.cppo.ml" + ; + Array.unsafe_set d.arr idx null + +# 373 "ext/vec.cppo.ml" +(** pop and return the last element *) + let get_last_and_pop (d : t) = + let idx = d.len - 1 in + if idx < 0 then invalid_arg "Resize_array.get_last_and_pop"; + let last = Array.unsafe_get d.arr idx in + d.len <- idx + +# 381 "ext/vec.cppo.ml" + ; + Array.unsafe_set d.arr idx null + +# 384 "ext/vec.cppo.ml" + ; + last + +(** delete elements start from [idx] with length [len] *) + let delete_range (d : t) idx len = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.delete_range" ; + let arr = d.arr in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len + +# 396 "ext/vec.cppo.ml" + ; + for i = d_len - len to d_len - 1 do + Array.unsafe_set arr i null + done + +# 402 "ext/vec.cppo.ml" +(** delete elements from [idx] with length [len] return the deleted elements as a new vec*) + let get_and_delete_range (d : t) idx len : t = + let d_len = d.len in + if len < 0 || idx < 0 || idx + len > d_len then invalid_arg "Resize_array.get_and_delete_range" ; + let arr = d.arr in + let value = unsafe_sub arr idx len in + unsafe_blit arr (idx + len) arr idx (d_len - idx - len); + d.len <- d_len - len; + +# 412 "ext/vec.cppo.ml" + for i = d_len - len to d_len - 1 do + Array.unsafe_set arr i null + done; + +# 416 "ext/vec.cppo.ml" + {len = len ; arr = value} + + + (** Below are simple wrapper around normal Array operations *) + + let clear (d : t ) = + +# 424 "ext/vec.cppo.ml" + for i = 0 to d.len - 1 do + Array.unsafe_set d.arr i null + done; + +# 428 "ext/vec.cppo.ml" + d.len <- 0 + + + + let inplace_filter f (d : t) : unit = + let d_arr = d.arr in + let d_len = d.len in + let p = ref 0 in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 451 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + + +# 454 "ext/vec.cppo.ml" + let inplace_filter_from start f (d : t) : unit = + if start < 0 then invalid_arg "Vec.inplace_filter_from"; + let d_arr = d.arr in + let d_len = d.len in + let p = ref start in + for i = start to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + done ; + let last = !p in + +# 473 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + + +# 477 "ext/vec.cppo.ml" +(** inplace filter the elements and accumulate the non-filtered elements *) + let inplace_filter_with f ~cb_no acc (d : t) = + let d_arr = d.arr in + let p = ref 0 in + let d_len = d.len in + let acc = ref acc in + for i = 0 to d_len - 1 do + let x = Array.unsafe_get d_arr i in + if f x then + begin + let curr_p = !p in + (if curr_p <> i then + Array.unsafe_set d_arr curr_p x) ; + incr p + end + else + acc := cb_no x !acc + done ; + let last = !p in + +# 500 "ext/vec.cppo.ml" + delete_range d last (d_len - last) + +# 502 "ext/vec.cppo.ml" + ; !acc + + + +# 507 "ext/vec.cppo.ml" +end + +end +module String_vec : sig +#1 "string_vec.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 Vec_gen.S with type elt = string + +end = struct +#1 "string_vec.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. *) + + +include Resize_array.Make(struct type t = string let null = "" end) +end +module Ext_file_pp : sig +#1 "ext_file_pp.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. *) + + + + +type interval = { + loc_start : Lexing.position ; + loc_end : Lexing.position ; + action : out_channel -> int -> unit +} + +val process_wholes : + interval list -> + int -> ?line_directive:string -> in_channel -> out_channel -> unit + +(** Assume that there is no overlapp *) +val interval_compare : + interval -> interval -> int + +val patch_action: + String_vec.t -> + Lexing.position -> + Lexing.position -> + interval +(* +val cpp_process_file : + string -> (Lexing.position * Lexing.position) list -> out_channel -> unit*) + + + +end = struct +#1 "ext_file_pp.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. *) + +type action = + (out_channel -> int -> unit) + + + + +type interval = { + loc_start : Lexing.position ; + loc_end : Lexing.position ; + action : action +} + +let interval_compare x y = + Pervasives.compare (x.loc_start.pos_cnum : int) y.loc_start.pos_cnum + +(* + It tries to copy io stream from [ic] into [oc] + except it will skip those wholes, for each + whole a callback can be attached + When come across a whole, + it will print + - line directive (based on previous info) + - all content before +*) +let process_wholes + (whole_intervals : interval list ) + file_size + ?line_directive ic oc + = + let buf = Buffer.create 4096 in + let rec aux (cur, line, offset) wholes = + seek_in ic cur ; + begin match line_directive with + | Some fname -> + output_string oc "# "; + output_string oc (string_of_int line); + output_string oc " \""; + output_string oc fname; (* TOOD escape ? *) + output_string oc "\"\n"; + | None -> () + end; + if offset <> 0 then + begin + output_string oc (String.make offset ' ') + end; + let print next = + Buffer.add_channel buf ic (next - cur) ; + Buffer.output_buffer oc buf ; + Buffer.clear buf + in + match wholes with + | [] -> print file_size + | { + loc_start = + {Lexing.pos_cnum = start }; + loc_end = {Lexing.pos_cnum = stop; pos_bol ; pos_lnum} ; + action + } :: xs -> + let offset = stop - pos_bol in + print start ; + action oc offset ; + aux (stop, pos_lnum, offset) xs + in + aux (0, 1, 0) whole_intervals + + +let print_arrays file_array oc offset = + let indent = String.make offset ' ' in + let p_str s = + output_string oc indent ; + output_string oc s ; + output_string oc "\n" + in + let len = String_vec.length file_array in + match len with + | 0 + -> output_string oc "[ ]\n" + | 1 + -> output_string oc ("[ \"" ^ String_vec.get file_array 0 ^ "\" ]\n") + | _ (* first::(_::_ as rest) *) + -> + output_string oc "[ \n"; + String_vec.iter_range file_array ~from:0 ~to_:(len - 2 ) + (fun s -> p_str @@ "\"" ^ s ^ "\",") ; + p_str @@ "\"" ^ (String_vec.last file_array) ^ "\""; + + p_str "]" + +let patch_action file_array + loc_start loc_end = + {loc_start ; loc_end ; + action = print_arrays file_array + } + + +(* TODO: in the future, support [bspp.exe] + with line directive as well + *) +(*let cpp_process_file fname + (whole_intervals : (Lexing.position * Lexing.position) list) + oc = + let ic = open_in_bin fname in + let file_size = in_channel_length ic in + process_wholes ~line_directive:fname + (Ext_list.map (fun (x,y) -> {loc_start = x ; loc_end = y; action = Skip}) whole_intervals) + file_size ic oc ; + close_in ic *) + +end +module Set_gen += struct +#1 "set_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. *) +(* *) +(***********************************************************************) + +(** balanced tree based on stdlib distribution *) + +type ('a, 'id) t0 = + | Empty + | Node of ('a, 'id) t0 * 'a * ('a, 'id) t0 * int + +type ('a, 'id) enumeration0 = + | End | More of 'a * ('a, 'id) t0 * ('a, 'id) enumeration0 + + +let rec cons_enum s e = + match s with + | Empty -> e + | Node(l,v,r,_) -> cons_enum l (More(v,r,e)) + +let rec height = function + | Empty -> 0 + | Node(_,_,_,h) -> h + +(* Smallest and greatest element of a set *) + +let rec min_elt = function + Empty -> raise Not_found + | Node(Empty, v, r, _) -> v + | Node(l, v, r, _) -> min_elt l + +let rec max_elt = function + Empty -> raise Not_found + | Node(l, v, Empty, _) -> v + | Node(l, v, r, _) -> max_elt r + + + + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec elements_aux accu = function + | Empty -> accu + | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l + +let elements s = + elements_aux [] s + +let choose = min_elt + +let rec iter x f = match x with + | Empty -> () + | Node(l, v, r, _) -> iter l f ; f v; iter r f + +let rec fold s accu f = + match s with + | Empty -> accu + | Node(l, v, r, _) -> fold r (f v (fold l accu f)) f + +let rec for_all x p = match x with + | Empty -> true + | Node(l, v, r, _) -> p v && for_all l p && for_all r p + +let rec exists x p = match x with + | Empty -> false + | Node(l, v, r, _) -> p v || exists l p || exists r p + + +let max_int3 (a : int) b c = + if a >= b then + if a >= c then a + else c + else + if b >=c then b + else c +let max_int_2 (a : int) b = + if a >= b then a else b + + + +exception Height_invariant_broken +exception Height_diff_borken + +let rec check_height_and_diff = + function + | Empty -> 0 + | Node(l,_,r,h) -> + let hl = check_height_and_diff l in + let hr = check_height_and_diff r in + if h <> max_int_2 hl hr + 1 then raise Height_invariant_broken + else + let diff = (abs (hl - hr)) in + if diff > 2 then raise Height_diff_borken + else h + +let check tree = + ignore (check_height_and_diff tree) +(* + Invariants: + 1. {[ l < v < r]} + 2. l and r balanced + 3. [height l] - [height r] <= 2 +*) +let create l v r = + let hl = match l with Empty -> 0 | Node (_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node (_,_,_,h) -> h in + Node(l,v,r, if hl >= hr then hl + 1 else hr + 1) + +(* Same as create, but performs one step of rebalancing if necessary. + Invariants: + 1. {[ l < v < r ]} + 2. l and r balanced + 3. | height l - height r | <= 3. + + Proof by indunction + + Lemma: the height of [bal l v r] will bounded by [max l r] + 1 +*) +let internal_bal l v r = + let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> assert false + | Node(ll, lv, lr, _) -> + if height ll >= height lr then + (* [ll] >~ [lr] + [ll] >~ [r] + [ll] ~~ [ lr ^ r] + *) + create ll lv (create lr v r) + else begin + match lr with + Empty -> assert false + | Node(lrl, lrv, lrr, _)-> + (* [lr] >~ [ll] + [lr] >~ [r] + [ll ^ lrl] ~~ [lrr ^ r] + *) + create (create ll lv lrl) lrv (create lrr v r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> assert false + | Node(rl, rv, rr, _) -> + if height rr >= height rl then + create (create l v rl) rv rr + else begin + match rl with + Empty -> assert false + | Node(rll, rlv, rlr, _) -> + create (create l v rll) rlv (create rlr rv rr) + end + end else + Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1)) + +let rec remove_min_elt = function + Empty -> invalid_arg "Set.remove_min_elt" + | Node(Empty, v, r, _) -> r + | Node(l, v, r, _) -> internal_bal (remove_min_elt l) v r + +let singleton x = Node(Empty, x, Empty, 1) + +(* + All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. + weak form of [concat] +*) + +let internal_merge l r = + match (l, r) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> internal_bal l (min_elt r) (remove_min_elt r) + +(* Beware: those two functions assume that the added v is *strictly* + smaller (or bigger) than all the present elements in the tree; it + does not test for equality with the current min (or max) element. + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_element v = function + | Empty -> singleton v + | Node (l, x, r, h) -> + internal_bal (add_min_element v l) x r + +let rec add_max_element v = function + | Empty -> singleton v + | Node (l, x, r, h) -> + internal_bal l x (add_max_element v r) + +(** + Invariants: + 1. l < v < r + 2. l and r are balanced + + Proof by induction + The height of output will be ~~ (max (height l) (height r) + 2) + Also use the lemma from [bal] +*) +let rec internal_join l v r = + match (l, r) with + (Empty, _) -> add_min_element v r + | (_, Empty) -> add_max_element v l + | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) -> + if lh > rh + 2 then + (* proof by induction: + now [height of ll] is [lh - 1] + *) + internal_bal ll lv (internal_join lr v r) + else + if rh > lh + 2 then internal_bal (internal_join l v rl) rv rr + else create l v r + + +(* + Required Invariants: + [t1] < [t2] +*) +let internal_concat t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> internal_join t1 (min_elt t2) (remove_min_elt t2) + +let rec filter x p = match x with + | Empty -> Empty + | Node(l, v, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pv = p v in + let r' = filter r p in + if pv then internal_join l' v r' else internal_concat l' r' + + +let rec partition x p = match x with + | Empty -> (Empty, Empty) + | Node(l, v, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pv = p v in + let (rt, rf) = partition r p in + if pv + then (internal_join lt v rt, internal_concat lf rf) + else (internal_concat lt rt, internal_join lf v rf) + +let of_sorted_list l = + let rec sub n l = + match n, l with + | 0, l -> Empty, l + | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l + | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l + | 3, x0 :: x1 :: x2 :: l -> + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l + | n, l -> + let nl = n / 2 in + let left, l = sub nl l in + match l with + | [] -> assert false + | mid :: l -> + let right, l = sub (n - nl - 1) l in + create left mid right, l + in + fst (sub (List.length l) l) + +let of_sorted_array l = + let rec sub start n l = + if n = 0 then Empty else + if n = 1 then + let x0 = Array.unsafe_get l start in + Node (Empty, x0, Empty, 1) + else if n = 2 then + let x0 = Array.unsafe_get l start in + let x1 = Array.unsafe_get l (start + 1) in + Node (Node(Empty, x0, Empty, 1), x1, Empty, 2) else + if n = 3 then + let x0 = Array.unsafe_get l start in + let x1 = Array.unsafe_get l (start + 1) in + let x2 = Array.unsafe_get l (start + 2) in + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2) + else + let nl = n / 2 in + let left = sub start nl l in + let mid = start + nl in + let v = Array.unsafe_get l mid in + let right = sub (mid + 1) (n - nl - 1) l in + create left v right + in + sub 0 (Array.length l) l + +let is_ordered ~cmp tree = + let rec is_ordered_min_max tree = + match tree with + | Empty -> `Empty + | Node(l,v,r,_) -> + begin match is_ordered_min_max l with + | `No -> `No + | `Empty -> + begin match is_ordered_min_max r with + | `No -> `No + | `Empty -> `V (v,v) + | `V(l,r) -> + if cmp v l < 0 then + `V(v,r) + else + `No + end + | `V(min_v,max_v)-> + begin match is_ordered_min_max r with + | `No -> `No + | `Empty -> + if cmp max_v v < 0 then + `V(min_v,v) + else + `No + | `V(min_v_r, max_v_r) -> + if cmp max_v min_v_r < 0 then + `V(min_v,max_v_r) + else `No + end + end in + is_ordered_min_max tree <> `No + +let invariant ~cmp t = + check t ; + is_ordered ~cmp t + +let rec compare_aux ~cmp e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, r1, e1), More(v2, r2, e2)) -> + let c = cmp v1 v2 in + if c <> 0 + then c + else compare_aux ~cmp (cons_enum r1 e1) (cons_enum r2 e2) + +let compare ~cmp s1 s2 = + compare_aux ~cmp (cons_enum s1 End) (cons_enum s2 End) + + +module type S = sig + type elt + type t + val empty: t + val is_empty: t -> bool + val iter: t -> (elt -> unit) -> unit + val fold: t -> 'a -> (elt -> 'a -> 'a) -> 'a + val for_all: t -> (elt -> bool) -> bool + val exists: t -> (elt -> bool) -> bool + val singleton: elt -> t + val cardinal: t -> int + val elements: t -> elt list + val min_elt: t -> elt + val max_elt: t -> elt + val choose: t -> elt + val of_sorted_list : elt list -> t + val of_sorted_array : elt array -> t + val partition: t -> (elt -> bool) -> t * t + + val mem: t -> elt -> bool + val add: t -> elt -> t + val remove: t -> elt -> t + val union: t -> t -> t + val inter: t -> t -> t + val diff: t -> t -> t + val compare: t -> t -> int + val equal: t -> t -> bool + val subset: t -> t -> bool + val filter: t -> (elt -> bool) -> t + + val split: t -> elt -> t * bool * t + val find: t -> elt -> elt + val of_list: elt list -> t + val of_sorted_list : elt list -> t + val of_sorted_array : elt array -> t + val of_array : elt array -> t + val invariant : t -> bool + val print : Format.formatter -> t -> unit +end + +end +module String_set : sig +#1 "string_set.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 Set_gen.S with type elt = string +end = struct +#1 "string_set.ml" +# 1 "ext/set.cppo.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. *) + + +# 27 "ext/set.cppo.ml" +type elt = string +let compare_elt = Ext_string.compare +let print_elt = Format.pp_print_string + +# 49 "ext/set.cppo.ml" +type ('a, 'id) t0 = ('a, 'id) Set_gen.t0 = + | Empty + | Node of ('a, 'id) t0 * 'a * ('a, 'id) t0 * int + +type ('a, 'id) enumeration0 = ('a, 'id) Set_gen.enumeration0 = + | End + | More of 'a * ('a, 'id) t0 * ('a, 'id) enumeration0 + +type t = (elt, unit) t0 +type enumeration = (elt, unit) Set_gen.enumeration0 +let empty = Set_gen.empty +let is_empty = Set_gen.is_empty +let iter = Set_gen.iter +let fold = Set_gen.fold +let for_all = Set_gen.for_all +let exists = Set_gen.exists +let singleton = Set_gen.singleton +let cardinal = Set_gen.cardinal +let elements = Set_gen.elements +let min_elt = Set_gen.min_elt +let max_elt = Set_gen.max_elt +let choose = Set_gen.choose +let of_sorted_list = Set_gen.of_sorted_list +let of_sorted_array = Set_gen.of_sorted_array +let partition = Set_gen.partition +let filter = Set_gen.filter +let of_sorted_list = Set_gen.of_sorted_list +let of_sorted_array = Set_gen.of_sorted_array + +let rec split (tree : t) x : t * bool * t = match tree with + | Empty -> + (Empty, false, Empty) + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then (l, true, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Set_gen.internal_join rl v r) + else + let (lr, pres, rr) = split r x in (Set_gen.internal_join l v lr, pres, rr) +let rec add (tree : t) x : t = match tree with + | Empty -> Node(Empty, x, Empty, 1) + | Node(l, v, r, _) as t -> + let c = compare_elt x v in + if c = 0 then t else + if c < 0 then Set_gen.internal_bal (add l x ) v r else Set_gen.internal_bal l v (add r x ) + +let rec union (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> t2 + | (t1, Empty) -> t1 + | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> + if h1 >= h2 then + if h2 = 1 then add s1 v2 else begin + let (l2, _, r2) = split s2 v1 in + Set_gen.internal_join (union l1 l2) v1 (union r1 r2) + end + else + if h1 = 1 then add s2 v1 else begin + let (l1, _, r1) = split s1 v2 in + Set_gen.internal_join (union l1 l2) v2 (union r1 r2) + end + +let rec inter (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> Empty + | (t1, Empty) -> Empty + | (Node(l1, v1, r1, _), t2) -> + begin match split t2 v1 with + | (l2, false, r2) -> + Set_gen.internal_concat (inter l1 l2) (inter r1 r2) + | (l2, true, r2) -> + Set_gen.internal_join (inter l1 l2) v1 (inter r1 r2) + end + +let rec diff (s1 : t) (s2 : t) : t = + match (s1, s2) with + | (Empty, t2) -> Empty + | (t1, Empty) -> t1 + | (Node(l1, v1, r1, _), t2) -> + begin match split t2 v1 with + | (l2, false, r2) -> + Set_gen.internal_join (diff l1 l2) v1 (diff r1 r2) + | (l2, true, r2) -> + Set_gen.internal_concat (diff l1 l2) (diff r1 r2) + end + + +let rec mem (tree : t) x = match tree with + | Empty -> false + | Node(l, v, r, _) -> + let c = compare_elt x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : t) x : t = match tree with + | Empty -> Empty + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then Set_gen.internal_merge l r else + if c < 0 then Set_gen.internal_bal (remove l x) v r else Set_gen.internal_bal l v (remove r x ) + +let compare s1 s2 = Set_gen.compare ~cmp:compare_elt s1 s2 + + +let equal s1 s2 = + compare s1 s2 = 0 + +let rec subset (s1 : t) (s2 : t) = + match (s1, s2) with + | Empty, _ -> + true + | _, Empty -> + false + | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) -> + let c = compare_elt v1 v2 in + if c = 0 then + subset l1 l2 && subset r1 r2 + else if c < 0 then + subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2 + else + subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2 + + + + +let rec find (tree : t) x = match tree with + | Empty -> raise Not_found + | Node(l, v, r, _) -> + let c = compare_elt x v in + if c = 0 then v + else find (if c < 0 then l else r) x + + + +let of_list l = + match l with + | [] -> empty + | [x0] -> singleton x0 + | [x0; x1] -> add (singleton x0) x1 + | [x0; x1; x2] -> add (add (singleton x0) x1) x2 + | [x0; x1; x2; x3] -> add (add (add (singleton x0) x1 ) x2 ) x3 + | [x0; x1; x2; x3; x4] -> add (add (add (add (singleton x0) x1) x2 ) x3 ) x4 + | _ -> of_sorted_list (List.sort_uniq compare_elt l) + +let of_array l = + Ext_array.fold_left l empty (fun acc x -> add acc x ) + +(* also check order *) +let invariant t = + Set_gen.check t ; + Set_gen.is_ordered ~cmp:compare_elt t + +let print fmt s = + Format.fprintf + fmt "@[{%a}@]@." + (fun fmt s -> + iter s + (fun e -> Format.fprintf fmt "@[%a@],@ " + print_elt e) + ) + s + + + + + + +end +module Bsb_file_groups += struct +#1 "bsb_file_groups.ml" +(* Copyright (C) 2018- Authors of BuckleScript + * + * 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. *) + + + type public = + | Export_none + | Export_all + | Export_set of String_set.t + + +type build_generator = + { input : string list ; + output : string list; + command : string} + + +type file_group = + { dir : string ; + sources : Bsb_db.t; + resources : string list ; + public : public ; + dir_index : Bsb_dir_index.t ; + generators : build_generator list ; + (* output of [generators] should be added to [sources], + if it is [.ml,.mli,.re,.rei] + *) + } + +type file_groups = file_group list + (** + [intervals] are used for side effect so we can patch `bsconfig.json` to add new files + we need add a new line in the end, + otherwise it will be idented twice +*) + +type t = + { files : file_groups; + intervals : Ext_file_pp.interval list ; + globbed_dirs : string list ; + } + + + +let empty : t = { files = []; intervals = []; globbed_dirs = []; } + + + +let merge (u : t) (v : t) = + if u == empty then v + else if v == empty then u + else + { + files = Ext_list.append u.files v.files ; + intervals = Ext_list.append u.intervals v.intervals ; + globbed_dirs = Ext_list.append u.globbed_dirs v.globbed_dirs ; + } + + +(** when [is_empty file_group] + we don't need issue [-I] [-S] in [.merlin] file +*) +let is_empty (x : file_group) = + String_map.is_empty x.sources && + x.resources = [] && + x.generators = [] +end +module Ext_filename : sig +#1 "ext_filename.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. *) + + + + + +(* TODO: + Change the module name, this code is not really an extension of the standard + library but rather specific to JS Module name convention. +*) + + + + + +(** An extension module to calculate relative path follow node/npm style. + TODO : this short name will have to change upon renaming the file. +*) + +(** Js_output is node style, which means + separator is only '/' + + if the path contains 'node_modules', + [node_relative_path] will discard its prefix and + just treat it as a library instead +*) + +val cwd : string Lazy.t + +(* It is lazy so that it will not hit errors when in script mode *) +val package_dir : string Lazy.t + + +val simple_convert_node_path_to_os_path : string -> string + + +end = struct +#1 "ext_filename.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. *) + + + + + + + + +type t = Ext_path.t + +let cwd = lazy (Sys.getcwd ()) + + + + +(* Input must be absolute directory *) +let rec find_root_filename ~cwd filename = + if Sys.file_exists ( Filename.concat 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 = + find_root_filename ~cwd Literals.bsconfig_json + +let package_dir = lazy (find_package_json_dir (Lazy.force cwd)) + + + + + + + + +let simple_convert_node_path_to_os_path = + if Sys.unix then fun x -> x + else if Sys.win32 || Sys.cygwin then + Ext_string.replace_slash_backward + else failwith ("Unknown OS : " ^ Sys.os_type) + + + +end +module Ext_namespace : sig +#1 "ext_namespace.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + +(** [make ~ns "a" ] + A typical example would return "a-Ns" + Note the namespace comes from the output of [namespace_of_package_name] +*) +val make : ns:string -> string -> string + +val try_split_module_name : + string -> (string * string ) option + +(** [ends_with_bs_suffix_then_chop filename] + is used to help we have dangling modules +*) +val ends_with_bs_suffix_then_chop : + string -> string option + + +(* Note we have to output uncapitalized file Name, + or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` + relevant issues: #1609, #913 + + #1933 when removing ns suffix, don't pass the bound + of basename +*) +val js_name_of_basename : + bool -> + string -> string + +type file_kind = + | Upper_js + | Upper_bs + | Little_js + | Little_bs + (** [js_name_of_modulename ~little A-Ns] + *) +val js_name_of_modulename : file_kind -> string -> string + +(* TODO handle cases like + '@angular/core' + its directory structure is like + {[ + @angular + |-------- core + ]} +*) +val is_valid_npm_package_name : string -> bool + +val namespace_of_package_name : string -> string + +end = struct +#1 "ext_namespace.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. *) + + +(* Note the build system should check the validity of filenames + espeically, it should not contain '-' +*) +let ns_sep_char = '-' +let ns_sep = "-" + +let make ~ns cunit = + cunit ^ ns_sep ^ ns + +let path_char = Filename.dir_sep.[0] + +let rec rindex_rec s i = + if i < 0 then i else + let char = String.unsafe_get s i in + if char = path_char then -1 + else if char = ns_sep_char then i + else + rindex_rec s (i - 1) + +let remove_ns_suffix name = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name + else String.sub name 0 i + +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else + Some (String.sub name (i+1) (len - i - 1), + String.sub name 0 i ) +type file_kind = + | Upper_js + | Upper_bs + | Little_js + | Little_bs + +let suffix_js = ".js" +let bs_suffix_js = ".bs.js" + +let ends_with_bs_suffix_then_chop s = + Ext_string.ends_with_then_chop s bs_suffix_js + +let js_name_of_basename bs_suffix s = + remove_ns_suffix s ^ + (if bs_suffix then bs_suffix_js else suffix_js ) + +let js_name_of_modulename little s = + match little with + | Little_js -> + remove_ns_suffix (Ext_string.uncapitalize_ascii s) ^ suffix_js + | Little_bs -> + remove_ns_suffix (Ext_string.uncapitalize_ascii s) ^ bs_suffix_js + | Upper_js -> + remove_ns_suffix s ^ suffix_js + | Upper_bs -> + remove_ns_suffix s ^ bs_suffix_js + +(* https://docs.npmjs.com/files/package.json + Some rules: + The name must be less than or equal to 214 characters. This includes the scope for scoped packages. + The name can't start with a dot or an underscore. + New packages must not have uppercase letters in the name. + The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. +*) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 && (* magic number forced by npm *) + len > 0 && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 + (fun x -> + match x with + | 'a'..'z' | '0'..'9' | '_' | '-' -> true + | _ -> false ) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Buffer.create len in + let add capital ch = + Buffer.add_char buf + (if capital then + (Ext_char.uppercase_ascii ch) + else ch) in + let rec aux capital off len = + if off >= len then () + else + let ch = String.unsafe_get s off in + match ch with + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + -> + add capital ch ; + aux false (off + 1) len + | '/' + | '-' -> + aux true (off + 1) len + | _ -> aux capital (off+1) len + in + aux true 0 len ; + Buffer.contents buf + +end +module Ext_option : sig +#1 "ext_option.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. *) + + + + + + + + +(** Utilities for [option] type *) + +val map : 'a option -> ('a -> 'b) -> 'b option + +val iter : 'a option -> ('a -> unit) -> unit + +val exists : 'a option -> ('a -> bool) -> bool +end = struct +#1 "ext_option.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 map v f = + match v with + | None -> None + | Some x -> Some (f x ) + +let iter v f = + match v with + | None -> () + | Some x -> f x + +let exists v f = + match v with + | None -> false + | Some x -> f x +end +module Bsb_parse_sources : sig +#1 "bsb_parse_sources.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. *) + + + +(** [scan .. cxt json] + entry is to the [sources] in the schema + given a root, return an object which is + all relative paths, this function will do the IO +*) +val scan : + not_dev: bool -> + root: string -> + cut_generators: bool -> + namespace : string option -> + clean_staled_bs_js:bool -> + ignored_dirs:String_set.t -> + Ext_json_types.t -> + Bsb_file_groups.t + +(** This function has some duplication + from [scan], + the parsing assuming the format is + already valid +*) +val clean_re_js: + string -> unit +end = struct +#1 "bsb_parse_sources.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. *) + + + +type build_generator = Bsb_file_groups.build_generator + +type public = Bsb_file_groups.public + +type file_group = Bsb_file_groups.file_group + +type t = Bsb_file_groups.t + +let is_input_or_output (xs : build_generator list) (x : string) = + Ext_list.exists xs (fun {input; output} -> + let it_is = fun y -> y = x in + Ext_list.exists input it_is || + Ext_list.exists output it_is + ) + +let warning_unused_file : _ format = + "@{IGNORED@}: file %s under %s is ignored because it can't be turned into a valid module name. The build system transforms a file name into a module name by upper-casing the first letter@." + +type cxt = { + not_dev : bool ; + dir_index : Bsb_dir_index.t ; + cwd : string ; + root : string; + cut_generators : bool; + traverse : bool; + namespace : string option; + clean_staled_bs_js: bool; + ignored_dirs : String_set.t +} + +(** [public] has a list of modules, we do a sanity check to see if all the listed + modules are indeed valid module components +*) +let collect_pub_modules + (xs : Ext_json_types.t array) + (cache : Bsb_db.t) : String_set.t = + let set = ref String_set.empty in + for i = 0 to Array.length xs - 1 do + let v = Array.unsafe_get xs i in + match v with + | Str { str ; loc } + -> + if String_map.mem cache str then + set := String_set.add !set str + else + begin + Bsb_log.warn + "@{IGNORED@} %S in public is ignored since it is not\ + an existing module@." str + end + | _ -> + Bsb_exception.errorf + ~loc:(Ext_json.loc_of v) + "public excpect a list of strings" + done ; + !set + +let extract_pub (input : Ext_json_types.t String_map.t) (cur_sources : Bsb_db.t) = + match String_map.find_opt input Bsb_build_schemas.public with + | Some (Str{str = s; loc}) -> + if s = Bsb_build_schemas.export_all then (Export_all : public) else + if s = Bsb_build_schemas.export_none then Export_none else + Bsb_exception.errorf ~loc "invalid str for %s " s + | Some (Arr {content = s}) -> + Export_set (collect_pub_modules s cur_sources) + | Some config -> + Bsb_exception.config_error config "expect array or string" + | None -> + Export_all + +let extract_resources (input : Ext_json_types.t String_map.t) = + match String_map.find_opt input Bsb_build_schemas.resources with + | Some (Arr {content = s}) -> + Bsb_build_util.get_list_string s + | Some config -> + Bsb_exception.config_error config + "expect array " + | None -> [] + + +let handle_empty_sources + ( cur_sources : Bsb_db.t ref) + dir + (file_array : string array Lazy.t) + ({loc_start; loc_end} : Ext_json_types.json_array) + generators + : Ext_file_pp.interval list = + let files_array = Lazy.force file_array in + let dyn_file_array = String_vec.make (Array.length files_array) in + let files = + Ext_array.fold_left files_array !cur_sources (fun acc name -> + if is_input_or_output generators name then acc + else + match Ext_string.is_valid_source_name name with + | Good -> begin + let new_acc = Bsb_db.collect_module_by_filename ~dir acc name in + String_vec.push dyn_file_array name; + new_acc + end + | Invalid_module_name -> + Bsb_log.warn + warning_unused_file name dir ; + acc + | Suffix_mismatch -> acc + ) in + cur_sources := files ; + [ Ext_file_pp.patch_action dyn_file_array + loc_start loc_end + ] + (* , + files *) + + +let extract_input_output + (loc_start : Ext_position.t) + (content : Ext_json_types.t array) : string list * string list = + let error () = + Bsb_exception.errorf ~loc:loc_start {| invalid edge format, expect ["output" , ":", "input" ]|} + in + match Ext_array.find_and_split content + (fun x () -> match x with Str { str =":"} -> true | _ -> false ) + () with + | `No_split -> error () + | `Split ( output, input) -> + (Ext_array.to_list_map (fun (x : Ext_json_types.t) -> + match x with + | Str {str = ":"} -> + error () + | Str {str } -> + Some str + | _ -> None) output + , + Ext_array.to_list_map (fun (x : Ext_json_types.t) -> + match x with + | Str {str = ":"} -> + error () + | Str {str} -> + Some str (* More rigirous error checking: It would trigger a ninja syntax error *) + | _ -> None) input) + +let extract_generators + (input : Ext_json_types.t String_map.t) + (cut_generators_or_not_dev : bool) + (dir : string) + (cur_sources : Bsb_db.t ref) + : build_generator list = + let generators : build_generator list ref = ref [] in + begin match String_map.find_opt input Bsb_build_schemas.generators with + | Some (Arr { content ; loc_start}) -> + (* Need check is dev build or not *) + Ext_array.iter content (fun x -> + match x with + | Obj { map = generator; loc} -> + begin match String_map.find_opt generator Bsb_build_schemas.name , + String_map.find_opt generator Bsb_build_schemas.edge + with + | Some (Str{str = command}), Some (Arr {content })-> + + let output, input = extract_input_output loc_start content in + if not cut_generators_or_not_dev then begin + generators := {input ; output ; command } :: !generators + end; + (* ATTENTION: Now adding output as source files, + it may be re-added again later when scanning files (not explicit files input) + *) + output |> List.iter begin fun output -> + match Ext_string.is_valid_source_name output with + | Good -> + cur_sources := Bsb_db.collect_module_by_filename ~dir !cur_sources output + | Invalid_module_name -> + Bsb_log.warn warning_unused_file output dir + | Suffix_mismatch -> () + end + | _ -> + Bsb_exception.errorf ~loc "Invalid generator format" + end + | _ -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x) "Invalid generator format" + ) + | Some x -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x ) "Invalid generator format" + | None -> () + end ; + !generators + +(** [parsing_source_dir_map cxt input] + Major work done in this function, + assume [not_dev && not (Bsb_dir_index.is_lib_dir dir_index)] + is already checked, so we don't need check it again +*) +let try_unlink s = + try Unix.unlink s + with _ -> + Bsb_log.info "@{Failed to remove %s}@." s + + +(** This is the only place where we do some removal during scanning, + configurabl +*) +let clean_staled_bs_js_files + (context : cxt) + (cur_sources : _ String_map.t ) + (files : string array) = + Ext_array.iter files (fun current_file -> + match Ext_namespace.ends_with_bs_suffix_then_chop current_file with + | None -> () + | Some basename -> (* Found [.bs.js] files *) + let parent = Filename.concat context.root context.cwd in + let lib_parent = + Filename.concat (Filename.concat context.root Bsb_config.lib_bs) + context.cwd in + if not (String_map.mem cur_sources (Ext_string.capitalize_ascii basename) ) then + begin + Unix.unlink (Filename.concat parent current_file); + let basename = + match context.namespace with + | None -> basename + | Some ns -> Ext_namespace.make ~ns basename in + ( + match Sys.getenv "BS_CMT_POST_PROCESS_CMD" with + | exception _ -> () + | cmd -> + Ext_pervasives.try_it (fun _ -> + Sys.command ( + cmd ^ + " -cmt-rm " ^ + Filename.concat lib_parent (basename ^ Literals.suffix_cmt)) + ) + ); + Ext_list.iter [ + Literals.suffix_cmi; Literals.suffix_cmj ; + Literals.suffix_cmt; Literals.suffix_cmti ; + Literals.suffix_mlast; Literals.suffix_mlastd; + Literals.suffix_mliast; Literals.suffix_mliastd + (*TODO: GenType*) + ] (fun suffix -> + try_unlink (Filename.concat lib_parent (basename ^ suffix)) + ) + end + ) + +let rec + parsing_source_dir_map + ({ cwd = dir;} as cxt ) + (input : Ext_json_types.t String_map.t) : t + = + if String_set.mem cxt.ignored_dirs dir then Bsb_file_groups.empty + else + let cur_update_queue = ref [] in + let cur_globbed_dirs = ref [] in + let cur_sources = ref String_map.empty in + let generators = + extract_generators input (cxt.cut_generators || cxt.not_dev) dir + cur_sources + in + let sub_dirs_field = String_map.find_opt input Bsb_build_schemas.subdirs in + let file_array = lazy (Sys.readdir (Filename.concat cxt.root dir)) in + begin + match String_map.find_opt input Bsb_build_schemas.files with + | None -> (* No setting on [!files]*) + (** We should avoid temporary files *) + cur_sources := + Ext_array.fold_left (Lazy.force file_array) !cur_sources (fun acc name -> + if is_input_or_output generators name then + acc + else + match Ext_string.is_valid_source_name name with + | Good -> + Bsb_db.collect_module_by_filename ~dir acc name + | Invalid_module_name -> + Bsb_log.warn + warning_unused_file + name dir + ; + acc + | Suffix_mismatch -> acc + ) ; + cur_globbed_dirs := [dir] + | Some (Arr ({content = [||] }as empty_json_array)) -> + (* [ ] populatd by scanning the dir (just once) *) + cur_update_queue := + handle_empty_sources cur_sources cxt.cwd + file_array + empty_json_array + generators + | Some (Arr {loc_start;loc_end; content = sx }) -> + (* [ a,b ] populated by users themselves + TODO: still need check? + *) + cur_sources := + Ext_array.fold_left sx !cur_sources (fun acc s -> + match s with + | Str str -> + Bsb_db.collect_module_by_filename ~dir acc str.str + | _ -> acc + ) + | Some (Obj {map = m; loc} ) -> (* { excludes : [], slow_re : "" }*) + cur_globbed_dirs := [dir]; + let excludes = + match String_map.find_opt m Bsb_build_schemas.excludes with + | None -> [] + | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr + | Some x -> Bsb_exception.config_error x "excludes expect array "in + let slow_re = String_map.find_opt m Bsb_build_schemas.slow_re in + let predicate = + match slow_re, excludes with + | Some (Str {str = s}), [] -> + let re = Str.regexp s in + fun name -> Str.string_match re name 0 + | Some (Str {str = s}) , _::_ -> + let re = Str.regexp s in + fun name -> Str.string_match re name 0 && not (List.mem name excludes) + | Some x, _ -> Bsb_exception.errorf ~loc "slow-re expect a string literal" + | None , _ -> Bsb_exception.errorf ~loc "missing field: slow-re" in + cur_sources := Ext_array.fold_left (Lazy.force file_array) !cur_sources (fun acc name -> + if is_input_or_output generators name || not (predicate name) then acc + else + Bsb_db.collect_module_by_filename ~dir acc name + ) + | Some x -> Bsb_exception.config_error x "files field expect array or object " + end; + let cur_sources = !cur_sources in + let resources = extract_resources input in + let public = extract_pub input cur_sources in + (** Doing recursive stuff *) + let children = + match sub_dirs_field, + cxt.traverse with + | None , true + | Some (True _), _ -> + let root = cxt.root in + let parent = Filename.concat root dir in + Ext_array.fold_left (Lazy.force file_array) Bsb_file_groups.empty (fun origin x -> + if not (String_set.mem cxt.ignored_dirs x) && + Sys.is_directory (Filename.concat parent x) then + Bsb_file_groups.merge + ( + parsing_source_dir_map + {cxt with + cwd = Ext_path.concat cxt.cwd + (Ext_filename.simple_convert_node_path_to_os_path x); + traverse = true + } String_map.empty) origin + else origin + ) + (* readdir parent avoiding scanning twice *) + | None, false + | Some (False _), _ -> Bsb_file_groups.empty + | Some s, _ -> parse_sources cxt s + in + (** Do some clean up *) + if cxt.clean_staled_bs_js then + begin + clean_staled_bs_js_files cxt cur_sources (Lazy.force file_array ) + end; + Bsb_file_groups.merge { + files = [ { dir ; + sources = cur_sources; + resources ; + public ; + dir_index = cxt.dir_index ; + generators } ] ; + intervals = !cur_update_queue ; + globbed_dirs = !cur_globbed_dirs ; + } children + + +and parsing_single_source ({not_dev; dir_index ; cwd} as cxt ) (x : Ext_json_types.t ) + : t = + match x with + | Str { str = dir } -> + if not_dev && not (Bsb_dir_index.is_lib_dir dir_index) then + Bsb_file_groups.empty + else + parsing_source_dir_map + {cxt with + cwd = Ext_path.concat cwd (Ext_filename.simple_convert_node_path_to_os_path dir)} + String_map.empty + | Obj {map} -> + let current_dir_index = + match String_map.find_opt map Bsb_build_schemas.type_ with + | Some (Str {str="dev"}) -> + Bsb_dir_index.get_dev_index () + | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} + | None -> dir_index in + if not_dev && not (Bsb_dir_index.is_lib_dir current_dir_index) then + Bsb_file_groups.empty + else + let dir = + match String_map.find_opt map Bsb_build_schemas.dir with + | Some (Str{str}) -> + Ext_filename.simple_convert_node_path_to_os_path str + | Some x -> Bsb_exception.config_error x "dir expected to be a string" + | None -> + Bsb_exception.config_error x + ( + "required field :" ^ Bsb_build_schemas.dir ^ " missing" ) + + in + parsing_source_dir_map + {cxt with dir_index = current_dir_index; + cwd= Ext_path.concat cwd dir} map + | _ -> Bsb_file_groups.empty +and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = + Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> + Bsb_file_groups.merge (parsing_single_source cxt x) origin + ) +and parse_sources ( cxt : cxt) (sources : Ext_json_types.t ) = + match sources with + | Arr file_groups -> + parsing_arr_sources cxt file_groups.content + | _ -> parsing_single_source cxt sources + + + +let scan + ~not_dev + ~root + ~cut_generators + ~namespace + ~clean_staled_bs_js + ~ignored_dirs + x = + parse_sources { + ignored_dirs; + not_dev; + dir_index = Bsb_dir_index.lib_dir_index; + cwd = Filename.current_dir_name; + root ; + cut_generators; + namespace; + clean_staled_bs_js; + traverse = false + } x + + + +(* Walk through to do some work *) +type walk_cxt = { + cwd : string ; + root : string; + traverse : bool; + ignored_dirs : String_set.t; + } + +let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = + match sources with + | Arr {content} -> + Ext_array.iter content (fun x -> walk_single_source cxt x) + | x -> walk_single_source cxt x +and walk_single_source cxt (x : Ext_json_types.t) = + match x with + | Str {str = dir} + -> + let dir = Ext_filename.simple_convert_node_path_to_os_path dir in + walk_source_dir_map + {cxt with cwd = Ext_path.concat cxt.cwd dir } None + | Obj {map} -> + begin match String_map.find_opt map Bsb_build_schemas.dir with + | Some (Str{str}) -> + let dir = Ext_filename.simple_convert_node_path_to_os_path str in + walk_source_dir_map + {cxt with cwd = Ext_path.concat cxt.cwd dir} (String_map.find_opt map Bsb_build_schemas.subdirs) + | _ -> () + end + | _ -> () +and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = + let working_dir = Filename.concat cxt.root cxt.cwd in + if not (String_set.mem cxt.ignored_dirs cxt.cwd) then begin + let file_array = Sys.readdir working_dir in + (* Remove .re.js when clean up *) + Ext_array.iter file_array begin fun file -> + if Ext_string.ends_with file Literals.suffix_gen_js + || Ext_string.ends_with file Literals.suffix_gen_tsx + then + Sys.remove (Filename.concat working_dir file) + end; + let cxt_traverse = cxt.traverse in + match sub_dirs_field, cxt_traverse with + | None, true + | Some(True _), _ -> + Ext_array.iter file_array begin fun f -> + if not (String_set.mem cxt.ignored_dirs f) && + Sys.is_directory (Filename.concat working_dir f ) then + walk_source_dir_map + {cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_filename.simple_convert_node_path_to_os_path f); + traverse = true + } None + end + | None, _ + | Some (False _), _ -> () + | Some s, _ -> walk_sources cxt s + end +(* It makes use of the side effect when [walk_sources], removing suffix_re_js, + TODO: make it configurable + *) +let clean_re_js root = + match Ext_json_parse.parse_json_from_file + (Filename.concat root Literals.bsconfig_json) with + | Obj { map } -> + let ignored_dirs = + match String_map.find_opt map Bsb_build_schemas.ignored_dirs with + | Some (Arr {content = x}) -> String_set.of_list (Bsb_build_util.get_list_string x ) + | Some _ + | None -> String_set.empty + in + Ext_option.iter (String_map.find_opt map Bsb_build_schemas.sources) begin fun config -> + Ext_pervasives.try_it (fun () -> + walk_sources { root ; + traverse = true; + cwd = Filename.current_dir_name; + ignored_dirs + } config + ) + end + | _ -> () + | exception _ -> () + +end +module Bsb_unix : sig +#1 "bsb_unix.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. *) + +type command = + { + cmd : string ; + cwd : string ; + args : string array + } + + +val command_fatal_error : command -> int -> unit + +val run_command_execv : command -> int + + +val remove_dir_recursive : string -> unit +end = struct +#1 "bsb_unix.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. *) + + + +type command = + { + cmd : string ; + cwd : string ; + args : string array + } + + +let log cmd = + Bsb_log.info "@{Entering@} %s @." cmd.cwd ; + Bsb_log.info "@{Cmd:@} " ; + Bsb_log.info_args cmd.args + +let command_fatal_error cmd eid = + Bsb_log.error "@{Failure:@} %s \n Location: %s@." cmd.cmd cmd.cwd; + exit eid + +let run_command_execv_unix cmd : int = + match Unix.fork () with + | 0 -> + log cmd; + Unix.chdir cmd.cwd; + Unix.execv cmd.cmd cmd.args + | pid -> + match Unix.waitpid [] pid with + | pid, process_status -> + match process_status with + | Unix.WEXITED eid -> + eid + | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> + Bsb_log.error "@{Interrupted:@} %s@." cmd.cmd; + 2 + + + +(** TODO: the args are not quoted, here + we are calling a very limited set of `bsb` commands, so that + we are safe +*) +let run_command_execv_win (cmd : command) = + let old_cwd = Unix.getcwd () in + log cmd; + Unix.chdir cmd.cwd; + let eid = + Sys.command + (String.concat Ext_string.single_space + ( Filename.quote cmd.cmd ::( List.tl @@ Array.to_list cmd.args))) in + Bsb_log.info "@{Leaving@} %s => %s @." cmd.cwd old_cwd; + Unix.chdir old_cwd; + eid + + +let run_command_execv = + if Ext_sys.is_windows_or_cygwin then + run_command_execv_win + else run_command_execv_unix +(** it assume you have permissions, so always catch it to fail + gracefully +*) + +let rec remove_dir_recursive dir = + if Sys.is_directory dir then + begin + let files = Sys.readdir dir in + for i = 0 to Array.length files - 1 do + remove_dir_recursive (Filename.concat dir (Array.unsafe_get files i)) + done ; + Unix.rmdir dir + end + else Sys.remove dir + +end +module Bsb_clean : sig +#1 "bsb_clean.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +(** clean bsc generated artifacts. + TODO: clean staled in source js artifacts +*) + +val clean_bs_deps : string -> string -> unit + +val clean_self : string -> string -> unit + +end = struct +#1 "bsb_clean.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + + +let ninja_clean bsc_dir proj_dir = + try + let cmd = bsc_dir // "ninja.exe" in + let cwd = proj_dir // Bsb_config.lib_bs in + if Sys.file_exists cwd then + let eid = + Bsb_unix.run_command_execv {cmd ; args = [|cmd; "-t"; "clean"|] ; cwd} in + if eid <> 0 then + Bsb_log.warn "@{ninja clean failed@}@." + with e -> + Bsb_log.warn "@{ninja clean failed@} : %s @." (Printexc.to_string e) + +let clean_bs_garbage bsc_dir proj_dir = + Bsb_log.info "@{Cleaning:@} in %s@." proj_dir ; + let try_remove x = + let x = proj_dir // x in + if Sys.file_exists x then + Bsb_unix.remove_dir_recursive x in + try + Bsb_parse_sources.clean_re_js proj_dir; (* clean re.js files*) + ninja_clean bsc_dir proj_dir ; + List.iter try_remove Bsb_config.all_lib_artifacts; + with + e -> + Bsb_log.warn "@{Failed@} to clean due to %s" (Printexc.to_string e) + + +let clean_bs_deps bsc_dir proj_dir = + Bsb_build_util.walk_all_deps proj_dir (fun pkg_cxt -> + (* whether top or not always do the cleaning *) + clean_bs_garbage bsc_dir pkg_cxt.cwd + ) + +let clean_self bsc_dir proj_dir = clean_bs_garbage bsc_dir proj_dir + +end +module Bsb_package_specs : sig +#1 "bsb_package_specs.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t + + +val default_package_specs : t + +val from_json: + Ext_json_types.t -> t + +val get_list_of_output_js : + t -> bool -> string -> string list + +(** + Sample output: {[ -bs-package-output commonjs:lib/js/jscomp/test]} +*) +val package_flag_of_package_specs : + t -> string -> string + + +end = struct +#1 "bsb_package_specs.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + +let common_js_prefix p = Bsb_config.lib_js // p +let amd_js_prefix p = Bsb_config.lib_amd // p +let es6_prefix p = Bsb_config.lib_es6 // p +let es6_global_prefix p = Bsb_config.lib_es6_global // p +let amdjs_global_prefix p = Bsb_config.lib_amd_global // p + +type spec = { + format : string; + in_source : bool +} + +module Spec_set = Set.Make( struct type t = spec + let compare = Pervasives.compare + end) + +type t = Spec_set.t + + + +let supported_format x = + x = Literals.amdjs || + x = Literals.commonjs || + x = Literals.es6 || + x = Literals.es6_global || + x = Literals.amdjs_global + +let bad_module_format_message_exn ~loc format = + Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s, %s, %s or %s" + format + Literals.amdjs + Literals.commonjs + Literals.es6 + Literals.es6_global + Literals.amdjs_global + +let rec from_array (arr : Ext_json_types.t array) : Spec_set.t = + let spec = ref Spec_set.empty in + let has_in_source = ref false in + Ext_array.iter arr (fun x -> + let result = from_json_single x in + if result.in_source then + ( + if not !has_in_source then + has_in_source:= true + else + Bsb_exception.errorf + ~loc:(Ext_json.loc_of x) + "package-specs: we've detected two module formats that are both configured to be in-source." + ); + spec := Spec_set.add result !spec + ); + !spec + +(* TODO: FIXME: better API without mutating *) +and from_json_single (x : Ext_json_types.t) : spec = + match x with + | Str {str = format; loc } -> + if supported_format format then + {format ; in_source = false } + else + (bad_module_format_message_exn ~loc format) + | Obj {map; loc} -> + begin match String_map.find_exn map "module" with + | Str {str = format} -> + let in_source = + match String_map.find_opt map Bsb_build_schemas.in_source with + | Some (True _) -> true + | Some _ + | None -> false + in + if supported_format format then + {format ; in_source } + else + bad_module_format_message_exn ~loc format + | Arr _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, `module` field should be a string, not an array. If you want to pass multiple module specs, try turning package-specs into an array of objects (or strings) instead." + | _ -> + Bsb_exception.errorf ~loc + "package-specs: the `module` field of the configuration object should be a string." + | exception _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, the `module` field is mandatory." + end + | _ -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: we expect either a string or an object." + +let from_json (x : Ext_json_types.t) : Spec_set.t = + match x with + | Arr {content ; _} -> from_array content + | _ -> Spec_set.singleton (from_json_single x ) + + +let bs_package_output = "-bs-package-output" + +(** Assume input is valid + {[ -bs-package-output commonjs:lib/js/jscomp/test ]} +*) +let package_flag ({format; in_source } : spec) dir = + Ext_string.inter2 + bs_package_output + (Ext_string.concat3 + format + Ext_string.single_colon + (if in_source then dir else + (if format = Literals.amdjs then + amd_js_prefix dir + else if format = Literals.commonjs then + common_js_prefix dir + else if format = Literals.es6 then + es6_prefix dir + else if format = Literals.es6_global then + es6_global_prefix dir + else if format = Literals.amdjs_global then + amdjs_global_prefix dir + else assert false)) + ) + +let package_flag_of_package_specs (package_specs : t) + (dirname : string ) = + (Spec_set.fold (fun format acc -> + Ext_string.inter2 acc (package_flag format dirname ) + + ) package_specs Ext_string.empty) + +let default_package_specs = + Spec_set.singleton + { format = Literals.commonjs ; in_source = false } +(** js output for each package *) +let package_output ({format; in_source } : spec) output= + + let prefix = + if in_source then fun x -> x + else + (if format = Literals.commonjs then + common_js_prefix + else if format = Literals.amdjs then + amd_js_prefix + else if format = Literals.es6 then + es6_prefix + else if format = Literals.es6_global then + es6_global_prefix + else if format = Literals.amdjs_global then + amdjs_global_prefix + else assert false) + in + (Bsb_config.proj_rel @@ prefix output ) + +(** + [get_list_of_output_js specs "src/hi/hello"] + +*) +let get_list_of_output_js + package_specs + bs_suffix + output_file_sans_extension = + Spec_set.fold + (fun format acc -> + package_output format + ( Ext_namespace.js_name_of_basename bs_suffix + output_file_sans_extension) + :: acc + ) package_specs [] + + +end +module Bsb_warning : sig +#1 "bsb_warning.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + + + +type t + +val get_warning_flag : t option -> string + +val default_warning : string + +val default_warning_flag : string +(* default_warning, including the -w prefix, for command-line arguments *) + +val from_map : Ext_json_types.t String_map.t -> t option + +(** [opt_warning_to_string not_dev warning] +*) +val opt_warning_to_string : bool -> t option -> string + + +end = struct +#1 "bsb_warning.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + +type warning_error = + | Warn_error_false + (* default [false] to make our changes non-intrusive *) + | Warn_error_true + | Warn_error_number of string + +type t = { + number : string option; + error : warning_error +} + +(** + See the meanings of the warning codes here: https://caml.inria.fr/pub/docs/manual-ocaml/comp.html#sec281 + + - 30 Two labels or constructors of the same name are defined in two mutually recursive types. + - 40 Constructor or label name used out of scope. + + - 6 Label omitted in function application. + - 7 Method overridden. + - 9 Missing fields in a record pattern. (*Not always desired, in some cases need [@@@warning "+9"] *) + - 27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn’t start with an underscore (_) character. + - 29 Unescaped end-of-line in a string constant (non-portable code). + - 32 .. 39 Unused blabla + - 44 Open statement shadows an already defined identifier. + - 45 Open statement shadows an already defined label or constructor. + - 48 Implicit elimination of optional arguments. https://caml.inria.fr/mantis/view.php?id=6352 + - 101 (bsb-specific) unsafe polymorphic comparison. +*) +let default_warning = "-30-40+6+7+27+32..39+44+45+101" + +let default_warning_flag = "-w " ^ default_warning + +let get_warning_flag x = + default_warning_flag ^ + (match x with + | Some {number =None} + | None -> Ext_string.empty + | Some {number = Some x} -> Ext_string.trim x ) + + +let warn_error = " -warn-error A" + +let warning_to_string not_dev + warning : string = + default_warning_flag ^ + (match warning.number with + | None -> + Ext_string.empty + | Some x -> + Ext_string.trim x) ^ + if not_dev then Ext_string.empty + else + match warning.error with + | Warn_error_true -> + warn_error + + | Warn_error_number y -> + " -warn-error " ^ y + | Warn_error_false -> + Ext_string.empty + + + +let from_map (m : Ext_json_types.t String_map.t) = + let number_opt = String_map.find_opt m Bsb_build_schemas.number in + let error_opt = String_map.find_opt m Bsb_build_schemas.error in + match number_opt, error_opt with + | None, None -> None + | _, _ -> + let error = + match error_opt with + | Some (True _) -> Warn_error_true + | Some (False _) -> Warn_error_false + | Some (Str {str ; }) + -> Warn_error_number str + | Some x -> Bsb_exception.config_error x "expect true/false or string" + | None -> Warn_error_false + (** To make it less intrusive : warning error has to be enabled*) + in + let number = + match number_opt with + | Some (Str { str = number}) -> Some number + | None -> None + | Some x -> Bsb_exception.config_error x "expect a string" + in + Some {number; error } + +let opt_warning_to_string not_dev warning = + match warning with + | None -> default_warning_flag + | Some w -> warning_to_string not_dev w + + +end +module Hash_set_gen += struct +#1 "hash_set_gen.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. *) + + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) + +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a list array; (* the buckets *) + initial_size: int; (* initial array size *) + } + + + + +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; data = Array.make s [] } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + Array.unsafe_set h.data i [] + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size [ ] + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + +let iter h f = + let rec do_bucket = function + | [ ] -> + () + | k :: rest -> + f k ; 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 h init f = + let rec do_bucket b accu = + match b with + [ ] -> + accu + | k :: rest -> + do_bucket rest (f k accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu + +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 [ ] in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + [ ] -> () + | key :: rest -> + let nidx = indexfun h key in + ndata.(nidx) <- key :: ndata.(nidx); + insert_bucket rest + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + +let elements set = + fold set [] (fun k acc -> k :: acc) + + + + +let stats h = + let mbl = + Ext_array.fold_left h.data 0 (fun m b -> max m (List.length b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = List.length b in + histo.(l) <- histo.(l) + 1) + ; + {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 key lst = + match lst with + | [] -> false + | key1::rest -> + eq_key key key1 || + match rest with + | [] -> false + | key2 :: rest -> + eq_key key key2 || + match rest with + | [] -> false + | key3 :: rest -> + eq_key key key3 || + small_bucket_mem eq_key key rest + +let rec remove_bucket eq_key key (h : _ t) buckets = + match buckets with + | [ ] -> + [ ] + | k :: next -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else k :: remove_bucket eq_key key h next + +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + val copy: t -> t + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val elements : t -> key list +end + +end +module String_hash_set : sig +#1 "string_hash_set.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 Hash_set_gen.S with type key = string + +end = struct +#1 "string_hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 31 "ext/hash_set.cppo.ml" +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 + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Bsb_config_types += struct +#1 "bsb_config_types.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. *) + + +type dependency = + { + package_name : Bsb_pkg_types.t ; + package_install_path : string ; + } +type dependencies = dependency list + +(* `string` is a path to the entrypoint *) +type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string + +type reason_react_jsx = string option + +type refmt = + | Refmt_none + | Refmt_v3 + | Refmt_custom of string + +type gentype_config = { + path : string (* resolved *) +} +type t = + { + package_name : string ; + (* [captial-package] *) + namespace : string option; + (* CapitalPackage *) + external_includes : string list ; + bsc_flags : string list ; + ppx_files : string list ; + ppx_checked_files : string list ; + pp_file : string option; + bs_dependencies : dependencies; + bs_dev_dependencies : dependencies; + built_in_dependency : dependency option; + warning : Bsb_warning.t option; + (*TODO: maybe we should always resolve bs-platform + so that we can calculate correct relative path in + [.merlin] + *) + refmt : refmt; + refmt_flags : string list; + js_post_build_cmd : string option; + package_specs : Bsb_package_specs.t ; + globbed_dirs : string list; + bs_file_groups : Bsb_file_groups.file_groups; + files_to_install : String_hash_set.t ; + generate_merlin : bool ; + reason_react_jsx : reason_react_jsx ; (* whether apply PPX transform or not*) + entries : entries_t list ; + generators : string String_map.t ; + cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) + bs_suffix : bool ; (* true means [.bs.js] we should pass [-bs-suffix] flag *) + gentype_config : gentype_config option + } + +end +module Bsb_default : sig +#1 "bsb_default.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 bsc_flags : string list + +val refmt_flags : string list + +val refmt_v3 : string + +val refmt_none : string + +val main_entries : Bsb_config_types.entries_t list + +end = struct +#1 "bsb_default.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. *) + + +(* for default warning flags, please see bsb_warning.ml *) +let bsc_flags = + [ + "-color"; "always" + ] + + +let refmt_flags = ["--print"; "binary"] + +let refmt_v3 = "refmt.exe" +let refmt_none = "refmt.exe" + +let main_entries = [Bsb_config_types.JsTarget "Index"] + +end +module Ext_json_noloc : sig +#1 "ext_json_noloc.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + + +type t + +val true_ : t +val false_ : t +val null : t +val str : string -> t +val flo : string -> t +val arr : t array -> t +val obj : t String_map.t -> t +val kvs : (string * t) list -> t +val equal : t -> t -> bool +val to_string : t -> string + + +val to_channel : out_channel -> t -> unit +end = struct +#1 "ext_json_noloc.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + + +type t = + | True + | False + | Null + | Flo of string + | Str of string + | Arr of t array + | Obj of t String_map.t + + +(** poor man's serialization *) + +let quot x = + "\"" ^ String.escaped x ^ "\"" + +let true_ = True +let false_ = False +let null = Null +let str s = Str s +let flo s = Flo s +let arr s = Arr s +let obj s = Obj s +let kvs s = + Obj (String_map.of_list s) + +let rec equal + (x : t) + (y : t) = + match x with + | Null -> (* [%p? Null _ ] *) + begin match y with + | Null -> true + | _ -> false end + | Str str -> + begin match y with + | Str str2 -> str = str2 + | _ -> false end + | Flo flo + -> + begin match y with + | Flo flo2 -> + flo = flo2 + | _ -> false + end + | True -> + begin match y with + | True -> true + | _ -> false + end + | False -> + begin match y with + | False -> true + | _ -> false + end + | Arr content + -> + begin match y with + | Arr content2 + -> + Ext_array.for_all2_no_exn content content2 equal + | _ -> false + end + + | Obj map -> + begin match y with + | Obj map2 -> + String_map.equal map map2 equal + | _ -> false + end + +let rec encode_aux (x : t ) + (buf : Buffer.t) : unit = + let a str = Buffer.add_string buf str in + match x with + | Null -> a "null" + | Str s -> a (quot s) + | Flo s -> + a s (* + since our parsing keep the original float representation, we just dump it as is, there is no cases like [nan] *) + | Arr content -> + begin match content with + | [||] -> a "[]" + | _ -> + a "[ "; + encode_aux + (Array.unsafe_get content 0) + buf ; + for i = 1 to Array.length content - 1 do + a " , "; + encode_aux + (Array.unsafe_get content i) + buf + done; + a " ]" + end + | True -> a "true" + | False -> a "false" + | Obj map -> + if String_map.is_empty map then + a "{}" + else + begin + (*prerr_endline "WEIRD"; + prerr_endline (string_of_int @@ String_map.cardinal map ); *) + a "{ "; + let _ : int = String_map.fold map 0 (fun k v i -> + if i <> 0 then begin + a " , " + end; + a (quot k); + a " : "; + encode_aux v buf ; + i + 1 + ) in + a " }" + end + + +let to_string x = + let buf = Buffer.create 1024 in + encode_aux x buf ; + Buffer.contents buf + +let to_channel (oc : out_channel) x = + let buf = Buffer.create 1024 in + encode_aux x buf ; + Buffer.output_buffer oc buf +end +module Bsb_watcher_gen : sig +#1 "bsb_watcher_gen.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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. *) + +(** This module try to generate some meta data so that + everytime [bsconfig.json] is reload, we can re-read + such meta data changes in the watcher. + + Another way of doing it is processing [bsconfig.json] + directly in [watcher] but that would + mean the duplication of logic in [bsb] and [bsb_watcher] +*) +val generate_sourcedirs_meta : + string -> Bsb_file_groups.t -> unit +end = struct +#1 "bsb_watcher_gen.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + +let sourcedirs_meta = ".sourcedirs.json" + +let generate_sourcedirs_meta cwd (res : Bsb_file_groups.t) = + let ochan = open_out_bin (cwd // Bsb_config.lib_bs // sourcedirs_meta) in + let v = + Ext_json_noloc.( + kvs [ + "dirs" , + arr (Ext_array.of_list_map res.files ( fun x -> + str x.dir + ) ) ; + "generated" , + arr @@ Array.of_list @@ Ext_list.fold_left res.files [] (fun acc x -> + Ext_list.flat_map_append x.generators acc + (fun x -> + Ext_list.map x.output str) + ) + ] + ) in + Ext_json_noloc.to_channel ochan v ; + close_out ochan +end +module Bsb_config_parse : sig +#1 "bsb_config_parse.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 package_specs_from_bsconfig : + unit -> Bsb_package_specs.t + + + + +val interpret_json : + override_package_specs:Bsb_package_specs.t option -> + bsc_dir:string -> + generate_watch_metadata:bool -> + not_dev:bool -> + string -> + Bsb_config_types.t + + + + + + +end = struct +#1 "bsb_config_parse.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 config_file_bak = "bsconfig.json.bak" +let get_list_string = Bsb_build_util.get_list_string +let (//) = Ext_path.combine +let current_package : Bsb_pkg_types.t = Global Bs_version.package_name +let resolve_package cwd package_name = + let x = Bsb_pkg.resolve_bs_package ~cwd package_name in + { + Bsb_config_types.package_name ; + package_install_path = x // Bsb_config.lib_ocaml + } + + +(* Key is the path *) +let (|?) m (key, cb) = + m |> Ext_json.test key cb + +let parse_entries (field : Ext_json_types.t array) = + Ext_array.to_list_map (function + | Ext_json_types.Obj {map} -> + (* kind defaults to bytecode *) + let kind = ref "js" in + let main = ref None in + let _ = map + |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x)) + |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x)) + in + let path = begin match !main with + (* This is technically optional when compiling to js *) + | None when !kind = Literals.js -> + "Index" + | None -> + failwith "Missing field 'main'. That field is required its value needs to be the main module for the target" + | Some path -> path + end in + if !kind = Literals.native then + Some (Bsb_config_types.NativeTarget path) + else if !kind = Literals.bytecode then + Some (Bsb_config_types.BytecodeTarget path) + else if !kind = Literals.js then + Some (Bsb_config_types.JsTarget path) + else + failwith "Missing field 'kind'. That field is required and its value be 'js', 'native' or 'bytecode'" + | _ -> failwith "Unrecognized object inside array 'entries' field.") + field + + + +let package_specs_from_bsconfig () = + let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in + begin match json with + | Obj {map} -> + begin + match String_map.find_opt map Bsb_build_schemas.package_specs with + | Some x -> + Bsb_package_specs.from_json x + | None -> + Bsb_package_specs.default_package_specs + end + | _ -> assert false + end + + + + + +(*TODO: it is a little mess that [cwd] and [project dir] are shared*) + + +let extract_package_name_and_namespace + loc (map : Ext_json_types.t String_map.t) : string * string option = + let package_name = + match String_map.find_opt map Bsb_build_schemas.name with + + | Some (Str { str = "_" }) + -> + Bsb_exception.errorf ~loc "_ is a reserved package name" + | Some (Str {str = name }) -> + name + | Some _ | None -> + Bsb_exception.errorf ~loc + "field name as string is required" + in + let namespace = + match String_map.find_opt map Bsb_build_schemas.namespace with + | None + | Some (False _) + -> None + | Some (True _) -> + Some (Ext_namespace.namespace_of_package_name package_name) + | Some (Str {str}) -> + (*TODO : check the validity of namespace *) + Some (Ext_namespace.namespace_of_package_name str) + | Some x -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "namespace field expects string or boolean" + in + package_name, namespace +(** ATT: make sure such function is re-entrant. + With a given [cwd] it works anywhere*) +let interpret_json + ~override_package_specs + ~bsc_dir + ~generate_watch_metadata + ~not_dev + cwd + + : Bsb_config_types.t = + + let reason_react_jsx = ref None in + let config_json = cwd // Literals.bsconfig_json in + let refmt_flags = ref Bsb_default.refmt_flags in + let bs_external_includes = ref [] in + (** we should not resolve it too early, + since it is external configuration, no {!Bsb_build_util.convert_and_resolve_path} + *) + let bsc_flags = ref Bsb_default.bsc_flags in + let ppx_files : string list ref = ref [] in + let ppx_checked_files : string list ref = ref [] in + let js_post_build_cmd = ref None in + let built_in_package = ref None in + let generate_merlin = ref true in + let generators = ref String_map.empty in + + (* When we plan to add more deps here, + Make sure check it is consistent that for nested deps, we have a + quck check by just re-parsing deps + Make sure it works with [-make-world] [-clean-world] + *) + let bs_dependencies = ref [] in + let bs_dev_dependencies = ref [] in + (* Setting ninja is a bit complex + 1. if [build.ninja] does use [ninja] we need set a variable + 2. we need store it so that we can call ninja correctly + *) + let entries = ref Bsb_default.main_entries in + let cut_generators = ref false in + let config_json_chan = open_in_bin config_json in + let global_data = + Ext_json_parse.parse_json_from_chan + config_json config_json_chan in + match global_data with + | Obj { map ; loc } -> + let package_name, namespace = + extract_package_name_and_namespace loc map in + let refmt = + match String_map.find_opt map Bsb_build_schemas.refmt with + | Some (Flo {flo} as config) -> + begin match flo with + | "3" -> Bsb_config_types.Refmt_v3 + | _ -> Bsb_exception.config_error config "expect version 3 only" + end + | Some (Str {str}) + -> + Refmt_custom + (fst (Bsb_build_util.resolve_bsb_magic_file + ~cwd ~desc:Bsb_build_schemas.refmt str)) + | Some config -> + Bsb_exception.config_error config "expect version 2 or 3" + | None -> + Refmt_none + in + let gentype_config : Bsb_config_types.gentype_config option = + match String_map.find_opt map Bsb_build_schemas.gentypeconfig with + | None -> None + | Some (Obj {map = obj}) -> + Some { path = + match String_map.find_opt obj Bsb_build_schemas.path with + | None -> + fst @@ Bsb_build_util.resolve_bsb_magic_file + ~cwd ~desc:"gentype.exe" + "gentype/gentype.exe" + | Some (Str {str}) -> + fst @@ Bsb_build_util.resolve_bsb_magic_file + ~cwd ~desc:"gentype.exe" str + | Some config -> + Bsb_exception.config_error config + "path expect to be a string" + } + + | Some config -> + Bsb_exception.config_error + config "gentypeconfig expect an object" + in + let bs_suffix = + match String_map.find_opt map Bsb_build_schemas.suffix with + | None -> false + | Some (Str {str} as config ) -> + if str = Literals.suffix_js then false + else if str = Literals.suffix_bs_js then true + else Bsb_exception.config_error config + "expect .bs.js or .js string here" + | Some config -> + Bsb_exception.config_error config + "expect .bs.js or .js string here" + in + (* The default situation is empty *) + (match String_map.find_opt map Bsb_build_schemas.use_stdlib with + | Some (False _) -> + () + | None + | Some _ -> + begin + let stdlib_path = + Bsb_pkg.resolve_bs_package ~cwd current_package in + let json_spec = + Ext_json_parse.parse_json_from_file + (Filename.concat stdlib_path Literals.package_json) in + match json_spec with + | Obj {map} -> + (match String_map.find_exn map Bsb_build_schemas.version with + | Str {str } -> + if str <> Bs_version.version then + ( + Format.fprintf Format.err_formatter + "@{bs-platform version mismatch@} Running bsb @{%s@} (%s) vs vendored @{%s@} (%s)@." + Bs_version.version + (Filename.dirname (Filename.dirname Sys.executable_name)) + str + stdlib_path + ; + exit 2) + + | _ -> assert false); + built_in_package := Some { + Bsb_config_types.package_name = current_package; + package_install_path = stdlib_path // Bsb_config.lib_ocaml; + } + + | _ -> assert false + + end + ) ; + let package_specs = + match String_map.find_opt map Bsb_build_schemas.package_specs with + | Some x -> + Bsb_package_specs.from_json x + | None -> Bsb_package_specs.default_package_specs + in + let pp_flags : string option = + match String_map.find_opt map Bsb_build_schemas.pp_flags with + | Some (Str {str = p }) -> + if p = "" then failwith "invalid pp, empty string found" + else + Some (fst @@ Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.pp_flags p) + | Some x -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) "pp-flags expected a string" + | None -> + None + in + map + |? (Bsb_build_schemas.reason, `Obj begin fun m -> + match String_map.find_opt m Bsb_build_schemas.react_jsx with + | Some (Flo{loc; flo}) -> + begin match flo with + | "2" -> + reason_react_jsx := + Some (Filename.quote + (Filename.concat bsc_dir Literals.reactjs_jsx_ppx_2_exe) ) + | "3" -> + Bsb_exception.errorf ~loc "JSX version 3 is deprecated, please downgrade to 1.x for version 3" + | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo + end + | Some x -> Bsb_exception.config_error x + "Unexpected input (expect a version number) for jsx, note boolean is no longer allowed" + | None -> () + end) + + |? (Bsb_build_schemas.generate_merlin, `Bool (fun b -> + generate_merlin := b + )) + + |? (Bsb_build_schemas.js_post_build, `Obj begin fun m -> + m |? (Bsb_build_schemas.cmd , `Str (fun s -> + js_post_build_cmd := Some (fst @@ Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.js_post_build s) + + ) + ) + |> ignore + end) + + |? (Bsb_build_schemas.bs_dependencies, `Arr (fun s -> bs_dependencies := Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s)))) + |? (Bsb_build_schemas.bs_dev_dependencies, + `Arr (fun s -> + if not not_dev then + bs_dev_dependencies + := Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s))) + ) + + (* More design *) + |? (Bsb_build_schemas.bs_external_includes, `Arr (fun s -> bs_external_includes := get_list_string s)) + |? (Bsb_build_schemas.bsc_flags, `Arr (fun s -> bsc_flags := Bsb_build_util.get_list_string_acc s !bsc_flags)) + |? (Bsb_build_schemas.ppx_flags, `Arr (fun s -> + let args = get_list_string s in + let a,b = Ext_list.map_split_opt args (fun p -> + if p = "" then failwith "invalid ppx, empty string found" + else + let file, checked = + Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.ppx_flags p + in + let some_file = Some file in + some_file, if checked then some_file else None + ) in + ppx_files := a ; + ppx_checked_files := b + )) + + |? (Bsb_build_schemas.cut_generators, `Bool (fun b -> cut_generators := b)) + |? (Bsb_build_schemas.generators, `Arr (fun s -> + generators := + Ext_array.fold_left s String_map.empty (fun acc json -> + match json with + | Obj {map = m ; loc} -> + begin match String_map.find_opt m Bsb_build_schemas.name, + String_map.find_opt m Bsb_build_schemas.command with + | Some (Str {str = name}), Some ( Str {str = command}) -> + String_map.add acc name command + | _, _ -> + Bsb_exception.errorf ~loc {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} + end + | _ -> acc ) )) + |? (Bsb_build_schemas.refmt_flags, `Arr (fun s -> refmt_flags := get_list_string s)) + |? (Bsb_build_schemas.entries, `Arr (fun s -> entries := parse_entries s)) + |> ignore ; + begin match String_map.find_opt map Bsb_build_schemas.sources with + | Some x -> + let ignored_dirs : String_set.t = + match String_map.find_opt map Bsb_build_schemas.ignored_dirs with + | None -> String_set.empty + | Some (Arr {content}) -> + String_set.of_list (Bsb_build_util.get_list_string content) + | Some config -> + Bsb_exception.config_error config "expect an array of string" + in + let res = Bsb_parse_sources.scan + ~ignored_dirs + ~not_dev + ~root: cwd + ~cut_generators: !cut_generators + ~clean_staled_bs_js:bs_suffix + ~namespace + x in + if generate_watch_metadata then + Bsb_watcher_gen.generate_sourcedirs_meta cwd res ; + begin match List.sort Ext_file_pp.interval_compare res.intervals with + | [] -> () + | queue -> + let file_size = in_channel_length config_json_chan in + let output_file = (cwd //config_file_bak) in + let oc = open_out_bin output_file in + let () = + Ext_file_pp.process_wholes + queue file_size config_json_chan oc in + close_out oc ; + close_in config_json_chan ; + Unix.unlink config_json; + Unix.rename output_file config_json + end; + let warning : Bsb_warning.t option = + match String_map.find_opt map Bsb_build_schemas.warnings with + | None -> None + | Some (Obj {map }) -> Bsb_warning.from_map map + | Some config -> Bsb_exception.config_error config "expect an object" + in + + { + gentype_config; + bs_suffix ; + package_name ; + namespace ; + warning = warning; + external_includes = !bs_external_includes; + bsc_flags = !bsc_flags ; + ppx_files = !ppx_files ; + ppx_checked_files = !ppx_checked_files; + pp_file = pp_flags ; + bs_dependencies = !bs_dependencies; + bs_dev_dependencies = !bs_dev_dependencies; + refmt; + refmt_flags = !refmt_flags ; + js_post_build_cmd = !js_post_build_cmd ; + package_specs = + (match override_package_specs with + | None -> package_specs + | Some x -> x ); + globbed_dirs = res.globbed_dirs; + bs_file_groups = res.files; + files_to_install = String_hash_set.create 96; + built_in_dependency = !built_in_package; + generate_merlin = !generate_merlin ; + reason_react_jsx = !reason_react_jsx ; + entries = !entries; + generators = !generators ; + cut_generators = !cut_generators + } + | None -> failwith "no sources specified, please checkout the schema for more details" + end + | _ -> failwith "bsconfig.json expect a json object {}" + +end +module Bsb_merlin_gen : sig +#1 "bsb_merlin_gen.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 merlin_file_gen : + cwd:string -> string -> Bsb_config_types.t -> unit +end = struct +#1 "bsb_merlin_gen.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 merlin = ".merlin" +let merlin_header = "####{BSB GENERATED: NO EDIT" +let merlin_trailer = "####BSB GENERATED: NO EDIT}" +let merlin_trailer_length = String.length merlin_trailer +let (//) = Ext_path.combine + +(** [new_content] should start end finish with newline *) +let revise_merlin merlin new_content = + if Sys.file_exists merlin then + let merlin_chan = open_in_bin merlin in + let size = in_channel_length merlin_chan in + let s = really_input_string merlin_chan size in + let () = close_in merlin_chan in + + let header = Ext_string.find s ~sub:merlin_header in + let tail = Ext_string.find s ~sub:merlin_trailer in + if header < 0 && tail < 0 then (* locked region not added yet *) + let ochan = open_out_bin merlin in + output_string ochan s ; + output_string ochan "\n"; + output_string ochan merlin_header; + Buffer.output_buffer ochan new_content; + output_string ochan merlin_trailer ; + output_string ochan "\n"; + close_out ochan + else if header >=0 && tail >= 0 then + (* there is one, hit it everytime, + should be fixed point + *) + let ochan = open_out_bin merlin in + output_string ochan (String.sub s 0 header) ; + output_string ochan merlin_header; + Buffer.output_buffer ochan new_content; + output_string ochan merlin_trailer ; + output_string ochan (Ext_string.tail_from s (tail + merlin_trailer_length)); + close_out ochan + else failwith ("the .merlin is corrupted, locked region by bsb is not consistent ") + else + let ochan = open_out_bin merlin in + output_string ochan merlin_header ; + Buffer.output_buffer ochan new_content; + output_string ochan merlin_trailer ; + output_string ochan "\n"; + close_out ochan + +(* ATTENTION: order matters here, need resolve global properties before + merlin generation +*) +let merlin_flg_ppx = "\nFLG -ppx " +let merlin_flg_pp = "\nFLG -pp " +let merlin_s = "\nS " +let merlin_b = "\nB " + + +let merlin_flg = "\nFLG " +let bs_flg_prefix = "-bs-" + +let output_merlin_namespace buffer ns= + match ns with + | None -> () + | Some x -> + Buffer.add_string buffer merlin_b ; + Buffer.add_string buffer Bsb_config.lib_bs ; + Buffer.add_string buffer merlin_flg ; + Buffer.add_string buffer "-open "; + Buffer.add_string buffer x + +let bsc_flg_to_merlin_ocamlc_flg bsc_flags = + merlin_flg ^ + String.concat Ext_string.single_space + (List.filter (fun x -> not (Ext_string.starts_with x bs_flg_prefix )) @@ + Literals.dash_nostdlib::bsc_flags) + +(* No need for [-warn-error] in merlin *) +let warning_to_merlin_flg (warning: Bsb_warning.t option) : string= + merlin_flg ^ Bsb_warning.get_warning_flag warning + + +let merlin_file_gen ~cwd + built_in_ppx + ({bs_file_groups = res_files ; + generate_merlin; + ppx_files; + pp_file; + bs_dependencies; + bs_dev_dependencies; + bsc_flags; + built_in_dependency; + external_includes; + reason_react_jsx ; + namespace; + package_name; + warning; + } : Bsb_config_types.t) + = + if generate_merlin then begin + let buffer = Buffer.create 1024 in + output_merlin_namespace buffer namespace; + Ext_list.iter ppx_files (fun x -> + Buffer.add_string buffer (merlin_flg_ppx ^ x ) + ); + Ext_option.iter pp_file (fun x -> + Buffer.add_string buffer (merlin_flg_pp ^ x) + ); + Ext_option.iter reason_react_jsx + (fun s -> + Buffer.add_string buffer (merlin_flg_ppx ^ s)); + Buffer.add_string buffer (merlin_flg_ppx ^ built_in_ppx); + (* + (match external_includes with + | [] -> () + | _ -> + + Buffer.add_string buffer (merlin_flg ^ Bsb_build_util.include_dirs external_includes + )); + *) + Ext_list.iter external_includes (fun path -> + Buffer.add_string buffer merlin_s ; + Buffer.add_string buffer path ; + Buffer.add_string buffer merlin_b; + Buffer.add_string buffer path ; + ); + Ext_option.iter built_in_dependency (fun package -> + let path = package.package_install_path in + Buffer.add_string buffer (merlin_s ^ path ); + Buffer.add_string buffer (merlin_b ^ path) + ); + let bsc_string_flag = bsc_flg_to_merlin_ocamlc_flg bsc_flags in + Buffer.add_string buffer bsc_string_flag ; + Buffer.add_string buffer (warning_to_merlin_flg warning); + Ext_list.iter bs_dependencies (fun package -> + let path = package.package_install_path in + Buffer.add_string buffer merlin_s ; + Buffer.add_string buffer path ; + Buffer.add_string buffer merlin_b; + Buffer.add_string buffer path ; + ); + Ext_list.iter bs_dev_dependencies (**TODO: shall we generate .merlin for dev packages ?*) + (fun package -> + let path = package.package_install_path in + Buffer.add_string buffer merlin_s ; + Buffer.add_string buffer path ; + Buffer.add_string buffer merlin_b; + Buffer.add_string buffer path ; + ); + Ext_list.iter res_files (fun (x : Bsb_file_groups.file_group) -> + if not (Bsb_file_groups.is_empty x) then + begin + Buffer.add_string buffer merlin_s; + Buffer.add_string buffer x.dir ; + Buffer.add_string buffer merlin_b; + Buffer.add_string buffer (Bsb_config.lib_bs//x.dir) ; + end + ) ; + Buffer.add_string buffer "\n"; + revise_merlin (cwd // merlin) buffer + end + + + +end +module Bsb_ninja_check : sig +#1 "bsb_ninja_check.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. *) + +(** + This module is used to check whether [build.ninja] needs + be regenerated. Everytime [bsb] run [regenerate_ninja], + bsb will try to [check] if it is needed, + if needed, bsb will regenerate ninja file and store the + metadata again +*) + + + + + +type check_result = + | Good + | Bsb_file_not_exist (** We assume that it is a clean repo *) + | Bsb_source_directory_changed + | Bsb_bsc_version_mismatch + | Bsb_forced + | Other of string + +val pp_check_result : Format.formatter -> check_result -> unit + + +(** [record cwd file relevant_file_or_dirs] + The data structure we decided to whether regenerate [build.ninja] + or not. + Note that if we don't record absolute path, ninja will not notice its build spec changed, + it will not trigger rebuild behavior, + It may not be desired behavior, since there is some subtlies here (__FILE__ or __dirname) + + We serialize such data structure and call {!check} to decide + [build.ninja] should be regenerated +*) +val record : cwd:string -> file:string -> string list -> unit + + +(** check if [build.ninja] should be regenerated *) +val check : + cwd:string -> + forced:bool -> file:string -> check_result + +end = struct +#1 "bsb_ninja_check.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. *) + +type dep_info = { + dir_or_file : string ; + st_mtime : float +} + +type t = + { file_stamps : dep_info array ; + source_directory : string ; + bsb_version : string; + bsc_version : string; + } + + +let magic_number = "BS_DEP_INFOS_20170822" +let bsb_version = "20170822+dev" +(* TODO: for such small data structure, maybe text format is better *) + +let write (fname : string) (x : t) = + let oc = open_out_bin fname in + output_string oc magic_number ; + output_value oc x ; + close_out oc + + + + + +type check_result = + | Good + | Bsb_file_not_exist (** We assume that it is a clean repo *) + | Bsb_source_directory_changed + | Bsb_bsc_version_mismatch + | Bsb_forced + | Other of string + +let pp_check_result fmt (check_resoult : check_result) = + Format.pp_print_string fmt (match check_resoult with + | Good -> "OK" + | Bsb_file_not_exist -> "Dependencies information missing" + | Bsb_source_directory_changed -> + "Bsb source directory changed" + | Bsb_bsc_version_mismatch -> + "Bsc or bsb version mismatch" + | Bsb_forced -> + "Bsb forced rebuild" + | Other s -> s) + +let rec check_aux cwd xs i finish = + if i = finish then Good + else + let k = Array.unsafe_get xs i in + let current_file = k.dir_or_file in + let stat = Unix.stat (Filename.concat cwd current_file) in + if stat.st_mtime <= k.st_mtime then + check_aux cwd xs (i + 1 ) finish + else Other current_file + + +let read (fname : string) cont = + match open_in_bin fname with (* Windows binary mode*) + | ic -> + let buffer = really_input_string ic (String.length magic_number) in + if (buffer <> magic_number) then Bsb_bsc_version_mismatch + else + let res : t = input_value ic in + close_in ic ; + cont res + | exception _ -> Bsb_file_not_exist + +let record ~cwd ~file file_or_dirs = + let file_stamps = + Ext_array.of_list_map file_or_dirs + (fun x -> + {dir_or_file = x ; + st_mtime = (Unix.stat (Filename.concat cwd x )).st_mtime + }) + in + write file + { file_stamps ; + source_directory = cwd ; + bsb_version ; + bsc_version = Bs_version.version } + +(** check time stamp for all files + TODO: those checks system call can be saved later + Return a reason + Even forced, we still need walk through a little + bit in case we found a different version of compiler +*) +let check ~cwd ~forced ~file : check_result = + read file begin function { + file_stamps = xs; source_directory; bsb_version = old_version; + bsc_version + } -> + if old_version <> bsb_version then Bsb_bsc_version_mismatch else + if cwd <> source_directory then Bsb_source_directory_changed else + if bsc_version <> Bs_version.version then Bsb_bsc_version_mismatch else + if forced then Bsb_forced (* No need walk through *) + else + try + check_aux cwd xs 0 (Array.length xs) + with e -> + begin + Bsb_log.info + "@{Stat miss %s@}@." + (Printexc.to_string e); + Bsb_file_not_exist + end + end + + +end +module Bsb_db_io : sig +#1 "bsb_db_io.mli" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + + + + +type t + +type group = { + modules : string array ; + meta_info_offset : int + } + +val decode : + string -> + int ref -> + group array + +val write_build_cache : + dir:string -> Bsb_db.ts -> unit + + +val read_build_cache : + dir:string -> t + +val find_opt : + t -> (* contains global info *) + int -> (* more likely to be zero *) + string -> (* module name *) + Bsb_db.module_info option +end = struct +#1 "bsb_db_io.ml" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + + + type group = { + modules : string array ; + meta_info_offset : int + } + +type t = group array * string (* string is whole content*) + +let bsbuild_cache = ".bsbuild" + + +let nl buf = + Buffer.add_char buf '\n' +let comma buf = + Buffer.add_char buf ',' +let bool buf b = + Buffer.add_char buf (if b then '1' else '0') + +(* IDEAS: + Pros: + - could be even shortened to a single byte + Cons: + - decode would allocate + - code too verbose + - not readable + *) +let encode_ml_info (x : Bsb_db.ml_info ) : char = + match x with + | Ml_empty -> '0' + | Ml_source(false,false) -> '1' + | Ml_source(false,true) -> '2' + | Ml_source(true, false) -> '3' + | Ml_source(true, true) -> '4' + +let decode_ml_info (x : char ) : Bsb_db.ml_info = + match x with + | '0' -> Ml_empty + | '1' -> Ml_source(false,false) + | '2' -> Ml_source(false,true) + | '3' -> Ml_source(true, false) + | '4' -> Ml_source(true, true) + | _ -> assert false + +let encode_mli_info (x : Bsb_db.mli_info ) : char = + match x with + | Mli_empty -> '0' + | Mli_source(false,false) -> '1' + | Mli_source(false,true) -> '2' + | Mli_source(true, false) -> '3' + | Mli_source(true, true) -> '4' + +let decode_mli_info (x : char ) : Bsb_db.mli_info = + match x with + | '0' -> Mli_empty + | '1' -> Mli_source(false,false) + | '2' -> Mli_source(false,true) + | '3' -> Mli_source(true, false) + | '4' -> Mli_source(true, true) + | _ -> assert false + +let rec encode_module_info (x : Bsb_db.module_info) (buf : Buffer.t) = + Buffer.add_string buf x.name_sans_extension; + comma buf; + Buffer.add_char buf (encode_mli_info x.mli_info); + Buffer.add_char buf (encode_ml_info x.ml_info) + + + +(* Make sure [tmp_buf1] and [tmp_buf2] is cleared , + they are only used to control the order. + Strictly speaking, [tmp_buf1] is not needed +*) +let encode_single (x : Bsb_db.t) (buf : Buffer.t) (buf2 : Buffer.t) = + let len = String_map.cardinal x in + nl buf ; + Buffer.add_string buf (string_of_int len); + String_map.iter x (fun name module_info -> + nl buf; + Buffer.add_string buf name; + nl buf2; + encode_module_info module_info buf2 + ) + +let encode (x : Bsb_db.ts) (oc : out_channel)= + output_char oc '\n'; + let len = Array.length x in + output_string oc (string_of_int len); + let tmp_buf1 = Buffer.create 10_000 in + let tmp_buf2 = Buffer.create 60_000 in + Ext_array.iter x (fun x -> begin + encode_single x tmp_buf1 tmp_buf2; + Buffer.output_buffer oc tmp_buf1; + Buffer.output_buffer oc tmp_buf2; + Buffer.clear tmp_buf1; + Buffer.clear tmp_buf2 + end + ) + + +type cursor = int ref + +let extract_line (x : string) (cur : cursor) : string = + Ext_string.extract_until x cur '\n' + +let next_mdoule_info (s : string) (cur : int) ~count = + if count = 0 then cur + else + Ext_string.index_count s cur '\n' count + 1 + +let rec decode (x : string) (offset : cursor) = + let len = int_of_string (extract_line x offset) in + Array.init len (fun _ -> decode_single x offset) +and decode_single x (offset : cursor) : group = + let cardinal = int_of_string (extract_line x offset) in + let modules = decode_modules x offset cardinal in + let meta_info_offset = !offset in + offset := next_mdoule_info x meta_info_offset ~count:cardinal; + { modules ; meta_info_offset } +and decode_modules x (offset : cursor) cardinal = + let result = Array.make cardinal "" in + for i = 0 to cardinal - 1 do + Array.unsafe_set result i (extract_line x offset) + done ; + result + + + + +let write_build_cache ~dir (bs_files : Bsb_db.ts) : unit = + let oc = open_out_bin (Filename.concat dir bsbuild_cache) in + output_string oc Bs_version.version ; + encode bs_files oc; + close_out oc + + +let read_build_cache ~dir : t = + let ic = open_in_bin (Filename.concat dir bsbuild_cache) in + let len = in_channel_length ic in + let all_content = really_input_string ic len in + let offset = ref 0 in + let cur_module_info_magic_number = extract_line all_content offset in + assert (cur_module_info_magic_number = Bs_version.version); + decode all_content offset, all_content + +let cmp (a : string) b = String_map.compare_key a b + +let rec binarySearchAux (arr : string array) (lo : int) (hi : int) (key : string) : _ option = + let mid = (lo + hi)/2 in + let midVal = Array.unsafe_get arr mid in + let c = cmp key midVal in + if c = 0 then Some (mid) + else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = (Array.unsafe_get arr lo) in + if loVal = key then Some lo + else None + else binarySearchAux arr lo mid key + else (* a[lo] =< a[mid] < key <= a[hi] *) + if lo = mid then + let hiVal = (Array.unsafe_get arr hi) in + if hiVal = key then Some hi + else None + else binarySearchAux arr mid hi key + +let find_opt_aux sorted key : _ option = + let len = Array.length sorted in + if len = 0 then None + else + let lo = Array.unsafe_get sorted 0 in + let c = cmp key lo in + if c < 0 then None + else + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = cmp key hi in + if c2 > 0 then None + else binarySearchAux sorted 0 (len - 1) key + +let find_opt + ((sorteds,whole) : t ) i key + : Bsb_db.module_info option = + let group = sorteds.(i) in + let i = find_opt_aux group.modules key in + match i with + | None -> None + | Some count -> + let cursor = + ref (next_mdoule_info whole group.meta_info_offset ~count) + in + let name_sans_extension = + Ext_string.extract_until whole cursor ',' in + let mli_info = decode_mli_info whole.[!cursor] in + let ml_info = decode_ml_info whole.[!cursor + 1] in + Some {mli_info ; ml_info; name_sans_extension} +end +module Bsb_namespace_map_gen : sig +#1 "bsb_namespace_map_gen.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +(** [output dir namespace file_groups] + when [build.ninja] is generated, we output a module map [.mlmap] file + such [.mlmap] file will be consumed by [bsc.exe] to generate [.cmi] file + *) +val output : + dir:string -> + string -> + Bsb_file_groups.file_groups -> + unit +end = struct +#1 "bsb_namespace_map_gen.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + + + + + + +let output ~dir namespace + (file_groups : Bsb_file_groups.file_groups ) + = + let fname = namespace ^ Literals.suffix_mlmap in + let oc = open_out_bin (dir// fname ) in + List.iter + (fun (x : Bsb_file_groups.file_group) -> + String_map.iter x.sources (fun k _ -> + output_string oc k ; + output_string oc "\n" + ) + ) file_groups ; + close_out oc +end +module Bsb_ninja_global_vars += struct +#1 "bsb_ninja_global_vars.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 bs_package_flags = "bs_package_flags" + +let bsc = "bsc" + +let src_root_dir = "src_root_dir" +let bsdep = "bsdep" + +let bsc_flags = "bsc_flags" + +let ppx_flags = "ppx_flags" +let ppx_checked_files = "ppx_checked_files" +let pp_flags = "pp_flags" +let bs_package_includes = "bs_package_includes" + +let bs_package_dev_includes = "bs_package_dev_includes" + +let refmt = "refmt" + +let reason_react_jsx = "reason_react_jsx" + +let refmt_flags = "refmt_flags" + +let postbuild = "postbuild" + +let namespace = "namespace" + +let warnings = "warnings" + +let gentypeconfig = "gentypeconfig" + +end +module Bsb_ninja_rule : sig +#1 "bsb_ninja_rule.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. *) + + + + +type t + +val get_name : t -> out_channel -> string + +val build_ast_and_module_sets : t +(** TODO: Implement it on top of pp_flags *) +val build_ast_and_module_sets_from_re : t +val build_ast_and_module_sets_from_rei : t +(** platform dependent, on Win32, + invoking cmd.exe + *) +val copy_resources : t + + + +(** Rules below all need restat *) +val build_bin_deps : t +val build_cmj_js : t +val build_cmj_cmi_js : t +val build_cmi : t +val build_package : t + +(** rules are generally composed of built-in rules and customized rules, there are two design choices: + 1. respect custom rules with the same name, then we need adjust our built-in + rules dynamically in case the conflict. + 2. respect our built-in rules, then we only need re-load custom rules for each bsconfig.json +*) + + +(** Since now we generate ninja files per bsconfig.json in a single process, + we must make sure it is re-entrant +*) +val reset : string String_map.t -> t String_map.t + +end = struct +#1 "bsb_ninja_rule.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 rule_id = ref 0 +let rule_names = ref String_set.empty +(** To make it re-entrant across multiple ninja files, + We must reset [rule_id] + could be improved later + 1. instead of having a global id, having a unique id per rule name + 2. the rule id is increased only when actually used +*) +let ask_name name = + let current_id = !rule_id in + let () = incr rule_id in + let new_name = + if String_set.mem !rule_names name then + name ^ Printf.sprintf "_%d" current_id + else name in + rule_names := String_set.add !rule_names new_name ; + new_name + + +type t = { + mutable used : bool; + rule_name : string; + name : out_channel -> string +} + +let get_name (x : t) oc = x.name oc +let print_rule oc ~description ?(restat : unit option) ?depfile ~command name = + output_string oc "rule "; output_string oc name ; output_string oc "\n"; + output_string oc " command = "; output_string oc command; output_string oc "\n"; + Ext_option.iter depfile begin fun f -> + output_string oc " depfile = "; output_string oc f; output_string oc "\n" + end; + (if restat <> None then + output_string oc " restat = 1\n"); + + output_string oc " description = " ; output_string oc description; output_string oc "\n" + + + + +(** allocate an unique name for such rule*) +let define + ~command + ?depfile + ?restat + ?(description = "\027[34mBuilding\027[39m \027[2m${out}\027[22m") (* blue, dim *) + name + = + let rule_name = ask_name name in + let rec self = { + used = false; + rule_name ; + name = fun oc -> + if not self.used then + begin + print_rule oc ~description ?depfile ?restat ~command rule_name; + self.used <- true + end ; + rule_name + } in self + + +(** FIXME: We don't need set [-o ${out}] when building ast + since the default is already good -- it does not*) +let build_ast_and_module_sets = + define + ~command:"${bsc} ${pp_flags} ${ppx_flags} ${warnings} ${bsc_flags} -c -o ${out} -bs-syntax-only -bs-binary-ast ${in}" + "build_ast_and_module_sets" + + +let build_ast_and_module_sets_from_re = + define + ~command:"${bsc} -pp \"${refmt} ${refmt_flags}\" ${reason_react_jsx} ${ppx_flags} ${warnings} ${bsc_flags} -c -o ${out} -bs-syntax-only -bs-binary-ast -impl ${in}" + "build_ast_and_module_sets_from_re" + +let build_ast_and_module_sets_from_rei = + define + ~command:"${bsc} -pp \"${refmt} ${refmt_flags}\" ${reason_react_jsx} ${ppx_flags} ${warnings} ${bsc_flags} -c -o ${out} -bs-syntax-only -bs-binary-ast -intf ${in}" + "build_ast_and_module_sets_from_rei" + +let copy_resources = + let name = "copy_resource" in + if Ext_sys.is_windows_or_cygwin then + define ~command:"cmd.exe /C copy /Y ${in} ${out} > null" + name + else + define + ~command:"cp ${in} ${out}" + name + +let build_bin_deps = + define + ~restat:() + ~command:"${bsdep} ${namespace} -g ${bsb_dir_group} -MD ${in}" + "build_deps" + + +(* only generate mll no mli generated *) +(* actually we would prefer generators in source ? + generator are divided into two categories: + 1. not system dependent (ocamllex,ocamlyacc) + 2. system dependent - has to be run on client's machine +*) + + +(**************************************) +(* below are rules not local any more *) +(**************************************) + +(* [bsc_lib_includes] are fixed for libs *) +let build_cmj_js = + define + ~command:"${bsc} ${bs_package_flags} -bs-assume-has-mli -bs-no-builtin-ppx-ml -bs-no-implicit-include \ + ${bs_package_includes} ${bsc_lib_includes} ${bsc_extra_includes} ${warnings} ${bsc_flags} ${gentypeconfig} -o ${out} -c ${in} $postbuild" + ~depfile:"${in}.d" + ~restat:() (* Always restat when having mli *) + "build_cmj_only" + + +let build_cmj_cmi_js = + define + ~command:"${bsc} ${bs_package_flags} -bs-assume-no-mli -bs-no-builtin-ppx-ml -bs-no-implicit-include \ + ${bs_package_includes} ${bsc_lib_includes} ${bsc_extra_includes} ${warnings} ${bsc_flags} ${gentypeconfig} -o ${out} -c ${in} $postbuild" + ~depfile:"${in}.d" + ~restat:() (* may not need it in the future *) + "build_cmj_cmi" (* the compiler should never consult [.cmi] when [.mli] does not exist *) +let build_cmi = + define + ~command:"${bsc} ${bs_package_flags} -bs-no-builtin-ppx-mli -bs-no-implicit-include \ + ${bs_package_includes} ${bsc_lib_includes} ${bsc_extra_includes} ${warnings} ${bsc_flags} ${gentypeconfig} -o ${out} -c ${in}" + ~depfile:"${in}.d" + ~restat:() + "build_cmi" (* the compiler should always consult [.cmi], current the vanilla ocaml compiler only consult [.cmi] when [.mli] found*) + +let build_package = + define + ~command:"${bsc} -w -49 -no-alias-deps -bs-cmi-only -c ${in}" + ~restat:() + "build_package" + +(* a snapshot of rule_names environment*) +let built_in_rule_names = !rule_names +let built_in_rule_id = !rule_id + +let reset (custom_rules : string String_map.t) = + rule_id := built_in_rule_id; + rule_names := built_in_rule_names; + build_ast_and_module_sets.used <- false ; + build_ast_and_module_sets_from_re.used <- false ; + build_ast_and_module_sets_from_rei.used <- false ; + build_bin_deps.used <- false; + copy_resources.used <- false ; + + build_cmj_js.used <- false; + build_cmj_cmi_js.used <- false ; + build_cmi.used <- false ; + build_package.used <- false; + String_map.mapi custom_rules begin fun name command -> + define ~command name + end + + + +end +module Bsb_ninja_util : sig +#1 "bsb_ninja_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. *) + + + + +type override = + | Append of string + | AppendList of string list + | AppendVar of string + + | Overwrite of string + + | OverwriteVar of string + +type shadow = { key : string ; op : override } +(** output should always be marked explicitly, + otherwise the build system can not figure out clearly + however, for the command we don't need pass `-o` +*) +val output_build : + ?order_only_deps:string list -> + ?implicit_deps:string list -> + ?outputs:string list -> + ?implicit_outputs: string list -> + ?inputs:string list -> + ?shadows:shadow list -> + ?restat:unit -> + output:string -> + input:string -> + rule:Bsb_ninja_rule.t -> out_channel -> unit + + +val phony : + ?order_only_deps:string list -> + ?restat:unit -> + inputs:string list -> output:string -> out_channel -> unit + +val output_kv : string -> string -> out_channel -> unit +val output_kvs : (string * string) array -> out_channel -> unit + + +end = struct +#1 "bsb_ninja_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. *) + + + + +type override = + | Append of string + | AppendList of string list + (* Append s + s + *) + | AppendVar of string + (* AppendVar s + $s + *) + | Overwrite of string + + | OverwriteVar of string + (* + OverwriteVar s + $s + *) + +type shadow = + { key : string ; op : override } + +let output_build + ?(order_only_deps=[]) + ?(implicit_deps=[]) + ?(outputs=[]) + ?(implicit_outputs=[]) + ?(inputs=[]) + ?(shadows=([] : shadow list)) + ?restat + ~output + ~input + ~rule + oc = + let rule = Bsb_ninja_rule.get_name rule oc in (* Trigger building if not used *) + output_string oc "build "; + output_string oc output ; + Ext_list.iter outputs (fun s -> output_string oc Ext_string.single_space ; output_string oc s ); + begin match implicit_outputs with + | [] -> () + | _ -> + output_string oc " | "; + implicit_outputs |> List.iter (fun s -> output_string oc Ext_string.single_space ; output_string oc s) + end; + output_string oc " : "; + output_string oc rule; + output_string oc Ext_string.single_space; + output_string oc input; + inputs |> List.iter (fun s -> output_string oc Ext_string.single_space ; output_string oc s); + begin match implicit_deps with + | [] -> () + | _ -> + begin + output_string oc " | "; + implicit_deps + |> + List.iter (fun s -> output_string oc Ext_string.single_space; output_string oc s ) + end + end; + begin match order_only_deps with + | [] -> () + | _ -> + begin + output_string oc " || "; + order_only_deps + |> + List.iter (fun s -> output_string oc Ext_string.single_space ; output_string oc s) + end + end; + output_string oc "\n"; + begin match shadows with + | [] -> () + | xs -> + List.iter (fun {key=k; op= v} -> + output_string oc " " ; + output_string oc k ; + output_string oc " = "; + match v with + | Overwrite s -> + output_string oc s ; + output_string oc "\n" + | OverwriteVar s -> + output_string oc "$"; + output_string oc s ; + output_string oc "\n" + | AppendList ls -> + output_string oc "$" ; + output_string oc k; + List.iter + (fun s -> + output_string oc Ext_string.single_space; + output_string oc s + ) ls; + output_string oc "\n" + | Append s -> + output_string oc "$" ; + output_string oc k; + output_string oc Ext_string.single_space; + output_string oc s ; output_string oc "\n" + | AppendVar s -> + output_string oc "$" ; + output_string oc k; + output_string oc Ext_string.single_space; + output_string oc "$"; + output_string oc s ; + output_string oc "\n" + ) xs + end; + if restat <> None then + output_string oc " restat = 1 \n" + + + +let phony ?(order_only_deps=[]) ?(restat : unit option) ~inputs ~output oc = + output_string oc "build "; + output_string oc output ; + output_string oc " : "; + output_string oc "phony"; + output_string oc Ext_string.single_space; + Ext_list.iter inputs (fun s -> output_string oc Ext_string.single_space ; output_string oc s); + (match order_only_deps with + | [] -> () + | _ -> + begin + output_string oc " || "; + Ext_list.iter order_only_deps (fun s -> output_string oc Ext_string.single_space ; output_string oc s) + end); + output_string oc "\n"; + if restat <> None then + output_string oc " restat = 1 \n" + +let output_kv key value oc = + output_string oc key ; + output_string oc " = "; + output_string oc value ; + output_string oc "\n" + +let output_kvs kvs oc = + Ext_array.iter kvs (fun (k,v) -> output_kv k v oc) + + + +end +module Bsb_ninja_file_groups : sig +#1 "bsb_ninja_file_groups.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + +type info = string list + + +val zero : info + + +val handle_file_groups : + out_channel -> + has_checked_ppx:bool -> + package_specs:Bsb_package_specs.t -> + bs_suffix:bool -> + js_post_build_cmd:string option -> + files_to_install:String_hash_set.t -> + custom_rules:Bsb_ninja_rule.t String_map.t -> + Bsb_file_groups.file_groups -> + string option -> + info -> info +end = struct +#1 "bsb_ninja_file_groups.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + +type info = + string list +(* Figure out a list of files + to be built before building cm* +*) + + +let zero : info = + [] + + + + + +let handle_generators oc + (group : Bsb_file_groups.file_group) custom_rules = + let map_to_source_dir = + (fun x -> Bsb_config.proj_rel (group.dir //x )) in + Ext_list.iter group.generators (fun {output; input; command} -> + begin match String_map.find_opt custom_rules command with + | None -> Ext_pervasives.failwithf ~loc:__LOC__ "custom rule %s used but not defined" command + | Some rule -> + begin match output, input with + | output::outputs, input::inputs -> + Bsb_ninja_util.output_build oc + ~outputs:(Ext_list.map outputs map_to_source_dir) + ~inputs:(Ext_list.map inputs map_to_source_dir) + ~output:(map_to_source_dir output) + ~input:(map_to_source_dir input) + ~rule + | [], _ + | _, [] -> Ext_pervasives.failwithf ~loc:__LOC__ "either output or input can not be empty in rule %s" command + end + end + ) + + +let make_common_shadows + is_re + package_specs + dirname + dir_index + : Bsb_ninja_util.shadow list + = + let shadows : Bsb_ninja_util.shadow list = + { key = Bsb_ninja_global_vars.bs_package_flags; + op = + Append + (Bsb_package_specs.package_flag_of_package_specs + package_specs dirname + ) + } :: + (if Bsb_dir_index.is_lib_dir dir_index then [] else + [{ + key = Bsb_ninja_global_vars.bs_package_includes; + op = AppendVar Bsb_ninja_global_vars.bs_package_dev_includes + } + ; + { key = "bsc_extra_includes"; + op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index) + } + ] + ) + in + if is_re then + { key = Bsb_ninja_global_vars.bsc_flags; + op = AppendList ["-bs-re-out"; "-bs-super-errors"] + } :: shadows + else shadows + + +let emit_impl_build + (package_specs : Bsb_package_specs.t) + (group_dir_index : Bsb_dir_index.t) + oc + ~has_checked_ppx + ~bs_suffix + ~no_intf_file:(no_intf_file : bool) + js_post_build_cmd + ~is_re + namespace + filename_sans_extension + : info = + let input = + Bsb_config.proj_rel + (if is_re then filename_sans_extension ^ Literals.suffix_re + else filename_sans_extension ^ Literals.suffix_ml ) in + let output_mlast = filename_sans_extension ^ Literals.suffix_mlast in + let output_mlastd = filename_sans_extension ^ Literals.suffix_mlastd in + let output_filename_sans_extension = + match namespace with + | None -> + filename_sans_extension + | Some ns -> + Ext_namespace.make ~ns filename_sans_extension + in + let file_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in + let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in + let output_js = + Bsb_package_specs.get_list_of_output_js package_specs bs_suffix output_filename_sans_extension in + let common_shadows = + make_common_shadows is_re package_specs + (Filename.dirname file_cmi) + group_dir_index in + begin + Bsb_ninja_util.output_build oc + ~output:output_mlast + ~input + ~implicit_deps:(if has_checked_ppx then [ "${ppx_checked_files}" ] else []) + ~rule:( if is_re then + Bsb_ninja_rule.build_ast_and_module_sets_from_re + else + Bsb_ninja_rule.build_ast_and_module_sets); + Bsb_ninja_util.output_build + oc + ~output:output_mlastd + ~input:output_mlast + ~rule:Bsb_ninja_rule.build_bin_deps + ~implicit_deps:(if has_checked_ppx then [ "${ppx_checked_files}" ] else []) + ?shadows:(if Bsb_dir_index.is_lib_dir group_dir_index then None + else Some [{Bsb_ninja_util.key = Bsb_build_schemas.bsb_dir_group ; + op = + Overwrite (string_of_int (group_dir_index :> int)) }]) + ; + let shadows = + match js_post_build_cmd with + | None -> common_shadows + | Some cmd -> + {key = Bsb_ninja_global_vars.postbuild; + op = Overwrite ("&& " ^ cmd ^ Ext_string.single_space ^ String.concat Ext_string.single_space output_js)} + :: common_shadows + in + let rule , cm_outputs, deps = + if no_intf_file then + Bsb_ninja_rule.build_cmj_cmi_js, [file_cmi], [] + else Bsb_ninja_rule.build_cmj_js, [] , [file_cmi] + in + Bsb_ninja_util.output_build oc + ~output:output_cmj + ~shadows + ~implicit_outputs: (output_js @ cm_outputs) + ~input:output_mlast + ~implicit_deps:deps + ~rule; + [output_mlastd] + end + + +let emit_intf_build + (package_specs : Bsb_package_specs.t) + (group_dir_index : Bsb_dir_index.t) + oc + ~is_re + ~has_checked_ppx + namespace + filename_sans_extension + : info = + let output_mliast = filename_sans_extension ^ Literals.suffix_mliast in + let output_mliastd = filename_sans_extension ^ Literals.suffix_mliastd in + let output_filename_sans_extension = + match namespace with + | None -> + filename_sans_extension + | Some ns -> + Ext_namespace.make ~ns filename_sans_extension + in + let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in + let common_shadows = + make_common_shadows is_re package_specs + (Filename.dirname output_cmi) + group_dir_index in + Bsb_ninja_util.output_build oc + ~output:output_mliast + (* TODO: we can get rid of absloute path if we fixed the location to be + [lib/bs], better for testing? + *) + ~input:(Bsb_config.proj_rel + (if is_re then filename_sans_extension ^ Literals.suffix_rei + else filename_sans_extension ^ Literals.suffix_mli)) + ~rule:(if is_re then Bsb_ninja_rule.build_ast_and_module_sets_from_rei + else Bsb_ninja_rule.build_ast_and_module_sets) + ~implicit_deps:(if has_checked_ppx then [ "${ppx_checked_files}" ] else []) + ; + Bsb_ninja_util.output_build oc + ~output:output_mliastd + ~input:output_mliast + ~rule:Bsb_ninja_rule.build_bin_deps + ~implicit_deps:(if has_checked_ppx then [ "${ppx_checked_files}" ] else []) + ?shadows:(if Bsb_dir_index.is_lib_dir group_dir_index then None + else Some [{ + key = Bsb_build_schemas.bsb_dir_group; + op = + Overwrite (string_of_int (group_dir_index :> int )) }]) + ; + Bsb_ninja_util.output_build oc + ~output:output_cmi + ~shadows:common_shadows + ~input:output_mliast + ~rule:Bsb_ninja_rule.build_cmi + ; + [output_mliastd] + + + +let handle_module_info + (group_dir_index : Bsb_dir_index.t) + (package_specs : Bsb_package_specs.t) + js_post_build_cmd + ~has_checked_ppx + ~bs_suffix + oc module_name + ( {name_sans_extension = input} as module_info : Bsb_db.module_info) + namespace + : info = + match module_info.ml_info, module_info.mli_info with + | Ml_source (impl_is_re,_), + Mli_source(intf_is_re,_) -> + emit_impl_build + package_specs + group_dir_index + oc + ~has_checked_ppx + ~bs_suffix + ~no_intf_file:false + ~is_re:impl_is_re + js_post_build_cmd + namespace + input @ + emit_intf_build + package_specs + group_dir_index + oc + ~has_checked_ppx + ~is_re:intf_is_re + namespace + input + | Ml_source(is_re,_), Mli_empty -> + emit_impl_build + package_specs + group_dir_index + oc + ~has_checked_ppx + ~bs_suffix + ~no_intf_file:true + js_post_build_cmd + ~is_re + namespace + input + | Ml_empty, Mli_source(is_re,_) -> + emit_intf_build + ~has_checked_ppx + package_specs + group_dir_index + oc + ~is_re + namespace + input + | Ml_empty, Mli_empty -> zero + + +let handle_file_group + oc + ~(has_checked_ppx : bool) + ~bs_suffix + ~custom_rules + ~package_specs + ~js_post_build_cmd + (files_to_install : String_hash_set.t) + (namespace : string option) + acc + (group: Bsb_file_groups.file_group ) + : info = + + handle_generators oc group custom_rules ; + String_map.fold group.sources acc (fun module_name module_info acc -> + let installable = + match group.public with + | Export_all -> true + | Export_none -> false + | Export_set set -> + String_set.mem set module_name in + if installable then + String_hash_set.add files_to_install (Bsb_db.filename_sans_suffix_of_module_info module_info); + (handle_module_info + ~has_checked_ppx + ~bs_suffix + group.dir_index + package_specs js_post_build_cmd + oc + module_name + module_info + namespace + ) @ acc + ) + + +let handle_file_groups + oc + ~has_checked_ppx + ~package_specs + ~bs_suffix + ~js_post_build_cmd + ~files_to_install ~custom_rules + (file_groups : Bsb_file_groups.file_groups) + namespace (st : info) : info = + Ext_list.fold_left file_groups st + (handle_file_group + oc + ~has_checked_ppx + ~bs_suffix ~package_specs ~custom_rules ~js_post_build_cmd + files_to_install + namespace + ) + + +end +module Bsb_ninja_gen : sig +#1 "bsb_ninja_gen.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. *) + +(** + generate ninja file based on [cwd] and [bsc_dir] +*) +val + output_ninja_and_namespace_map : + cwd:string -> + bsc_dir:string -> + not_dev:bool -> + Bsb_config_types.t -> unit + +end = struct +#1 "bsb_ninja_gen.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 (//) = Ext_path.combine + +(* we need copy package.json into [_build] since it does affect build output + it is a bad idea to copy package.json which requires to copy js files +*) + +let merge_module_info_map acc sources : Bsb_db.t = + String_map.merge acc sources (fun modname k1 k2 -> + match k1 , k2 with + | None , None -> + assert false + | Some a, Some b -> + Bsb_exception.conflict_module modname + (Bsb_db.dir_of_module_info a) + (Bsb_db.dir_of_module_info b) + | Some v, None -> Some v + | None, Some v -> Some v + ) + + +let bsc_exe = "bsc.exe" +let bsb_helper_exe = "bsb_helper.exe" +let dash_i = "-I" + + + +let output_ninja_and_namespace_map + ~cwd + ~bsc_dir + ~not_dev + ({ + bs_suffix; + package_name; + external_includes; + bsc_flags ; + pp_file; + ppx_files ; + ppx_checked_files; + bs_dependencies; + bs_dev_dependencies; + refmt; + refmt_flags; + js_post_build_cmd; + package_specs; + bs_file_groups; + files_to_install; + built_in_dependency; + reason_react_jsx; + generators ; + namespace ; + warning; + gentype_config; + } : Bsb_config_types.t) + = + let custom_rules = Bsb_ninja_rule.reset generators in + let bsc = bsc_dir // bsc_exe in (* The path to [bsc.exe] independent of config *) + let bsdep = bsc_dir // bsb_helper_exe in (* The path to [bsb_heler.exe] *) + let cwd_lib_bs = cwd // Bsb_config.lib_bs in + let ppx_flags = Bsb_build_util.ppx_flags ppx_files in + let bsc_flags = String.concat Ext_string.single_space bsc_flags in + let refmt_flags = String.concat Ext_string.single_space refmt_flags in + let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in + let bs_package_includes = + Bsb_build_util.include_dirs @@ Ext_list.map bs_dependencies + (fun x -> x.package_install_path) + in + let bs_package_dev_includes = + Bsb_build_util.include_dirs @@ Ext_list.map bs_dev_dependencies + (fun x -> x.package_install_path) + in + let has_reason_files = ref false in + let bs_package_flags , namespace_flag = + match namespace with + | None -> + Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty + | Some s -> + Ext_string.inter4 + "-bs-package-name" package_name + "-bs-package-map" s + , + Ext_string.inter2 "-ns" s + in + let bsc_flags = + let result = + Ext_string.inter2 Literals.dash_nostdlib @@ + match built_in_dependency with + | None -> bsc_flags + | Some {package_install_path} -> + Ext_string.inter3 dash_i (Filename.quote package_install_path) bsc_flags + in + if bs_suffix then Ext_string.inter2 "-bs-suffix" result else result + in + + let warnings = Bsb_warning.opt_warning_to_string not_dev warning in + + let output_reason_config () = + if !has_reason_files then + let reason_react_jsx_flag = + match reason_react_jsx with + | None -> Ext_string.empty + | Some s -> + Ext_string.inter2 "-ppx" s + in + Bsb_ninja_util.output_kvs + [| + Bsb_ninja_global_vars.refmt, + (match refmt with + | Refmt_none -> + Bsb_log.warn "@{Warning:@} refmt version missing. Please set it explicitly, since we may change the default in the future.@."; + bsc_dir // Bsb_default.refmt_none + | Refmt_v3 -> + bsc_dir // Bsb_default.refmt_v3 + | Refmt_custom x -> x ); + Bsb_ninja_global_vars.reason_react_jsx, reason_react_jsx_flag; + Bsb_ninja_global_vars.refmt_flags, refmt_flags; + |] oc + in + let () = + Ext_option.iter pp_file (fun flag -> + Bsb_ninja_util.output_kv Bsb_ninja_global_vars.pp_flags + (Bsb_build_util.pp_flag flag) oc + ); + Ext_option.iter gentype_config (fun {path} -> + (* resolved earlier *) + Bsb_ninja_util.output_kv Bsb_ninja_global_vars.gentypeconfig + ("-bs-gentype " ^ path) oc + ) + ; + (* + TODO: + see https://github.com/ninja-build/ninja/issues/1375 + *) + (match ppx_checked_files with + | first_ppx_checked_file :: _ -> + Bsb_ninja_util.output_kv Bsb_ninja_global_vars.ppx_checked_files + first_ppx_checked_file oc + | [] -> ()) + ; + + Bsb_ninja_util.output_kvs + [| + Bsb_ninja_global_vars.bs_package_flags, bs_package_flags ; + Bsb_ninja_global_vars.src_root_dir, cwd (* TODO: need check its integrity -- allow relocate or not? *); + Bsb_ninja_global_vars.bsc, bsc ; + Bsb_ninja_global_vars.bsdep, bsdep; + Bsb_ninja_global_vars.warnings, warnings; + Bsb_ninja_global_vars.bsc_flags, bsc_flags ; + Bsb_ninja_global_vars.ppx_flags, ppx_flags; + Bsb_ninja_global_vars.bs_package_includes, bs_package_includes; + Bsb_ninja_global_vars.bs_package_dev_includes, bs_package_dev_includes; + Bsb_ninja_global_vars.namespace , namespace_flag ; + Bsb_build_schemas.bsb_dir_group, "0" (*TODO: avoid name conflict in the future *) + |] oc + in + let all_includes acc = + match external_includes with + | [] -> acc + | _ -> + (* for external includes, if it is absolute path, leave it as is + for relative path './xx', we need '../.././x' since we are in + [lib/bs], [build] is different from merlin though + *) + Ext_list.map_append + external_includes + acc + (fun x -> if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) + + in + let emit_bsc_lib_includes source_dirs = + Bsb_ninja_util.output_kv + Bsb_build_schemas.bsc_lib_includes + (Bsb_build_util.include_dirs @@ + (all_includes + (if namespace = None then source_dirs + else Filename.current_dir_name :: source_dirs) )) oc + in + let bs_groups, bsc_lib_dirs, static_resources = + let number_of_dev_groups = Bsb_dir_index.get_current_number_of_dev_groups () in + if number_of_dev_groups = 0 then + let bs_group, source_dirs,static_resources = + Ext_list.fold_left bs_file_groups (String_map.empty,[],[]) + (fun (acc, dirs,acc_resources) ({sources ; dir; resources } as x) + -> + merge_module_info_map acc sources , + (if Bsb_file_groups.is_empty x then dirs else dir::dirs) , + ( if resources = [] then acc_resources + else Ext_list.map_append resources acc_resources (fun x -> dir // x ) ) + ) in + has_reason_files := Bsb_db.sanity_check bs_group || !has_reason_files; + [|bs_group|], source_dirs, static_resources + else + let bs_groups = Array.init (number_of_dev_groups + 1 ) (fun i -> String_map.empty) in + let source_dirs = Array.init (number_of_dev_groups + 1 ) (fun i -> []) in + let static_resources = + Ext_list.fold_left bs_file_groups [] (fun (acc_resources : string list) {sources; dir; resources; dir_index} + -> + let dir_index = (dir_index :> int) in + bs_groups.(dir_index) <- merge_module_info_map bs_groups.(dir_index) sources ; + source_dirs.(dir_index) <- dir :: source_dirs.(dir_index); + Ext_list.map_append resources acc_resources (fun x -> dir//x) + ) in + let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in + has_reason_files := Bsb_db.sanity_check lib || !has_reason_files; + for i = 1 to number_of_dev_groups do + let c = bs_groups.(i) in + has_reason_files := Bsb_db.sanity_check c || !has_reason_files ; + String_map.iter c (fun k _ -> if String_map.mem lib k then failwith ("conflict files found:" ^ k)) ; + Bsb_ninja_util.output_kv + (Bsb_dir_index.(string_of_bsb_dev_include (of_int i))) + (Bsb_build_util.include_dirs @@ source_dirs.(i)) oc + done ; + bs_groups,source_dirs.((Bsb_dir_index.lib_dir_index:>int)), static_resources + in + + output_reason_config (); + Bsb_db_io.write_build_cache ~dir:cwd_lib_bs bs_groups ; + emit_bsc_lib_includes bsc_lib_dirs; + Ext_list.iter static_resources (fun output -> + Bsb_ninja_util.output_build + oc + ~output + ~input:(Bsb_config.proj_rel output) + ~rule:Bsb_ninja_rule.copy_resources); + (** Generate build statement for each file *) + let all_info = + Bsb_ninja_file_groups.handle_file_groups oc + ~has_checked_ppx:(ppx_checked_files <> []) + ~bs_suffix + ~custom_rules + ~js_post_build_cmd + ~package_specs + ~files_to_install + bs_file_groups + namespace + Bsb_ninja_file_groups.zero + in + (match namespace with + | None -> + Bsb_ninja_util.phony + oc + ~order_only_deps:(static_resources @ all_info) + ~inputs:[] + ~output:Literals.build_ninja + | Some ns -> + let namespace_dir = + cwd // Bsb_config.lib_bs in + Bsb_namespace_map_gen.output + ~dir:namespace_dir ns + bs_file_groups + ; + let all_info = + Bsb_ninja_util.output_build oc + ~output:(ns ^ Literals.suffix_cmi) + ~input:(ns ^ Literals.suffix_mlmap) + ~rule:Bsb_ninja_rule.build_package + ; + (ns ^ Literals.suffix_cmi) :: all_info in + Bsb_ninja_util.phony + oc + ~order_only_deps:(static_resources @ all_info) + ~inputs:[] + ~output:Literals.build_ninja ); + close_out oc; + +end +module Bsb_ninja_regen : sig +#1 "bsb_ninja_regen.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + + + +(** Regenerate ninja file by need based on [.bsdeps] + return None if we dont need regenerate + otherwise return Some info +*) +val regenerate_ninja : + not_dev:bool -> + override_package_specs:Bsb_package_specs.t option -> + generate_watch_metadata: bool -> + forced: bool -> string -> string -> + Bsb_config_types.t option +end = struct +#1 "bsb_ninja_regen.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 bsdeps = ".bsdeps" + +let bsppx_exe = "bsppx.exe" + +let (//) = Ext_path.combine + +(** Regenerate ninja file by need based on [.bsdeps] + return None if we dont need regenerate + otherwise return Some info +*) +let regenerate_ninja + ~not_dev + ~override_package_specs + ~generate_watch_metadata + ~forced cwd bsc_dir + : _ option = + let output_deps = cwd // Bsb_config.lib_bs // bsdeps in + let check_result = + Bsb_ninja_check.check + ~cwd + ~forced ~file:output_deps in + let () = + Bsb_log.info + "@{BSB check@} build spec : %a @." Bsb_ninja_check.pp_check_result check_result in + begin match check_result with + | Good -> + None (* Fast path, no need regenerate ninja *) + | Bsb_forced + | Bsb_bsc_version_mismatch + | Bsb_file_not_exist + | Bsb_source_directory_changed + | Other _ -> + if check_result = Bsb_bsc_version_mismatch then begin + Bsb_log.info "@{Different compiler version@}: clean current repo"; + Bsb_clean.clean_self bsc_dir cwd; + end ; + Bsb_build_util.mkp (cwd // Bsb_config.lib_bs); + let config = + Bsb_config_parse.interpret_json + ~override_package_specs + ~bsc_dir + ~generate_watch_metadata + ~not_dev + cwd in + begin + Bsb_merlin_gen.merlin_file_gen ~cwd + (bsc_dir // bsppx_exe) config; + Bsb_ninja_gen.output_ninja_and_namespace_map + ~cwd ~bsc_dir ~not_dev config ; + (* PR2184: we still need record empty dir + since it may add files in the future *) + Bsb_ninja_check.record ~cwd ~file:output_deps + (Literals.bsconfig_json::config.globbed_dirs) ; + Some config + end + end + + +end +module Bsb_query : sig +#1 "bsb_query.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 query: cwd:string -> bsc_dir:string -> string -> unit +end = struct +#1 "bsb_query.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 query_sources ({bs_file_groups} : Bsb_config_types.t) : Ext_json_noloc.t + = + Ext_array.of_list_map bs_file_groups (fun x -> + Ext_json_noloc.( + kvs [ + "dir", str x.dir ; + "sources" , + arr (Ext_array.of_list_map (String_map.keys x.sources) str) + ] + ) + ) + |> Ext_json_noloc.arr + + +let query_current_package_sources cwd bsc_dir = + let config_opt = Bsb_ninja_regen.regenerate_ninja + ~not_dev:false + ~override_package_specs:None + ~generate_watch_metadata:true + ~forced:true cwd bsc_dir in + match config_opt with + | None -> None + + | Some config -> + Some (query_sources config) + + +let query ~cwd ~bsc_dir str = + match str with + | "sources" -> + begin match query_current_package_sources cwd bsc_dir with + | None -> raise (Arg.Bad "internal error in query") + | Some config -> + output_string stdout + (Printf.sprintf "QUERY-INFO-BEGIN(%s)\n" str); + Ext_json_noloc.to_channel stdout + ( config ); + output_string stdout "\nQUERY-INFO-END\n"; + end + | _ -> raise (Arg.Bad "Unsupported query") +end +module Bsb_regex : sig +#1 "bsb_regex.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + +(** Used in `bsb -init` command *) +val global_substitute: + string -> + reg:string -> + (string -> string list -> string) -> + string +end = struct +#1 "bsb_regex.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 string_after s n = String.sub s n (String.length s - n) + + + +(* There seems to be a bug in {!Str.global_substitute} +{[ +Str.global_substitute (Str.regexp "\\${bsb:\\([-a-zA-Z0-9]+\\)}") (fun x -> (x^":found")) {| ${bsb:hello-world} ${bsb:x} ${x}|} ;; +- : bytes = +" ${bsb:hello-world} ${bsb:x} ${x}:found ${bsb:hello-world} ${bsb:x} ${x}:found ${x}" +]} +*) +let global_substitute text ~reg:expr repl_fun = + let text_len = String.length text in + let expr = Str.regexp expr in + let rec replace accu start last_was_empty = + let startpos = if last_was_empty then start + 1 else start in + if startpos > text_len then + string_after text start :: accu + else + match Str.search_forward expr text startpos with + | exception Not_found -> + string_after text start :: accu + | pos -> + let end_pos = Str.match_end() in + let matched = (Str.matched_string text) in + let groups = + let rec aux n acc = + match Str.matched_group n text with + | exception (Not_found | Invalid_argument _ ) + -> acc + | v -> aux (succ n) (v::acc) in + aux 1 [] in + let repl_text = repl_fun matched groups in + replace (repl_text :: String.sub text start (pos-start) :: accu) + end_pos (end_pos = pos) + in + String.concat "" (List.rev (replace [] 0 false)) + +end +module OCamlRes += struct +#1 "oCamlRes.ml" + + +module Res = struct + type node = + | Dir of string * node list + | File of string * string + +end + + + +end +module Bsb_templates : sig +#1 "bsb_templates.mli" + + +val root : OCamlRes.Res.node list +end = struct +#1 "bsb_templates.ml" +(* This file has been generated by ocp-ocamlres *) +let root = OCamlRes.Res.([ + Dir ("basic", [ + Dir ("src", [ + File ("demo.ml", + "\n\ + \n\ + let () = Js.log \"Hello, BuckleScript\"")]) ; + Dir (".vscode", [ + File ("tasks.json", + "{\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"command\": \"npm\",\n\ + \ \"options\": {\n\ + \ \"cwd\": \"${workspaceRoot}\"\n\ + \ },\n\ + \ \"isShellCommand\": true,\n\ + \ \"args\": [\n\ + \ \"run\",\n\ + \ \"watch\"\n\ + \ ],\n\ + \ \"showOutput\": \"always\",\n\ + \ \"isBackground\": true,\n\ + \ \"problemMatcher\": {\n\ + \ \"fileLocation\": \"absolute\",\n\ + \ \"owner\": \"ocaml\",\n\ + \ \"watching\": {\n\ + \ \"activeOnStart\": false,\n\ + \ \"beginsPattern\": \">>>> Start compiling\",\n\ + \ \"endsPattern\": \">>>> Finish compiling\"\n\ + \ },\n\ + \ \"pattern\": [\n\ + \ {\n\ + \ \"regexp\": \"^File \\\"(.*)\\\", line (\\\\d+)(?:, characters (\\\\d+)-(\\\\d+))?:$\",\n\ + \ \"file\": 1,\n\ + \ \"line\": 2,\n\ + \ \"column\": 3,\n\ + \ \"endColumn\": 4\n\ + \ },\n\ + \ {\n\ + \ \"regexp\": \"^(?:(?:Parse\\\\s+)?(Warning|[Ee]rror)(?:\\\\s+\\\\d+)?:)?\\\\s+(.*)$\",\n\ + \ \"severity\": 1,\n\ + \ \"message\": 2,\n\ + \ \"loop\": true\n\ + \ }\n\ + \ ]\n\ + \ }\n\ + }")]) ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"sources\": {\n\ + \ \"dir\" : \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": {\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ },\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"bs-dependencies\": [\n\ + \ ],\n\ + \ \"warnings\": {\n\ + \ \"error\" : \"+101\"\n\ + \ },\n\ + \ \"refmt\": 3\n\ + }\n\ + ") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"watch\": \"bsb -make-world -w\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }") ; + File (".gitignore", + "*.exe\n\ + *.obj\n\ + *.out\n\ + *.compile\n\ + *.native\n\ + *.byte\n\ + *.cmo\n\ + *.annot\n\ + *.cmi\n\ + *.cmx\n\ + *.cmt\n\ + *.cmti\n\ + *.cma\n\ + *.a\n\ + *.cmxa\n\ + *.obj\n\ + *~\n\ + *.annot\n\ + *.cmj\n\ + *.bak\n\ + lib/bs\n\ + *.mlast\n\ + *.mliast\n\ + .vscode\n\ + .merlin\n\ + .bsb.lock") ; + File ("README.md", + "\n\ + \n\ + # Build\n\ + ```\n\ + npm run build\n\ + ```\n\ + \n\ + # Watch\n\ + \n\ + ```\n\ + npm run watch\n\ + ```\n\ + \n\ + \n\ + # Editor\n\ + If you use `vscode`, Press `Windows + Shift + B` it will build automatically")]) ; + Dir ("basic-reason", [ + Dir ("src", [ + File ("Demo.re", + "Js.log(\"Hello, BuckleScript and Reason!\");\n\ + ")]) ; + Dir (".vscode", [ + File ("tasks.json", + "{\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"command\": \"npm\",\n\ + \ \"options\": {\n\ + \ \"cwd\": \"${workspaceRoot}\"\n\ + \ },\n\ + \ \"type\": \"shell\",\n\ + \ \"args\": [\"run\", \"start\"],\n\ + \ \"presentation\": {\n\ + \ \"echo\": true,\n\ + \ \"reveal\": \"always\",\n\ + \ \"focus\": false,\n\ + \ \"panel\": \"shared\"\n\ + \ },\n\ + \ \"isBackground\": true,\n\ + \ \"problemMatcher\": {\n\ + \ \"fileLocation\": \"absolute\",\n\ + \ \"owner\": \"ocaml\",\n\ + \ \"background\": {\n\ + \ \"activeOnStart\": false,\n\ + \ \"beginsPattern\": \">>>> Start compiling\",\n\ + \ \"endsPattern\": \">>>> Finish compiling\"\n\ + \ },\n\ + \ \"pattern\": [\n\ + \ {\n\ + \ \"regexp\":\n\ + \ \"^File \\\"(.*)\\\", line (\\\\d+)(?:, characters (\\\\d+)-(\\\\d+))?:$\",\n\ + \ \"file\": 1,\n\ + \ \"line\": 2,\n\ + \ \"column\": 3,\n\ + \ \"endColumn\": 4\n\ + \ },\n\ + \ {\n\ + \ \"regexp\":\n\ + \ \"^(?:(?:Parse\\\\s+)?(Warning|[Ee]rror)(?:\\\\s+\\\\d+)?:)?\\\\s+(.*)$\",\n\ + \ \"severity\": 1,\n\ + \ \"message\": 2,\n\ + \ \"loop\": true\n\ + \ }\n\ + \ ]\n\ + \ }\n\ + \ }\n\ + ")]) ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"sources\": {\n\ + \ \"dir\" : \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": {\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ },\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"bs-dependencies\": [\n\ + \n\ + \ ],\n\ + \ \"warnings\": {\n\ + \ \"error\" : \"+101\"\n\ + \ },\n\ + \ \"namespace\": true,\n\ + \ \"refmt\": 3\n\ + }\n\ + ") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"start\": \"bsb -make-world -w\",\n\ + \ \"clean\": \"bsb -clean-world\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }\n\ + ") ; + File (".gitignore", + ".DS_Store\n\ + .merlin\n\ + .bsb.lock\n\ + npm-debug.log\n\ + /lib/bs/\n\ + /node_modules/\n\ + ") ; + File ("README.md", + "# Basic Reason Template\n\ + \n\ + Hello! This project allows you to quickly get started with Reason and BuckleScript. If you wanted a more sophisticated version, try the `react` template (`bsb -theme react -init .`).\n\ + \n\ + # Build\n\ + ```\n\ + npm run build\n\ + ```\n\ + \n\ + # Build + Watch\n\ + \n\ + ```\n\ + npm run start\n\ + ```\n\ + \n\ + \n\ + # Editor\n\ + If you use `vscode`, Press `Windows + Shift + B` it will build automatically\n\ + ")]) ; + Dir ("generator", [ + Dir ("src", [ + File ("test.cpp.ml", + "\n\ + (* \n\ + #define FS_VAL(name,ty) external name : ty = \"\" [@@bs.module \"fs\"]\n\ + \n\ + \n\ + FS_VAL(readdirSync, string -> string array)\n\ + \ *)\n\ + \n\ + \n\ + \ let ocaml = OCAML") ; + File ("demo.ml", + "\n\ + \n\ + let () = Js.log \"Hello, BuckleScript\"")]) ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"sources\": {\n\ + \ \"dir\": \"src\",\n\ + \ \"generators\": [{\n\ + \ \"name\": \"cpp\",\n\ + \ \"edge\": [\"test.ml\", \":\", \"test.cpp.ml\"]\n\ + \ }],\n\ + \ \"subdirs\": true \n\ + \ },\n\ + \ \"generators\": [{\n\ + \ \"name\" : \"cpp\",\n\ + \ \"command\": \"sed 's/OCAML/3/' $in > $out\"\n\ + \ }],\n\ + \ \"bs-dependencies\" : [\n\ + \ ]\n\ + }") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"watch\": \"bsb -make-world -w\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }") ; + File (".gitignore", + "*.exe\n\ + *.obj\n\ + *.out\n\ + *.compile\n\ + *.native\n\ + *.byte\n\ + *.cmo\n\ + *.annot\n\ + *.cmi\n\ + *.cmx\n\ + *.cmt\n\ + *.cmti\n\ + *.cma\n\ + *.a\n\ + *.cmxa\n\ + *.obj\n\ + *~\n\ + *.annot\n\ + *.cmj\n\ + *.bak\n\ + lib/bs\n\ + *.mlast\n\ + *.mliast\n\ + .vscode\n\ + .merlin\n\ + .bsb.lock") ; + File ("README.md", + "\n\ + \n\ + # Build\n\ + ```\n\ + npm run build\n\ + ```\n\ + \n\ + # Watch\n\ + \n\ + ```\n\ + npm run watch\n\ + ```\n\ + \n\ + \n\ + # Editor\n\ + If you use `vscode`, Press `Windows + Shift + B` it will build automatically")]) ; + Dir ("minimal", [ + Dir ("src", [ File ("main.ml", "")]) ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"sources\": {\n\ + \ \"dir\": \"src\",\n\ + \ \"subdirs\": true\n\ + \ }\n\ + }") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"start\": \"bsb -make-world -w\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }") ; + File (".gitignore", + ".DS_Store\n\ + .merlin\n\ + .bsb.lock\n\ + npm-debug.log\n\ + /lib/bs/\n\ + /node_modules/") ; + File ("README.md", + "\n\ + \ # ${bsb:name}")]) ; + Dir ("node", [ + Dir ("src", [ + File ("demo.ml", + "\n\ + \n\ + let () = Js.log \"Hello, BuckleScript\"")]) ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"sources\": {\n\ + \ \"dir\": \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": {\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ },\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"bs-dependencies\": [\n\ + \ ]\n\ + }") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"watch\": \"bsb -make-world -w\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }") ; + File (".gitignore", + "*.exe\n\ + *.obj\n\ + *.out\n\ + *.compile\n\ + *.native\n\ + *.byte\n\ + *.cmo\n\ + *.annot\n\ + *.cmi\n\ + *.cmx\n\ + *.cmt\n\ + *.cmti\n\ + *.cma\n\ + *.a\n\ + *.cmxa\n\ + *.obj\n\ + *~\n\ + *.annot\n\ + *.cmj\n\ + *.bak\n\ + lib/bs\n\ + *.mlast\n\ + *.mliast\n\ + .vscode\n\ + .merlin\n\ + .bsb.lock") ; + File ("README.md", + "\n\ + \n\ + # Build\n\ + ```\n\ + npm run build\n\ + ```\n\ + \n\ + # Watch\n\ + \n\ + ```\n\ + npm run watch\n\ + ```\n\ + \n\ + \n\ + # Editor\n\ + If you use `vscode`, Press `Windows + Shift + B` it will build automatically\n\ + ")]) ; + Dir ("react", [ + Dir ("src", [ + File ("Index.re", + "ReactDOMRe.renderToElementWithId(, \"index1\");\n\ + \n\ + ReactDOMRe.renderToElementWithId(, \"index2\");\n\ + ") ; + File ("Component1.re", + "/* This is the basic component. */\n\ + let component = ReasonReact.statelessComponent(\"Component1\");\n\ + \n\ + /* Your familiar handleClick from ReactJS. This mandatorily takes the payload,\n\ + \ then the `self` record, which contains state (none here), `handle`, `reduce`\n\ + \ and other utilities */\n\ + let handleClick = (_event, _self) => Js.log(\"clicked!\");\n\ + \n\ + /* `make` is the function that mandatorily takes `children` (if you want to use\n\ + \ `JSX). `message` is a named argument, which simulates ReactJS props. Usage:\n\ + \n\ + \ ``\n\ + \n\ + \ Which desugars to\n\ + \n\ + \ `ReasonReact.element(Component1.make(~message=\"hello\", [||]))` */\n\ + let make = (~message, _children) => {\n\ + \ ...component,\n\ + \ render: self =>\n\ + \
\n\ + \ {ReasonReact.string(message)}\n\ + \
,\n\ + };\n\ + ") ; + File ("Component2.re", + "/* State declaration */\n\ + type state = {\n\ + \ count: int,\n\ + \ show: bool,\n\ + };\n\ + \n\ + /* Action declaration */\n\ + type action =\n\ + \ | Click\n\ + \ | Toggle;\n\ + \n\ + /* Component template declaration.\n\ + \ Needs to be **after** state and action declarations! */\n\ + let component = ReasonReact.reducerComponent(\"Example\");\n\ + \n\ + /* greeting and children are props. `children` isn't used, therefore ignored.\n\ + \ We ignore it by prepending it with an underscore */\n\ + let make = (~greeting, _children) => {\n\ + \ /* spread the other default fields of component here and override a few */\n\ + \ ...component,\n\ + \n\ + \ initialState: () => {count: 0, show: true},\n\ + \n\ + \ /* State transitions */\n\ + \ reducer: (action, state) =>\n\ + \ switch (action) {\n\ + \ | Click => ReasonReact.Update({...state, count: state.count + 1})\n\ + \ | Toggle => ReasonReact.Update({...state, show: ! state.show})\n\ + \ },\n\ + \n\ + \ render: self => {\n\ + \ let message =\n\ + \ \"You've clicked this \" ++ string_of_int(self.state.count) ++ \" times(s)\";\n\ + \
\n\ + \ \n\ + \ \n\ + \ {self.state.show ? ReasonReact.string(greeting) : ReasonReact.null}\n\ + \
;\n\ + \ },\n\ + };\n\ + ") ; + File ("index.html", + "\n\ + \n\ + \n\ + \ \n\ + \ ReasonReact Examples\n\ + \n\ + \n\ + \ Component 1:\n\ + \
\n\ + \n\ + \ Component 2:\n\ + \
\n\ + \n\ + \ \n\ + \n\ + \n\ + ")]) ; + File ("bsconfig.json", + "\n\ + {\n\ + \ \"name\": \"react-template\",\n\ + \ \"reason\": {\n\ + \ \"react-jsx\": 2\n\ + \ },\n\ + \ \"sources\": {\n\ + \ \"dir\" : \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": [{\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ }],\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"namespace\": true,\n\ + \ \"bs-dependencies\": [\n\ + \ \"reason-react\"\n\ + \ ],\n\ + \ \"refmt\": 3\n\ + }\n\ + ") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"start\": \"bsb -make-world -w\",\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"test\": \"echo \\\"Error: no test specified\\\" && exit 1\",\n\ + \ \"webpack\": \"webpack -w\",\n\ + \ \"webpack:production\": \"NODE_ENV=production webpack\",\n\ + \ \"server\": \"webpack-dev-server\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"dependencies\": {\n\ + \ \"react\": \"^16.2.0\",\n\ + \ \"react-dom\": \"^16.2.0\",\n\ + \ \"reason-react\": \">=0.4.0\"\n\ + \ },\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\",\n\ + \ \"html-webpack-plugin\": \"^3.2.0\",\n\ + \ \"webpack\": \"^4.0.1\",\n\ + \ \"webpack-cli\": \"^3.1.1\",\n\ + \ \"webpack-dev-server\": \"^3.1.8\"\n\ + \ }\n\ + }\n\ + ") ; + File (".gitignore", + ".DS_Store\n\ + .merlin\n\ + .bsb.lock\n\ + npm-debug.log\n\ + /lib/bs/\n\ + /node_modules/") ; + File ("README.md", + "# ${bsb:name}\n\ + \n\ + ## Run Project\n\ + \n\ + ```sh\n\ + npm install\n\ + npm start\n\ + # in another tab\n\ + npm run webpack\n\ + ```\n\ + \n\ + After you see the webpack compilation succeed (the `npm run webpack` step), open up `build/index.html` (**no server needed!**). Then modify whichever `.re` file in `src` and refresh the page to see the changes.\n\ + \n\ + **For more elaborate ReasonReact examples**, please see https://github.com/reasonml-community/reason-react-example\n\ + \n\ + ## Run Project with Server\n\ + \n\ + To run with the webpack development server run `npm run server` and view in the browser at http://localhost:8000. Running in this environment provides hot reloading and support for routing; just edit and save the file and the browser will automatically refresh.\n\ + \n\ + Note that any hot reload on a route will fall back to the root (`/`), so `ReasonReact.Router.dangerouslyGetInitialUrl` will likely be needed alongside the `ReasonReact.Router.watchUrl` logic to handle routing correctly on hot reload refreshes or simply opening the app at a URL that is not the root.\n\ + \n\ + To use a port other than 8000 set the `PORT` environment variable (`PORT=8080 npm run server`).\n\ + \n\ + ## Build for Production\n\ + \n\ + ```sh\n\ + npm run build\n\ + npm run webpack:production\n\ + ```\n\ + \n\ + This will replace the development artifact `build/Index.js` for an optimized version as well as copy `src/index.html` into `build/`. You can then deploy the contents of the `build` directory (`index.html` and `Index.js`).\n\ + \n\ + If you make use of routing (via `ReasonReact.Router` or similar logic) ensure that server-side routing handles your routes or that 404's are directed back to `index.html` (which is how the dev server is set up).\n\ + \n\ + **To enable dead code elimination**, change `bsconfig.json`'s `package-specs` `module` from `\"commonjs\"` to `\"es6\"`. Then re-run the above 2 commands. This will allow Webpack to remove unused code.\n\ + ") ; + File ("webpack.config.js", + "const path = require('path');\n\ + const HtmlWebpackPlugin = require('html-webpack-plugin');\n\ + const outputDir = path.join(__dirname, 'build/');\n\ + \n\ + const isProd = process.env.NODE_ENV === 'production';\n\ + \n\ + module.exports = {\n\ + \ entry: './src/Index.bs.js',\n\ + \ mode: isProd ? 'production' : 'development',\n\ + \ output: {\n\ + \ path: outputDir,\n\ + \ filename: 'Index.js'\n\ + \ },\n\ + \ plugins: [\n\ + \ new HtmlWebpackPlugin({\n\ + \ template: 'src/index.html',\n\ + \ inject: false\n\ + \ })\n\ + \ ],\n\ + \ devServer: {\n\ + \ compress: true,\n\ + \ contentBase: outputDir,\n\ + \ port: process.env.PORT || 8000,\n\ + \ historyApiFallback: true\n\ + \ }\n\ + };\n\ + ")]) ; + Dir ("react-lite", [ + Dir ("src", [ + File ("Index.re", + "ReactDOMRe.renderToElementWithId(, \"index1\");\n\ + \n\ + ReactDOMRe.renderToElementWithId(, \"index2\");\n\ + ") ; + File ("Component1.re", + "/* This is the basic component. */\n\ + let component = ReasonReact.statelessComponent(\"Component1\");\n\ + \n\ + /* Your familiar handleClick from ReactJS. This mandatorily takes the payload,\n\ + \ then the `self` record, which contains state (none here), `handle`, `reduce`\n\ + \ and other utilities */\n\ + let handleClick = (_event, _self) => Js.log(\"clicked!\");\n\ + \n\ + /* `make` is the function that mandatorily takes `children` (if you want to use\n\ + \ `JSX). `message` is a named argument, which simulates ReactJS props. Usage:\n\ + \n\ + \ ``\n\ + \n\ + \ Which desugars to\n\ + \n\ + \ `ReasonReact.element(Component1.make(~message=\"hello\", [||]))` */\n\ + let make = (~message, _children) => {\n\ + \ ...component,\n\ + \ render: self =>\n\ + \
\n\ + \ {ReasonReact.string(message)}\n\ + \
,\n\ + };\n\ + ") ; + File ("Component2.re", + "/* State declaration */\n\ + type state = {\n\ + \ count: int,\n\ + \ show: bool,\n\ + };\n\ + \n\ + /* Action declaration */\n\ + type action =\n\ + \ | Click\n\ + \ | Toggle;\n\ + \n\ + /* Component template declaration.\n\ + \ Needs to be **after** state and action declarations! */\n\ + let component = ReasonReact.reducerComponent(\"Example\");\n\ + \n\ + /* greeting and children are props. `children` isn't used, therefore ignored.\n\ + \ We ignore it by prepending it with an underscore */\n\ + let make = (~greeting, _children) => {\n\ + \ /* spread the other default fields of component here and override a few */\n\ + \ ...component,\n\ + \n\ + \ initialState: () => {count: 0, show: true},\n\ + \n\ + \ /* State transitions */\n\ + \ reducer: (action, state) =>\n\ + \ switch (action) {\n\ + \ | Click => ReasonReact.Update({...state, count: state.count + 1})\n\ + \ | Toggle => ReasonReact.Update({...state, show: ! state.show})\n\ + \ },\n\ + \n\ + \ render: self => {\n\ + \ let message =\n\ + \ \"You've clicked this \" ++ string_of_int(self.state.count) ++ \" times(s)\";\n\ + \
\n\ + \ \n\ + \ \n\ + \ {self.state.show ? ReasonReact.string(greeting) : ReasonReact.null}\n\ + \
;\n\ + \ },\n\ + };\n\ + ")]) ; + File ("loader.js", + "/* Copyright (C) 2018 Authors of BuckleScript\n\ + \ * \n\ + \ * This program is free software: you can redistribute it and/or modify\n\ + \ * it under the terms of the GNU Lesser General Public License as published by\n\ + \ * the Free Software Foundation, either version 3 of the License, or\n\ + \ * (at your option) any later version.\n\ + \ *\n\ + \ * In addition to the permissions granted to you by the LGPL, you may combine\n\ + \ * or link a \"work that uses the Library\" with a publicly distributed version\n\ + \ * of this file to produce a combined library or application, then distribute\n\ + \ * that combined work under the terms of your choosing, with no requirement\n\ + \ * to comply with the obligations normally placed on you by section 4 of the\n\ + \ * LGPL version 3 (or the corresponding section of a later version of the LGPL\n\ + \ * should you choose to use a later version).\n\ + \ *\n\ + \ * This program is distributed in the hope that it will be useful,\n\ + \ * but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ + \ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ + \ * GNU Lesser General Public License for more details.\n\ + \ * \n\ + \ * You should have received a copy of the GNU Lesser General Public License\n\ + \ * along with this program; if not, write to the Free Software\n\ + \ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */\n\ + \n\ + \n\ + \n\ + //@ts-check\n\ + \n\ + // @ts-ignore\n\ + window.process = { env: { NODE_ENV: 'dev' } }\n\ + \n\ + \n\ + // local to getPath\n\ + var relativeElement = document.createElement(\"a\");\n\ + var baseElement = document.createElement(\"base\");\n\ + document.head.appendChild(baseElement);\n\ + \n\ + export function BsGetPath(id, parent) {\n\ + \ var oldPath = baseElement.href\n\ + \ baseElement.href = parent\n\ + \ relativeElement.href = id\n\ + \ var result = relativeElement.href\n\ + \ baseElement.href = oldPath\n\ + \ return result\n\ + }\n\ + /**\n\ + \ * \n\ + \ * Given current link and its parent, return the new link\n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * @return {string}\n\ + \ */\n\ + function getPathWithJsSuffix(id, parent) {\n\ + \ var oldPath = baseElement.href\n\ + \ baseElement.href = parent\n\ + \ relativeElement.href = id\n\ + \ var result = addSuffixJsIfNot(relativeElement.href)\n\ + \ baseElement.href = oldPath\n\ + \ return result\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} x \n\ + \ */\n\ + function addSuffixJsIfNot(x) {\n\ + \ if (x.endsWith('.js')) {\n\ + \ return x\n\ + \ } else {\n\ + \ return x + '.js'\n\ + \ }\n\ + }\n\ + \n\ + \n\ + var falsePromise = Promise.resolve(false)\n\ + var fetchConfig = {'cache' : 'no-cache'}\n\ + // package.json semantics\n\ + // a string to module object \n\ + // from url -> module object \n\ + // Modules : Map \n\ + // fetch the link:\n\ + // - if it is already fetched before, return the stored promise\n\ + // otherwise create the promise which will be filled with the text if successful\n\ + // or filled with boolean false when failed\n\ + var MODULES = new Map()\n\ + function cachedFetch(link) {\n\ + \ // console.info(link)\n\ + \ var linkResult = MODULES.get(link)\n\ + \ if (linkResult) {\n\ + \ return linkResult\n\ + \ } else {\n\ + \ var p = fetch(link, fetchConfig)\n\ + \ .then(resp => {\n\ + \ if (resp.ok) {\n\ + \ return resp.text()\n\ + \ } else {\n\ + \ return falsePromise\n\ + \ }\n\ + \ })\n\ + \n\ + \ MODULES.set(link, p)\n\ + \ return p\n\ + \ }\n\ + }\n\ + \n\ + // from location id -> url \n\ + // There are two rounds of caching:\n\ + // 1. if location and relative path is hit, no need to run \n\ + // 2. if location and relative path is not hit, but the resolved link is hit, no need \n\ + // for network request\n\ + /**\n\ + \ * @type {Map > > }\n\ + \ */\n\ + var IDLocations = new Map()\n\ + \n\ + /**\n\ + \ * @type {Map > }\n\ + \ */\n\ + var SyncedIDLocations = new Map()\n\ + // Its value is an object \n\ + // { link : String }\n\ + // We will first mark it when visiting (to avoid duplicated computation)\n\ + // and populate its link later\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ */\n\ + function getIdLocation(id, location) {\n\ + \ var idMap = IDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ return idMap.get(id)\n\ + \ }\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ */\n\ + function getIdLocationSync(id, location) {\n\ + \ var idMap = SyncedIDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ return idMap.get(id)\n\ + \ }\n\ + }\n\ + \n\ + function countIDLocations() {\n\ + \ var count = 0\n\ + \ for (let [k, vv] of IDLocations) {\n\ + \ for (let [kv, v] of vv) {\n\ + \ count += 1\n\ + \ }\n\ + \ }\n\ + \ console.log(count, 'modules loaded')\n\ + }\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ * @param {Function} cb \n\ + \ * @returns Promise\n\ + \ */\n\ + function visitIdLocation(id, location, cb) {\n\ + \ var result;\n\ + \ var idMap = IDLocations.get(location)\n\ + \ if (idMap && (result = idMap.get(id))) {\n\ + \ return result\n\ + \ }\n\ + \ else {\n\ + \ result = new Promise(resolve => {\n\ + \ return (cb()).then(res => {\n\ + \ var idMap = SyncedIDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ idMap.set(id, res)\n\ + \ } else {\n\ + \ SyncedIDLocations.set(location, new Map([[id, res]]))\n\ + \ }\n\ + \ return resolve(res)\n\ + \ })\n\ + \ })\n\ + \ if (idMap) {\n\ + \ idMap.set(id, result)\n\ + \ }\n\ + \ else {\n\ + \ IDLocations.set(location, new Map([[id, result]]))\n\ + \ }\n\ + \ return result\n\ + \ }\n\ + }\n\ + \n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @return {string[]}\n\ + \ */\n\ + function getDeps(text) {\n\ + \ var deps = []\n\ + \ text.replace(/(\\/\\*[\\w\\W]*?\\*\\/|\\/\\/[^\\n]*|[.$]r)|\\brequire\\s*\\(\\s*[\"']([^\"']*)[\"']\\s*\\)/g, function (_, ignore, id) {\n\ + \ if (!ignore) deps.push(id);\n\ + \ });\n\ + \ return deps;\n\ + }\n\ + \n\ + \n\ + \n\ + // By using a named \"eval\" most browsers will execute in the global scope.\n\ + // http://www.davidflanagan.com/2010/12/global-eval-in.html\n\ + var globalEval = eval;\n\ + \n\ + // function parentURL(url) {\n\ + // if (url.endsWith('/')) {\n\ + // return url + '../'\n\ + // } else {\n\ + // return url + '/../'\n\ + // }\n\ + // }\n\ + \n\ + \n\ + \n\ + // loader.js:23 http://localhost:8080/node_modules/react-dom/cjs/react-dom.development.js/..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//../ fbjs/lib/containsNode Promise\xC2\xA0{}\n\ + // 23:10:02.884 loader.js:23 http://localhost:8080/node_modules/react-dom/cjs/react-dom.development.js/..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//../ fbjs/lib/invariant Promise\xC2\xA0{}\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ */\n\ + function getParentModulePromise(id, parent) {\n\ + \ var parentLink = BsGetPath('..', parent)\n\ + \ if (parentLink === parent) {\n\ + \ return falsePromise\n\ + \ }\n\ + \ return getPackageJsPromise(id, parentLink)\n\ + }\n\ + // In the beginning\n\ + // it is `resolveModule('./main.js', '')\n\ + // return the promise of link and text \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ */\n\ + function getPackageName(id) {\n\ + \ var index = id.indexOf('/')\n\ + \ if (id[0] === '@') index = id.indexOf('/', index + 1)\n\ + \ if (index === -1) {\n\ + \ return id\n\ + \ }\n\ + \ return id.substring(0, index)\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} s \n\ + \ * @param {string} text \n\ + \ * @returns {undefined | string }\n\ + \ */\n\ + function isJustAPackageAndHasMainField(s,text){\n\ + \ if(s.indexOf('/') >= 0){\n\ + \ return \n\ + \ } else {\n\ + \ var mainField; \n\ + \ try {\n\ + \ mainField = JSON.parse(text).main\n\ + \ }catch(_){\n\ + \ }\n\ + \ if(mainField === undefined){\n\ + \ return \n\ + \ } else {\n\ + \ return mainField\n\ + \ }\n\ + \ }\n\ + }\n\ + function getPackageJsPromise(id, parent) {\n\ + \ var idNodeModulesPrefix = './node_modules/' + id\n\ + \ var link = getPathWithJsSuffix(idNodeModulesPrefix, parent)\n\ + \ if (parent.endsWith('node_modules/')) {\n\ + \ // impossible that `node_modules/node_modules/xx/x\n\ + \ // return falsePromise\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \n\ + \ var packageJson = BsGetPath(`./node_modules/${getPackageName(id)}/package.json`, parent)\n\ + \n\ + \ return cachedFetch(packageJson)\n\ + \ .then(\n\ + \ function (text) {\n\ + \ if (text !== false) {\n\ + \ var mainField; \n\ + \ if( (mainField = isJustAPackageAndHasMainField(id, text)) !== undefined){\n\ + \ var packageLink = BsGetPath(addSuffixJsIfNot(`./node_modules/${id}/${mainField}`), parent)\n\ + \ return cachedFetch(packageLink)\n\ + \ .then(function(text){\n\ + \ if(text !== false){\n\ + \ return {text, link : packageLink}\n\ + \ } else {\n\ + \ return getParentModulePromise(id,parent)\n\ + \ }\n\ + \ })\n\ + \n\ + \ } else {\n\ + \ // package indeed exist\n\ + \ return cachedFetch(link).then(function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link }\n\ + \ } else if (!id.endsWith('.js')) {\n\ + \ var linkNew = getPathWithJsSuffix(idNodeModulesPrefix + `/index.js`, parent)\n\ + \ return cachedFetch(linkNew)\n\ + \ .then(function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link: linkNew }\n\ + \ } else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ })\n\ + \n\ + \ } else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ })\n\ + \ }\n\ + \ }\n\ + \ else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ }\n\ + \ )\n\ + \n\ + \n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * can return Promise , false means\n\ + \ * this module can not be resolved\n\ + \ */\n\ + function getModulePromise(id, parent) {\n\ + \ var done = getIdLocation(id, parent)\n\ + \ if (!done) {\n\ + \ return visitIdLocation(id, parent, function () {\n\ + \ if (id[0] != '.') { // package path\n\ + \ return getPackageJsPromise(id, parent)\n\ + \ } else { // relative path, one shot resolve \n\ + \ let link = getPathWithJsSuffix(id, parent)\n\ + \ return cachedFetch(link).then(\n\ + \ function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link }\n\ + \ } else if (!id.endsWith('.js')){ \n\ + \ // could be \"./dir\"\n\ + \ var newLink = getPathWithJsSuffix( id +\"/index.js\",parent)\n\ + \ return cachedFetch(newLink)\n\ + \ .then(function(text){\n\ + \ if(text !== false){\n\ + \ return{text, link : newLink }\n\ + \ } else {\n\ + \ throw new Error(` ${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + \ })\n\ + \ }\n\ + \ else {\n\ + \ throw new Error(` ${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + \ }\n\ + \ )\n\ + \ }\n\ + \ })\n\ + \ } else {\n\ + \ return done\n\ + \ }\n\ + }\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * @returns {Promise}\n\ + \ */\n\ + function getAll(id, parent) {\n\ + \ return getModulePromise(id, parent)\n\ + \ .then(function (obj) {\n\ + \ if (obj) {\n\ + \ var deps = getDeps(obj.text)\n\ + \ return Promise.all(deps.map(x => getAll(x, obj.link)))\n\ + \ } else {\n\ + \ throw new Error(`${id}@${parent} was not resolved successfully`)\n\ + \ }\n\ + \ })\n\ + };\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @param {string} parent \n\ + \ * @returns {Promise}\n\ + \ */\n\ + function getAllFromText(text, parent) {\n\ + \ var deps = getDeps(text)\n\ + \ return Promise.all(deps.map(x => getAll(x, parent)))\n\ + }\n\ + \n\ + var evaluatedModules = new Map()\n\ + \n\ + function loadSync(id, parent) {\n\ + \ var baseOrModule = getIdLocationSync(id, parent)\n\ + \ if (baseOrModule && baseOrModule.link !== undefined) {\n\ + \ if(evaluatedModules.has(baseOrModule.link)){\n\ + \ return evaluatedModules.get(baseOrModule.link).exports\n\ + \ }\n\ + \ if (!baseOrModule.exports) {\n\ + \ baseOrModule.exports = {}\n\ + \ globalEval(`(function(require,exports,module){${baseOrModule.text}\\n})//# sourceURL=${baseOrModule.link}`)(\n\ + \ function require(id) {\n\ + \ return loadSync(id, baseOrModule.link);\n\ + \ }, // require\n\ + \ baseOrModule.exports = {}, // exports\n\ + \ baseOrModule // module\n\ + \ );\n\ + \ }\n\ + \ if(!evaluatedModules.has(baseOrModule.link)){\n\ + \ evaluatedModules.set(baseOrModule.link,baseOrModule)\n\ + \ }\n\ + \ return baseOrModule.exports\n\ + \ } else {\n\ + \ throw new Error(`${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + }\n\ + \n\ + \n\ + function genEvalName() {\n\ + \ return \"eval-\" + ((\"\" + Math.random()).substr(2, 5))\n\ + }\n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @param {string} link\n\ + \ * In this case [text] evaluated result will not be cached\n\ + \ */\n\ + function loadTextSync(text, link) {\n\ + \ var baseOrModule = { exports: {}, text, link }\n\ + \ globalEval(`(function(require,exports,module){${baseOrModule.text}\\n})//# sourceURL=${baseOrModule.link}/${genEvalName()}.js`)(\n\ + \ function require(id) {\n\ + \ return loadSync(id, baseOrModule.link);\n\ + \ }, // require\n\ + \ baseOrModule.exports, // exports\n\ + \ baseOrModule // module\n\ + \ );\n\ + \ return baseOrModule.exports\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ */\n\ + function BSloadText(text) {\n\ + \ console.time(\"Loading\")\n\ + \ var parent = BsGetPath(\".\", document.baseURI)\n\ + \ return getAllFromText(text, parent).then(function () {\n\ + \ var result = loadTextSync(text, parent)\n\ + \ console.timeEnd(\"Loading\")\n\ + \ return result\n\ + \ })\n\ + };\n\ + \n\ + \n\ + function load(id, parent) {\n\ + \ return getAll(id, parent).then(function () {\n\ + \ return loadSync(id, parent)\n\ + \ })\n\ + \n\ + };\n\ + \n\ + \n\ + export function BSload(id) {\n\ + \ var parent = BsGetPath(\".\", document.baseURI)\n\ + \ return load(id, parent)\n\ + }\n\ + \n\ + export var BSLoader = {\n\ + \ loadText: BSloadText,\n\ + \ load: BSload,\n\ + \ SyncedIDLocations: SyncedIDLocations\n\ + };\n\ + \n\ + window.BSLoader = BSLoader;\n\ + \n\ + var main = document.querySelector('script[data-main]')\n\ + if (main) {\n\ + \ BSload(main.dataset.main)\n\ + }\n\ + ") ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"react-lite\",\n\ + \ \"reason\": {\n\ + \ \"react-jsx\": 2\n\ + \ },\n\ + \ \"sources\": {\n\ + \ \"dir\" : \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": [{\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ }],\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"namespace\": true,\n\ + \ \"bs-dependencies\": [\n\ + \ \"reason-react\"\n\ + \ ],\n\ + \ \"refmt\": 3\n\ + }\n\ + ") ; + File ("watcher.js", + "\n\ + \n\ + var wsReloader;\n\ + var LAST_SUCCESS_BUILD_STAMP = (localStorage.getItem('LAST_SUCCESS_BUILD_STAMP') || 0)\n\ + var WS_PORT = 9999; // configurable\n\ + \n\ + function setUpWebScoket() {\n\ + \ if (wsReloader == null || wsReloader.readyState !== 1) {\n\ + \ try {\n\ + \ wsReloader = new WebSocket(`ws://localhost:${WS_PORT}`)\n\ + \ wsReloader.onmessage = (msg) => {\n\ + \ var newData = JSON.parse(msg.data).LAST_SUCCESS_BUILD_STAMP\n\ + \ if (newData > LAST_SUCCESS_BUILD_STAMP) {\n\ + \ LAST_SUCCESS_BUILD_STAMP = newData\n\ + \ localStorage.setItem('LAST_SUCCESS_BUILD_STAMP', LAST_SUCCESS_BUILD_STAMP)\n\ + \ location.reload(true)\n\ + \ }\n\ + \n\ + \ }\n\ + \ } catch (exn) {\n\ + \ console.error(\"web socket failed connect\")\n\ + \ }\n\ + \ }\n\ + };\n\ + \n\ + setUpWebScoket();\n\ + setInterval(setUpWebScoket, 2000);") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"start\": \"bsb -make-world -w -ws _ \",\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"test\": \"echo \\\"Error: no test specified\\\" && exit 1\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"dependencies\": {\n\ + \ \"react\": \"^16.2.0\",\n\ + \ \"react-dom\": \"^16.2.0\",\n\ + \ \"reason-react\": \">=0.4.0\"\n\ + \ },\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ }\n\ + }\n\ + ") ; + File (".gitignore", + ".DS_Store\n\ + .merlin\n\ + .bsb.lock\n\ + npm-debug.log\n\ + /lib/bs/\n\ + /node_modules/") ; + File ("README.md", + "# react\n\ + \n\ + ## Run Project\n\ + \n\ + ```sh\n\ + npm install\n\ + npm start\n\ + ```\n\ + \n\ + Suppose you have a http-server running (try `npm i -g http-server`)\n\ + \n\ + \n\ + Then modify whichever `.re` file in `src` and refresh the page to see the changes.\n\ + \n\ + **For more elaborate ReasonReact examples**, please see https://github.com/reasonml-community/reason-react-example\n\ + \n\ + ") ; + File ("index.html", + "\n\ + \n\ + \n\ + \ \n\ + \ ReasonReact Examples\n\ + \n\ + \n\ + \ Component 1:\n\ + \
\n\ + \ Component 2:\n\ + \
\n\ + \n\ + \ \n\ + \ \n\ + \n\ + \n\ + ")]) ; + Dir ("tea", [ + Dir ("src", [ + File ("main.ml", + "\n\ + \n\ + \n\ + Js.Global.setTimeout\n\ + \ (fun _ -> \n\ + \ Demo.main (Web.Document.getElementById \"my-element\") () \n\ + \ |. ignore\n\ + \ ) \n\ + 0") ; + File ("demo.ml", + "(* This line opens the Tea.App modules into the current scope for Program access functions and types *)\n\ + open Tea.App\n\ + \n\ + (* This opens the Elm-style virtual-dom functions and types into the current scope *)\n\ + open Tea.Html\n\ + \n\ + (* Let's create a new type here to be our main message type that is passed around *)\n\ + type msg =\n\ + \ | Increment (* This will be our message to increment the counter *)\n\ + \ | Decrement (* This will be our message to decrement the counter *)\n\ + \ | Reset (* This will be our message to reset the counter to 0 *)\n\ + \ | Set of int (* This will be our message to set the counter to a specific value *)\n\ + \ [@@bs.deriving {accessors}] (* This is a nice quality-of-life addon from Bucklescript, it will generate function names for each constructor name, optional, but nice to cut down on code, this is unused in this example but good to have regardless *)\n\ + \n\ + (* This is optional for such a simple example, but it is good to have an `init` function to define your initial model default values, the model for Counter is just an integer *)\n\ + let init () = 4\n\ + \n\ + (* This is the central message handler, it takes the model as the first argument *)\n\ + let update model = function (* These should be simple enough to be self-explanatory, mutate the model based on the message, easy to read and follow *)\n\ + \ | Increment -> model + 1\n\ + \ | Decrement -> model - 1\n\ + \ | Reset -> 0\n\ + \ | Set v -> v\n\ + \n\ + (* This is just a helper function for the view, a simple function that returns a button based on some argument *)\n\ + let view_button title msg =\n\ + \ button\n\ + \ [ onClick msg\n\ + \ ]\n\ + \ [ text title\n\ + \ ]\n\ + \n\ + (* This is the main callback to generate the virtual-dom.\n\ + \ This returns a virtual-dom node that becomes the view, only changes from call-to-call are set on the real DOM for efficiency, this is also only called once per frame even with many messages sent in within that frame, otherwise does nothing *)\n\ + let view model =\n\ + \ div\n\ + \ []\n\ + \ [ span\n\ + \ [ style \"text-weight\" \"bold\" ]\n\ + \ [ text (string_of_int model) ]\n\ + \ ; br []\n\ + \ ; view_button \"Increment\" Increment\n\ + \ ; br []\n\ + \ ; view_button \"Decrement\" Decrement\n\ + \ ; br []\n\ + \ ; view_button \"Set to 2\" (Set 42)\n\ + \ ; br []\n\ + \ ; if model <> 0 then view_button \"Reset\" Reset else noNode\n\ + \ ]\n\ + \n\ + (* This is the main function, it can be named anything you want but `main` is traditional.\n\ + \ The Program returned here has a set of callbacks that can easily be called from\n\ + \ Bucklescript or from javascript for running this main attached to an element,\n\ + \ or even to pass a message into the event loop. You can even expose the\n\ + \ constructors to the messages to javascript via the above [@@bs.deriving {accessors}]\n\ + \ attribute on the `msg` type or manually, that way even javascript can use it safely. *)\n\ + let main =\n\ + \ beginnerProgram { (* The beginnerProgram just takes a set model state and the update and view functions *)\n\ + \ model = init (); (* Since model is a set value here, we call our init function to generate that value *)\n\ + \ update;\n\ + \ view;\n\ + \ }")]) ; + File ("loader.js", + "/* Copyright (C) 2018 Authors of BuckleScript\n\ + \ * \n\ + \ * This program is free software: you can redistribute it and/or modify\n\ + \ * it under the terms of the GNU Lesser General Public License as published by\n\ + \ * the Free Software Foundation, either version 3 of the License, or\n\ + \ * (at your option) any later version.\n\ + \ *\n\ + \ * In addition to the permissions granted to you by the LGPL, you may combine\n\ + \ * or link a \"work that uses the Library\" with a publicly distributed version\n\ + \ * of this file to produce a combined library or application, then distribute\n\ + \ * that combined work under the terms of your choosing, with no requirement\n\ + \ * to comply with the obligations normally placed on you by section 4 of the\n\ + \ * LGPL version 3 (or the corresponding section of a later version of the LGPL\n\ + \ * should you choose to use a later version).\n\ + \ *\n\ + \ * This program is distributed in the hope that it will be useful,\n\ + \ * but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ + \ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ + \ * GNU Lesser General Public License for more details.\n\ + \ * \n\ + \ * You should have received a copy of the GNU Lesser General Public License\n\ + \ * along with this program; if not, write to the Free Software\n\ + \ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */\n\ + \n\ + \n\ + \n\ + //@ts-check\n\ + \n\ + // @ts-ignore\n\ + window.process = { env: { NODE_ENV: 'dev' } }\n\ + \n\ + \n\ + // local to getPath\n\ + var relativeElement = document.createElement(\"a\");\n\ + var baseElement = document.createElement(\"base\");\n\ + document.head.appendChild(baseElement);\n\ + \n\ + export function BsGetPath(id, parent) {\n\ + \ var oldPath = baseElement.href\n\ + \ baseElement.href = parent\n\ + \ relativeElement.href = id\n\ + \ var result = relativeElement.href\n\ + \ baseElement.href = oldPath\n\ + \ return result\n\ + }\n\ + /**\n\ + \ * \n\ + \ * Given current link and its parent, return the new link\n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * @return {string}\n\ + \ */\n\ + function getPathWithJsSuffix(id, parent) {\n\ + \ var oldPath = baseElement.href\n\ + \ baseElement.href = parent\n\ + \ relativeElement.href = id\n\ + \ var result = addSuffixJsIfNot(relativeElement.href)\n\ + \ baseElement.href = oldPath\n\ + \ return result\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} x \n\ + \ */\n\ + function addSuffixJsIfNot(x) {\n\ + \ if (x.endsWith('.js')) {\n\ + \ return x\n\ + \ } else {\n\ + \ return x + '.js'\n\ + \ }\n\ + }\n\ + \n\ + \n\ + var falsePromise = Promise.resolve(false)\n\ + var fetchConfig = {'cache' : 'no-cache'}\n\ + // package.json semantics\n\ + // a string to module object \n\ + // from url -> module object \n\ + // Modules : Map \n\ + // fetch the link:\n\ + // - if it is already fetched before, return the stored promise\n\ + // otherwise create the promise which will be filled with the text if successful\n\ + // or filled with boolean false when failed\n\ + var MODULES = new Map()\n\ + function cachedFetch(link) {\n\ + \ // console.info(link)\n\ + \ var linkResult = MODULES.get(link)\n\ + \ if (linkResult) {\n\ + \ return linkResult\n\ + \ } else {\n\ + \ var p = fetch(link, fetchConfig)\n\ + \ .then(resp => {\n\ + \ if (resp.ok) {\n\ + \ return resp.text()\n\ + \ } else {\n\ + \ return falsePromise\n\ + \ }\n\ + \ })\n\ + \n\ + \ MODULES.set(link, p)\n\ + \ return p\n\ + \ }\n\ + }\n\ + \n\ + // from location id -> url \n\ + // There are two rounds of caching:\n\ + // 1. if location and relative path is hit, no need to run \n\ + // 2. if location and relative path is not hit, but the resolved link is hit, no need \n\ + // for network request\n\ + /**\n\ + \ * @type {Map > > }\n\ + \ */\n\ + var IDLocations = new Map()\n\ + \n\ + /**\n\ + \ * @type {Map > }\n\ + \ */\n\ + var SyncedIDLocations = new Map()\n\ + // Its value is an object \n\ + // { link : String }\n\ + // We will first mark it when visiting (to avoid duplicated computation)\n\ + // and populate its link later\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ */\n\ + function getIdLocation(id, location) {\n\ + \ var idMap = IDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ return idMap.get(id)\n\ + \ }\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ */\n\ + function getIdLocationSync(id, location) {\n\ + \ var idMap = SyncedIDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ return idMap.get(id)\n\ + \ }\n\ + }\n\ + \n\ + function countIDLocations() {\n\ + \ var count = 0\n\ + \ for (let [k, vv] of IDLocations) {\n\ + \ for (let [kv, v] of vv) {\n\ + \ count += 1\n\ + \ }\n\ + \ }\n\ + \ console.log(count, 'modules loaded')\n\ + }\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} location \n\ + \ * @param {Function} cb \n\ + \ * @returns Promise\n\ + \ */\n\ + function visitIdLocation(id, location, cb) {\n\ + \ var result;\n\ + \ var idMap = IDLocations.get(location)\n\ + \ if (idMap && (result = idMap.get(id))) {\n\ + \ return result\n\ + \ }\n\ + \ else {\n\ + \ result = new Promise(resolve => {\n\ + \ return (cb()).then(res => {\n\ + \ var idMap = SyncedIDLocations.get(location)\n\ + \ if (idMap) {\n\ + \ idMap.set(id, res)\n\ + \ } else {\n\ + \ SyncedIDLocations.set(location, new Map([[id, res]]))\n\ + \ }\n\ + \ return resolve(res)\n\ + \ })\n\ + \ })\n\ + \ if (idMap) {\n\ + \ idMap.set(id, result)\n\ + \ }\n\ + \ else {\n\ + \ IDLocations.set(location, new Map([[id, result]]))\n\ + \ }\n\ + \ return result\n\ + \ }\n\ + }\n\ + \n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @return {string[]}\n\ + \ */\n\ + function getDeps(text) {\n\ + \ var deps = []\n\ + \ text.replace(/(\\/\\*[\\w\\W]*?\\*\\/|\\/\\/[^\\n]*|[.$]r)|\\brequire\\s*\\(\\s*[\"']([^\"']*)[\"']\\s*\\)/g, function (_, ignore, id) {\n\ + \ if (!ignore) deps.push(id);\n\ + \ });\n\ + \ return deps;\n\ + }\n\ + \n\ + \n\ + \n\ + // By using a named \"eval\" most browsers will execute in the global scope.\n\ + // http://www.davidflanagan.com/2010/12/global-eval-in.html\n\ + var globalEval = eval;\n\ + \n\ + // function parentURL(url) {\n\ + // if (url.endsWith('/')) {\n\ + // return url + '../'\n\ + // } else {\n\ + // return url + '/../'\n\ + // }\n\ + // }\n\ + \n\ + \n\ + \n\ + // loader.js:23 http://localhost:8080/node_modules/react-dom/cjs/react-dom.development.js/..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//../ fbjs/lib/containsNode Promise\xC2\xA0{}\n\ + // 23:10:02.884 loader.js:23 http://localhost:8080/node_modules/react-dom/cjs/react-dom.development.js/..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//..//../ fbjs/lib/invariant Promise\xC2\xA0{}\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ */\n\ + function getParentModulePromise(id, parent) {\n\ + \ var parentLink = BsGetPath('..', parent)\n\ + \ if (parentLink === parent) {\n\ + \ return falsePromise\n\ + \ }\n\ + \ return getPackageJsPromise(id, parentLink)\n\ + }\n\ + // In the beginning\n\ + // it is `resolveModule('./main.js', '')\n\ + // return the promise of link and text \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ */\n\ + function getPackageName(id) {\n\ + \ var index = id.indexOf('/')\n\ + \ if (id[0] === '@') index = id.indexOf('/', index + 1)\n\ + \ if (index === -1) {\n\ + \ return id\n\ + \ }\n\ + \ return id.substring(0, index)\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} s \n\ + \ * @param {string} text \n\ + \ * @returns {undefined | string }\n\ + \ */\n\ + function isJustAPackageAndHasMainField(s,text){\n\ + \ if(s.indexOf('/') >= 0){\n\ + \ return \n\ + \ } else {\n\ + \ var mainField; \n\ + \ try {\n\ + \ mainField = JSON.parse(text).main\n\ + \ }catch(_){\n\ + \ }\n\ + \ if(mainField === undefined){\n\ + \ return \n\ + \ } else {\n\ + \ return mainField\n\ + \ }\n\ + \ }\n\ + }\n\ + function getPackageJsPromise(id, parent) {\n\ + \ var idNodeModulesPrefix = './node_modules/' + id\n\ + \ var link = getPathWithJsSuffix(idNodeModulesPrefix, parent)\n\ + \ if (parent.endsWith('node_modules/')) {\n\ + \ // impossible that `node_modules/node_modules/xx/x\n\ + \ // return falsePromise\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \n\ + \ var packageJson = BsGetPath(`./node_modules/${getPackageName(id)}/package.json`, parent)\n\ + \n\ + \ return cachedFetch(packageJson)\n\ + \ .then(\n\ + \ function (text) {\n\ + \ if (text !== false) {\n\ + \ var mainField; \n\ + \ if( (mainField = isJustAPackageAndHasMainField(id, text)) !== undefined){\n\ + \ var packageLink = BsGetPath(addSuffixJsIfNot(`./node_modules/${id}/${mainField}`), parent)\n\ + \ return cachedFetch(packageLink)\n\ + \ .then(function(text){\n\ + \ if(text !== false){\n\ + \ return {text, link : packageLink}\n\ + \ } else {\n\ + \ return getParentModulePromise(id,parent)\n\ + \ }\n\ + \ })\n\ + \n\ + \ } else {\n\ + \ // package indeed exist\n\ + \ return cachedFetch(link).then(function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link }\n\ + \ } else if (!id.endsWith('.js')) {\n\ + \ var linkNew = getPathWithJsSuffix(idNodeModulesPrefix + `/index.js`, parent)\n\ + \ return cachedFetch(linkNew)\n\ + \ .then(function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link: linkNew }\n\ + \ } else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ })\n\ + \n\ + \ } else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ })\n\ + \ }\n\ + \ }\n\ + \ else {\n\ + \ return getParentModulePromise(id, parent)\n\ + \ }\n\ + \ }\n\ + \ )\n\ + \n\ + \n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * can return Promise , false means\n\ + \ * this module can not be resolved\n\ + \ */\n\ + function getModulePromise(id, parent) {\n\ + \ var done = getIdLocation(id, parent)\n\ + \ if (!done) {\n\ + \ return visitIdLocation(id, parent, function () {\n\ + \ if (id[0] != '.') { // package path\n\ + \ return getPackageJsPromise(id, parent)\n\ + \ } else { // relative path, one shot resolve \n\ + \ let link = getPathWithJsSuffix(id, parent)\n\ + \ return cachedFetch(link).then(\n\ + \ function (text) {\n\ + \ if (text !== false) {\n\ + \ return { text, link }\n\ + \ } else if (!id.endsWith('.js')){ \n\ + \ // could be \"./dir\"\n\ + \ var newLink = getPathWithJsSuffix( id +\"/index.js\",parent)\n\ + \ return cachedFetch(newLink)\n\ + \ .then(function(text){\n\ + \ if(text !== false){\n\ + \ return{text, link : newLink }\n\ + \ } else {\n\ + \ throw new Error(` ${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + \ })\n\ + \ }\n\ + \ else {\n\ + \ throw new Error(` ${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + \ }\n\ + \ )\n\ + \ }\n\ + \ })\n\ + \ } else {\n\ + \ return done\n\ + \ }\n\ + }\n\ + \n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} id \n\ + \ * @param {string} parent \n\ + \ * @returns {Promise}\n\ + \ */\n\ + function getAll(id, parent) {\n\ + \ return getModulePromise(id, parent)\n\ + \ .then(function (obj) {\n\ + \ if (obj) {\n\ + \ var deps = getDeps(obj.text)\n\ + \ return Promise.all(deps.map(x => getAll(x, obj.link)))\n\ + \ } else {\n\ + \ throw new Error(`${id}@${parent} was not resolved successfully`)\n\ + \ }\n\ + \ })\n\ + };\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @param {string} parent \n\ + \ * @returns {Promise}\n\ + \ */\n\ + function getAllFromText(text, parent) {\n\ + \ var deps = getDeps(text)\n\ + \ return Promise.all(deps.map(x => getAll(x, parent)))\n\ + }\n\ + \n\ + var evaluatedModules = new Map()\n\ + \n\ + function loadSync(id, parent) {\n\ + \ var baseOrModule = getIdLocationSync(id, parent)\n\ + \ if (baseOrModule && baseOrModule.link !== undefined) {\n\ + \ if(evaluatedModules.has(baseOrModule.link)){\n\ + \ return evaluatedModules.get(baseOrModule.link).exports\n\ + \ }\n\ + \ if (!baseOrModule.exports) {\n\ + \ baseOrModule.exports = {}\n\ + \ globalEval(`(function(require,exports,module){${baseOrModule.text}\\n})//# sourceURL=${baseOrModule.link}`)(\n\ + \ function require(id) {\n\ + \ return loadSync(id, baseOrModule.link);\n\ + \ }, // require\n\ + \ baseOrModule.exports = {}, // exports\n\ + \ baseOrModule // module\n\ + \ );\n\ + \ }\n\ + \ if(!evaluatedModules.has(baseOrModule.link)){\n\ + \ evaluatedModules.set(baseOrModule.link,baseOrModule)\n\ + \ }\n\ + \ return baseOrModule.exports\n\ + \ } else {\n\ + \ throw new Error(`${id} : ${parent} could not be resolved`)\n\ + \ }\n\ + }\n\ + \n\ + \n\ + function genEvalName() {\n\ + \ return \"eval-\" + ((\"\" + Math.random()).substr(2, 5))\n\ + }\n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ * @param {string} link\n\ + \ * In this case [text] evaluated result will not be cached\n\ + \ */\n\ + function loadTextSync(text, link) {\n\ + \ var baseOrModule = { exports: {}, text, link }\n\ + \ globalEval(`(function(require,exports,module){${baseOrModule.text}\\n})//# sourceURL=${baseOrModule.link}/${genEvalName()}.js`)(\n\ + \ function require(id) {\n\ + \ return loadSync(id, baseOrModule.link);\n\ + \ }, // require\n\ + \ baseOrModule.exports, // exports\n\ + \ baseOrModule // module\n\ + \ );\n\ + \ return baseOrModule.exports\n\ + }\n\ + \n\ + /**\n\ + \ * \n\ + \ * @param {string} text \n\ + \ */\n\ + function BSloadText(text) {\n\ + \ console.time(\"Loading\")\n\ + \ var parent = BsGetPath(\".\", document.baseURI)\n\ + \ return getAllFromText(text, parent).then(function () {\n\ + \ var result = loadTextSync(text, parent)\n\ + \ console.timeEnd(\"Loading\")\n\ + \ return result\n\ + \ })\n\ + };\n\ + \n\ + \n\ + function load(id, parent) {\n\ + \ return getAll(id, parent).then(function () {\n\ + \ return loadSync(id, parent)\n\ + \ })\n\ + \n\ + };\n\ + \n\ + \n\ + export function BSload(id) {\n\ + \ var parent = BsGetPath(\".\", document.baseURI)\n\ + \ return load(id, parent)\n\ + }\n\ + \n\ + export var BSLoader = {\n\ + \ loadText: BSloadText,\n\ + \ load: BSload,\n\ + \ SyncedIDLocations: SyncedIDLocations\n\ + };\n\ + \n\ + window.BSLoader = BSLoader;\n\ + \n\ + var main = document.querySelector('script[data-main]')\n\ + if (main) {\n\ + \ BSload(main.dataset.main)\n\ + }\n\ + ") ; + File ("bsconfig.json", + "{\n\ + \ \"name\": \"tea\",\n\ + \ \"version\": \"0.1.0\",\n\ + \ \"sources\": {\n\ + \ \"dir\" : \"src\",\n\ + \ \"subdirs\" : true\n\ + \ },\n\ + \ \"package-specs\": {\n\ + \ \"module\": \"commonjs\",\n\ + \ \"in-source\": true\n\ + \ },\n\ + \ \"suffix\": \".bs.js\",\n\ + \ \"bs-dependencies\": [\n\ + \ \"bucklescript-tea\"\n\ + \ ],\n\ + \ \"warnings\": {\n\ + \ \"error\" : \"+101\"\n\ + \ }\n\ + }\n\ + ") ; + File ("watcher.js", + "\n\ + \n\ + var wsReloader;\n\ + var LAST_SUCCESS_BUILD_STAMP = (localStorage.getItem('LAST_SUCCESS_BUILD_STAMP') || 0)\n\ + var WS_PORT = 9999; // configurable\n\ + \n\ + function setUpWebScoket() {\n\ + \ if (wsReloader == null || wsReloader.readyState !== 1) {\n\ + \ try {\n\ + \ wsReloader = new WebSocket(`ws://localhost:${WS_PORT}`)\n\ + \ wsReloader.onmessage = (msg) => {\n\ + \ var newData = JSON.parse(msg.data).LAST_SUCCESS_BUILD_STAMP\n\ + \ if (newData > LAST_SUCCESS_BUILD_STAMP) {\n\ + \ LAST_SUCCESS_BUILD_STAMP = newData\n\ + \ localStorage.setItem('LAST_SUCCESS_BUILD_STAMP', LAST_SUCCESS_BUILD_STAMP)\n\ + \ location.reload(true)\n\ + \ }\n\ + \n\ + \ }\n\ + \ } catch (exn) {\n\ + \ console.error(\"web socket failed connect\")\n\ + \ }\n\ + \ }\n\ + };\n\ + \n\ + setUpWebScoket();\n\ + setInterval(setUpWebScoket, 2000);") ; + File ("package.json", + "{\n\ + \ \"name\": \"${bsb:name}\",\n\ + \ \"version\": \"${bsb:proj-version}\",\n\ + \ \"scripts\": {\n\ + \ \"clean\": \"bsb -clean-world\",\n\ + \ \"build\": \"bsb -make-world\",\n\ + \ \"watch\": \"bsb -make-world -w -ws _\"\n\ + \ },\n\ + \ \"keywords\": [\n\ + \ \"BuckleScript\"\n\ + \ ],\n\ + \ \"author\": \"\",\n\ + \ \"license\": \"MIT\",\n\ + \ \"devDependencies\": {\n\ + \ \"bs-platform\": \"^${bsb:bs-version}\"\n\ + \ },\n\ + \ \"dependencies\": {\n\ + \ \"bucklescript-tea\": \"^0.7.4\"\n\ + \ }\n\ + }\n\ + ") ; + File ("README.md", + "\n\ + \n\ + # Build\n\ + ```\n\ + npm run build\n\ + ```\n\ + \n\ + # Watch\n\ + \n\ + ```\n\ + npm run watch\n\ + ```\n\ + \n\ + create a http-server\n\ + \n\ + ```\n\ + npm install -g http-server\n\ + ```\n\ + \n\ + Edit the file and see the changes automatically reloaded in the browser\n\ + ") ; + File ("index.html", + "\n\ + \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ Bucklescript TEA Starter Kit\n\ + \ \n\ + \ \n\ + \n\ + \n\ + \ \n\ + \
\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + ")]) +]) + +end +module Ext_io : sig +#1 "ext_io.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 load_file : string -> string + +val rev_lines_of_file : string -> string list + +val write_file : string -> string -> unit + +end = struct +#1 "ext_io.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. *) + + +(** on 32 bit , there are 16M limitation *) +let load_file f = + Ext_pervasives.finally (open_in_bin f) close_in begin fun ic -> + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + Bytes.unsafe_to_string s + end + + +let rev_lines_of_file file = + Ext_pervasives.finally (open_in_bin file) close_in begin fun chan -> + let rec loop acc = + match input_line chan with + | line -> loop (line :: acc) + | exception End_of_file -> close_in chan ; acc in + loop [] + end + +let write_file f content = + Ext_pervasives.finally (open_out_bin f) close_out begin fun oc -> + output_string oc content + end + +end +module Bsb_theme_init : sig +#1 "bsb_theme_init.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 init_sample_project : cwd:string -> theme:string -> string -> unit + +val list_themes : unit -> unit +end = struct +#1 "bsb_theme_init.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. *) + + +type file_type = + | Directory + | Non_directory_file + | Non_exists + +let classify_file name = + let exists = Sys.file_exists name in + if exists then + if Sys.is_directory name then Directory + else Non_directory_file + else Non_exists + +let replace s env : string = + Bsb_regex.global_substitute s ~reg:"\\${bsb:\\([-a-zA-Z0-9]+\\)}" + (fun (_s : string) templates -> + match templates with + | key::_ -> + String_hashtbl.find_exn env key + | _ -> assert false + ) + +let (//) = Filename.concat + +(* TODO: Check Ext_io.write_file may overwrite, duplicate with Bsb_config_parse *) +let get_bs_platform_version_if_exists dir = + match + Ext_json_parse.parse_json_from_file + (Filename.concat dir Literals.package_json) with + | Obj {map} + -> + (match String_map.find_exn map Bsb_build_schemas.version with + | Str {str} -> str + | _ -> assert false) + | _ -> assert false + +let run_npm_link cwd dirname = + let bs_platform_dir = + Filename.concat Literals.node_modules Bs_version.package_name in + if Sys.file_exists bs_platform_dir + then + if get_bs_platform_version_if_exists bs_platform_dir = Bs_version.version then + begin + Format.fprintf Format.std_formatter + "bs-platform already exists(version match), no need symlink@." + end + else + begin + Format.fprintf Format.err_formatter + "bs-platform already exists, but version mismatch with running bsb@."; + exit 2 + end + else + if Ext_sys.is_windows_or_cygwin then + begin + let npm_link = "npm link bs-platform" in + let exit_code = Sys.command npm_link in + if exit_code <> 0 then + begin + prerr_endline ("failed to run : " ^ npm_link); + exit exit_code + end + end + else + begin + (* symlink bs-platform and bsb,bsc,bsrefmt to .bin directory + we did not run npm link bs-platform for efficiency reasons + *) + Format.fprintf Format.std_formatter "Symlink bs-platform in %s @." (cwd//dirname); + let (//) = Filename.concat in + let node_bin = "node_modules" // ".bin" in + Bsb_build_util.mkp node_bin; + let p = ".." // Bs_version.package_name // "lib" in + let link a = + Unix.symlink (p//a) (node_bin // a) in + link "bsb" ; + link "bsc" ; + link "bsrefmt"; + Unix.symlink + (Filename.dirname (Filename.dirname Sys.executable_name)) + (Filename.concat "node_modules" Bs_version.package_name) + end + +let enter_dir cwd x action = + Unix.chdir x ; + match action () with + | exception e -> Unix.chdir cwd ; raise e + | v -> v + +let mkdir_or_not_if_exists dir = + match classify_file dir with + | Directory -> () + | Non_directory_file + -> + Format.fprintf Format.err_formatter + "%s expected to be added as dir but exist file is not a dir" dir + | Non_exists -> Unix.mkdir dir 0o777 + +let rec process_theme_aux env cwd (x : OCamlRes.Res.node) = + match x with + | File (name,content) -> + let new_file = cwd // name in + if not @@ Sys.file_exists new_file then + Ext_io.write_file new_file (replace content env) + | Dir (current, nodes) -> + let new_cwd = cwd // current in + mkdir_or_not_if_exists new_cwd; + List.iter (fun x -> process_theme_aux env new_cwd x ) nodes + +let list_themes () = + Format.fprintf Format.std_formatter "Available themes: @."; + Bsb_templates.root + |> + List.iter (fun (x : OCamlRes.Res.node) -> + match x with + | Dir (x, _) -> + Format.fprintf Format.std_formatter "%s@." x + + | _ -> () + ) + +(* @raise [Not_found] *) +let process_themes env theme proj_dir (themes : OCamlRes.Res.node list ) = + match Ext_list.find_first themes (fun x -> + match x with + | Dir (dir, _) -> dir = theme + | File _ -> false + ) with + | None -> + list_themes (); + raise (Arg.Bad( "theme " ^ theme ^ " not found") ) + | Some (Dir(_theme, nodes )) -> + List.iter (fun node -> process_theme_aux env proj_dir node ) nodes + | Some _ -> assert false + +(** TODO: run npm link *) +let init_sample_project ~cwd ~theme name = + let env = String_hashtbl.create 0 in + List.iter (fun (k,v) -> String_hashtbl.add env k v ) [ + "proj-version", "0.1.0"; + "bs-version", Bs_version.version; + "bsb" , Filename.current_dir_name // "node_modules" // ".bin" // "bsb" + ]; + let action = fun _ -> + process_themes env theme Filename.current_dir_name Bsb_templates.root; + run_npm_link cwd name + in + begin match name with + | "." -> + let name = Filename.basename cwd in + if Ext_namespace.is_valid_npm_package_name name then + begin + String_hashtbl.add env "name" name; + action () + end + else + begin + Format.fprintf Format.err_formatter + "@{Invalid package name@} %S.@} The project name must be a valid npm name, thus can't contain upper-case letters, for example." + name ; + exit 2 + end + + | _ -> + if Ext_namespace.is_valid_npm_package_name name + then begin + match classify_file name with + | Non_directory_file + -> + begin + Format.fprintf Format.err_formatter "@{%s already exists but it is not a directory@}@." name ; + exit 2 + end + | Directory -> + begin + Format.fprintf Format.std_formatter "Adding files into existing dir %s@." name; + String_hashtbl.add env "name" name; + enter_dir cwd name action + end + | Non_exists + -> + begin + Format.fprintf Format.std_formatter "Making directory %s@." name; + Unix.mkdir name 0o777; + String_hashtbl.add env "name" name; + enter_dir cwd name action + end + end else begin + Format.fprintf Format.err_formatter + "@{Invalid package name@} %S.@} The project name must be a valid npm name, thus can't contain upper-case letters, for example." + name ; + exit 2 + end + end + + + + + +end +module Bsb_file : sig +#1 "bsb_file.mli" + + + +(** return [true] if copied *) +val install_if_exists : destdir:string -> string -> bool + + +end = struct +#1 "bsb_file.ml" + + +open Unix + +let set_infos filename infos = + Unix.utimes filename infos.st_atime infos.st_mtime; + Unix.chmod filename infos.st_perm + (** it is not necessary to call [chown] since it is within the same user + and {!Unix.chown} is not implemented under Windows + *) + (* + try + Unix.chown filename infos.st_uid infos.st_gid + with Unix_error(EPERM,_,_) -> () +*) + +let buffer_size = 8192;; +let buffer = Bytes.create buffer_size;; + +let file_copy input_name output_name = + let fd_in = openfile input_name [O_RDONLY] 0 in + let fd_out = openfile output_name [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in + let rec copy_loop () = + match read fd_in buffer 0 buffer_size with + | 0 -> () + | r -> ignore (write fd_out buffer 0 r); copy_loop () + in + copy_loop (); + close fd_in; + close fd_out;; + + +let copy_with_permission input_name output_name = + file_copy input_name output_name ; + set_infos output_name (Unix.lstat input_name) + +let install_if_exists ~destdir input_name = + if Sys.file_exists input_name then + let output_name = (Filename.concat destdir (Filename.basename input_name)) in + match Unix.stat output_name , Unix.stat input_name with + | {st_mtime = output_stamp}, {st_mtime = input_stamp} when input_stamp <= output_stamp + -> false + | _ -> copy_with_permission input_name output_name; true + | exception _ -> copy_with_permission input_name output_name; true + else false + +end +module Bsb_world : sig +#1 "bsb_world.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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 install_targets: + string -> + Bsb_config_types.t option -> + unit*) + +val make_world_deps: + string -> + Bsb_config_types.t option -> + unit +end = struct +#1 "bsb_world.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * 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 (//) = Ext_path.combine + +(** TODO: create the animation effect + logging installed files +*) +let install_targets cwd (config : Bsb_config_types.t option) = + + let install ~destdir file = + if Bsb_file.install_if_exists ~destdir file then + begin + () + + end + in + let install_filename_sans_extension destdir namespace x = + let x = + match namespace with + | None -> x + | Some ns -> Ext_namespace.make ~ns x in + install ~destdir (cwd // x ^ Literals.suffix_ml) ; + install ~destdir (cwd // x ^ Literals.suffix_re) ; + install ~destdir (cwd // x ^ Literals.suffix_mli) ; + install ~destdir (cwd // x ^ Literals.suffix_rei) ; + install ~destdir (cwd // Bsb_config.lib_bs//x ^ Literals.suffix_cmi) ; + install ~destdir (cwd // Bsb_config.lib_bs//x ^ Literals.suffix_cmj) ; + install ~destdir (cwd // Bsb_config.lib_bs//x ^ Literals.suffix_cmt) ; + install ~destdir (cwd // Bsb_config.lib_bs//x ^ Literals.suffix_cmti) ; + + in + match config with + | None -> () + | Some {files_to_install; namespace; package_name} -> + let destdir = cwd // Bsb_config.lib_ocaml in (* lib is already there after building, so just mkdir [lib/ocaml] *) + if not @@ Sys.file_exists destdir then begin Unix.mkdir destdir 0o777 end; + begin + Bsb_log.info "@{Installing started@}@."; + begin match namespace with + | None -> () + | Some x -> + install_filename_sans_extension destdir None x + end; + String_hash_set.iter files_to_install (install_filename_sans_extension destdir namespace) ; + Bsb_log.info "@{Installing finished@} @."; + end + + + +let build_bs_deps cwd deps = + + let bsc_dir = Bsb_build_util.get_bsc_dir ~cwd in + let vendor_ninja = bsc_dir // "ninja.exe" in + Bsb_build_util.walk_all_deps cwd + (fun {top; cwd} -> + if not top then + begin + let config_opt = Bsb_ninja_regen.regenerate_ninja ~not_dev:true + ~generate_watch_metadata:false + ~override_package_specs:(Some deps) + ~forced:true + cwd bsc_dir in (* set true to force regenrate ninja file so we have [config_opt]*) + let command = + {Bsb_unix.cmd = vendor_ninja; + cwd = cwd // Bsb_config.lib_bs; + args = [|vendor_ninja|] + } in + let eid = + Bsb_unix.run_command_execv + command in + if eid <> 0 then + Bsb_unix.command_fatal_error command eid; + (* When ninja is not regenerated, ninja will still do the build, + still need reinstall check + Note that we can check if ninja print "no work to do", + then don't need reinstall more + *) + install_targets cwd config_opt; + end + ) + + +let make_world_deps cwd (config : Bsb_config_types.t option) = + Bsb_log.info "Making the dependency world!@."; + let deps = + match config with + | None -> + (* When this running bsb does not read bsconfig.json, + we will read such json file to know which [package-specs] + it wants + *) + Bsb_config_parse.package_specs_from_bsconfig () + | Some {package_specs} -> package_specs in + build_bs_deps cwd deps +end +module Bsb_main : sig +#1 "bsb_main.mli" +(* *) + +end = struct +#1 "bsb_main.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 cwd = Sys.getcwd () +let bsc_dir = Bsb_build_util.get_bsc_dir ~cwd +let () = Bsb_log.setup () +let (//) = Ext_path.combine +let force_regenerate = ref false +let exec = ref false +let node_lit = "node" +let current_theme = ref "basic" +let set_theme s = current_theme := s +let generate_theme_with_path = ref None +let regen = "-regen" +let separator = "--" +let watch_mode = ref false +let make_world = ref false +let set_make_world () = make_world := true +let bs_version_string = Bs_version.version + +let print_version_string () = + print_string bs_version_string; + print_newline (); + exit 0 + +let bsb_main_flags : (string * Arg.spec * string) list= + [ + "-v", Arg.Unit print_version_string, + " Print version and exit"; + "-version", Arg.Unit print_version_string, + " Print version and exit"; + "-verbose", Arg.Unit Bsb_log.verbose, + " Set the output(from bsb) to be verbose"; + "-w", Arg.Set watch_mode, + " Watch mode" ; + "-clean-world", Arg.Unit (fun _ -> + Bsb_clean.clean_bs_deps bsc_dir cwd), + " Clean all bs dependencies"; + "-clean", Arg.Unit (fun _ -> + Bsb_clean.clean_self bsc_dir cwd), + " Clean only current project"; + "-make-world", Arg.Unit set_make_world, + " Build all dependencies and itself "; + "-init", Arg.String (fun path -> generate_theme_with_path := Some path), + " Init sample project to get started. Note (`bsb -init sample` will create a sample project while `bsb -init .` will reuse current directory)"; + "-theme", Arg.String set_theme, + " The theme for project initialization, default is basic(https://github.com/bucklescript/bucklescript/tree/master/jscomp/bsb/templates)"; + + regen, Arg.Set force_regenerate, + " (internal) Always regenerate build.ninja no matter bsconfig.json is changed or not (for debugging purpose)"; + "-query", Arg.String (fun s -> Bsb_query.query ~cwd ~bsc_dir s ), + " (internal)Query metadata about the build"; + "-themes", Arg.Unit Bsb_theme_init.list_themes, + " List all available themes"; + "-where", + Arg.Unit (fun _ -> + print_endline (Filename.dirname Sys.executable_name)), + " Show where bsb.exe is located" + ] + + +(*Note that [keepdepfile] only makes sense when combined with [deps] for optimization*) + +(** Invariant: it has to be the last command of [bsb] *) +let exec_command_then_exit command = + Bsb_log.info "@{CMD:@} %s@." command; + exit (Sys.command command ) + +(* Execute the underlying ninja build call, then exit (as opposed to keep watching) *) +let ninja_command_exit vendor_ninja ninja_args = + let ninja_args_len = Array.length ninja_args in + if Ext_sys.is_windows_or_cygwin then + let path_ninja = Filename.quote vendor_ninja in + exec_command_then_exit @@ + (if ninja_args_len = 0 then + Ext_string.inter3 + path_ninja "-C" Bsb_config.lib_bs + else + let args = + Array.append + [| path_ninja ; "-C"; Bsb_config.lib_bs|] + ninja_args in + Ext_string.concat_array Ext_string.single_space args) + else + let ninja_common_args = [|"ninja.exe"; "-C"; Bsb_config.lib_bs |] in + let args = + if ninja_args_len = 0 then ninja_common_args else + Array.append ninja_common_args ninja_args in + Bsb_log.info_args args ; + Unix.execvp vendor_ninja args + + + +(** + Cache files generated: + - .bsdircache in project root dir + - .bsdeps in builddir + + What will happen, some flags are really not good + ninja -C _build +*) +let usage = "Usage : bsb.exe -- \n\ + For ninja options, try ninja -h \n\ + ninja will be loaded either by just running `bsb.exe' or `bsb.exe .. -- ..`\n\ + It is always recommended to run ninja via bsb.exe \n\ + Bsb options are:" + +let handle_anonymous_arg arg = + raise (Arg.Bad ("Unknown arg \"" ^ arg ^ "\"")) + + +let watch_exit () = + exit 0 + +(* see discussion #929, if we catch the exception, we don't have stacktrace... *) +let () = + + let vendor_ninja = bsc_dir // "ninja.exe" in + try begin + match Sys.argv with + | [| _ |] -> (* specialize this path [bsb.exe] which is used in watcher *) + begin + let _config_opt = + Bsb_ninja_regen.regenerate_ninja ~override_package_specs:None ~not_dev:false + ~generate_watch_metadata:true + ~forced:false + cwd bsc_dir + in + ninja_command_exit vendor_ninja [||] + end + | argv -> + begin + match Ext_array.find_and_split argv Ext_string.equal separator with + | `No_split + -> + begin + Arg.parse bsb_main_flags handle_anonymous_arg usage; + (* first, check whether we're in boilerplate generation mode, aka -init foo -theme bar *) + match !generate_theme_with_path with + | Some path -> Bsb_theme_init.init_sample_project ~cwd ~theme:!current_theme path + | None -> + (* [-make-world] should never be combined with [-package-specs] *) + let make_world = !make_world in + begin match make_world, !force_regenerate with + | false, false -> + (* [regenerate_ninja] is not triggered in this case + There are several cases we wish ninja will not be triggered. + [bsb -clean-world] + [bsb -regen ] + *) + if !watch_mode then begin + watch_exit () + end + | make_world, force_regenerate -> + let config_opt = Bsb_ninja_regen.regenerate_ninja ~generate_watch_metadata:true ~override_package_specs:None ~not_dev:false ~forced:force_regenerate cwd bsc_dir in + if make_world then begin + Bsb_world.make_world_deps cwd config_opt + end; + if !watch_mode then begin + watch_exit () + (* ninja is not triggered in this case + There are several cases we wish ninja will not be triggered. + [bsb -clean-world] + [bsb -regen ] + *) + end else if make_world then begin + ninja_command_exit vendor_ninja [||] + end + end; + end + | `Split (bsb_args,ninja_args) + -> (* -make-world all dependencies fall into this category *) + begin + Arg.parse_argv bsb_args bsb_main_flags handle_anonymous_arg usage ; + let config_opt = Bsb_ninja_regen.regenerate_ninja ~generate_watch_metadata:true ~override_package_specs:None ~not_dev:false cwd bsc_dir ~forced:!force_regenerate in + (* [-make-world] should never be combined with [-package-specs] *) + if !make_world then + Bsb_world.make_world_deps cwd config_opt ; + if !watch_mode then watch_exit () + else ninja_command_exit vendor_ninja ninja_args + end + end + end + with + | Bsb_exception.Error e -> + Bsb_exception.print Format.err_formatter e ; + Format.pp_print_newline Format.err_formatter (); + exit 2 + | Ext_json_parse.Error (start,_,e) -> + Format.fprintf Format.err_formatter + "File %S, line %d\n\ + @{Error:@} %a@." + start.pos_fname start.pos_lnum + Ext_json_parse.report_error e ; + exit 2 + | Arg.Bad s + | Sys_error s -> + Format.fprintf Format.err_formatter + "@{Error:@} %s@." + s ; + exit 2 + | e -> Ext_pervasives.reraise e + +end diff --git a/lib/4.06.1/unstable/bsb_native.ml.d b/lib/4.06.1/unstable/bsb_native.ml.d new file mode 100644 index 0000000000..148dff5c20 --- /dev/null +++ b/lib/4.06.1/unstable/bsb_native.ml.d @@ -0,0 +1,135 @@ +../lib/4.06.1/unstable/bsb_native.ml: +./bsb/bsb_build_schemas.ml +./bsb/bsb_build_util.ml +./bsb/bsb_build_util.mli +./bsb/bsb_clean.ml +./bsb/bsb_clean.mli +./bsb/bsb_config.ml +./bsb/bsb_config.mli +./bsb/bsb_config_parse.ml +./bsb/bsb_config_parse.mli +./bsb/bsb_config_types.ml +./bsb/bsb_db.ml +./bsb/bsb_db.mli +./bsb/bsb_db_io.ml +./bsb/bsb_db_io.mli +./bsb/bsb_default.ml +./bsb/bsb_default.mli +./bsb/bsb_dir_index.ml +./bsb/bsb_dir_index.mli +./bsb/bsb_exception.ml +./bsb/bsb_exception.mli +./bsb/bsb_file.ml +./bsb/bsb_file.mli +./bsb/bsb_file_groups.ml +./bsb/bsb_log.ml +./bsb/bsb_log.mli +./bsb/bsb_merlin_gen.ml +./bsb/bsb_merlin_gen.mli +./bsb/bsb_namespace_map_gen.ml +./bsb/bsb_namespace_map_gen.mli +./bsb/bsb_ninja_check.ml +./bsb/bsb_ninja_check.mli +./bsb/bsb_ninja_file_groups.ml +./bsb/bsb_ninja_file_groups.mli +./bsb/bsb_ninja_gen.ml +./bsb/bsb_ninja_gen.mli +./bsb/bsb_ninja_global_vars.ml +./bsb/bsb_ninja_regen.ml +./bsb/bsb_ninja_regen.mli +./bsb/bsb_ninja_rule.ml +./bsb/bsb_ninja_rule.mli +./bsb/bsb_ninja_util.ml +./bsb/bsb_ninja_util.mli +./bsb/bsb_package_specs.ml +./bsb/bsb_package_specs.mli +./bsb/bsb_parse_sources.ml +./bsb/bsb_parse_sources.mli +./bsb/bsb_pkg.ml +./bsb/bsb_pkg.mli +./bsb/bsb_pkg_types.ml +./bsb/bsb_pkg_types.mli +./bsb/bsb_query.ml +./bsb/bsb_query.mli +./bsb/bsb_regex.ml +./bsb/bsb_regex.mli +./bsb/bsb_templates.ml +./bsb/bsb_templates.mli +./bsb/bsb_theme_init.ml +./bsb/bsb_theme_init.mli +./bsb/bsb_unix.ml +./bsb/bsb_unix.mli +./bsb/bsb_warning.ml +./bsb/bsb_warning.mli +./bsb/bsb_watcher_gen.ml +./bsb/bsb_watcher_gen.mli +./bsb/bsb_world.ml +./bsb/bsb_world.mli +./bsb/oCamlRes.ml +./common/bs_version.ml +./common/bs_version.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_color.ml +./ext/ext_color.mli +./ext/ext_file_pp.ml +./ext/ext_file_pp.mli +./ext/ext_filename.ml +./ext/ext_filename.mli +./ext/ext_io.ml +./ext/ext_io.mli +./ext/ext_json.ml +./ext/ext_json.mli +./ext/ext_json_noloc.ml +./ext/ext_json_noloc.mli +./ext/ext_json_parse.ml +./ext/ext_json_parse.mli +./ext/ext_json_types.ml +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_modulename.ml +./ext/ext_modulename.mli +./ext/ext_namespace.ml +./ext/ext_namespace.mli +./ext/ext_option.ml +./ext/ext_option.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_position.ml +./ext/ext_position.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hash_set_gen.ml +./ext/hashtbl_gen.ml +./ext/hashtbl_make.ml +./ext/hashtbl_make.mli +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/resize_array.ml +./ext/resize_array.mli +./ext/set_gen.ml +./ext/string_hash_set.ml +./ext/string_hash_set.mli +./ext/string_hashtbl.ml +./ext/string_hashtbl.mli +./ext/string_map.ml +./ext/string_map.mli +./ext/string_set.ml +./ext/string_set.mli +./ext/string_vec.ml +./ext/string_vec.mli +./ext/vec_gen.ml +./main/bsb_main.ml +./main/bsb_main.mli +./stubs/bs_hash_stubs.ml diff --git a/lib/4.06.1/unstable/bspack.ml b/lib/4.06.1/unstable/bspack.ml new file mode 100644 index 0000000000..d4a8eee8d1 --- /dev/null +++ b/lib/4.06.1/unstable/bspack.ml @@ -0,0 +1,31906 @@ +module Arg_helper : sig +#1 "arg_helper.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Decipher command line arguments of the form + | =[,...] + (as used for example for the specification of inlining parameters + varying by simplification round). +*) + +module Make (S : sig + module Key : sig + type t + + (** The textual representation of a key must not contain '=' or ','. *) + val of_string : string -> t + + module Map : Map.S with type key = t + end + + module Value : sig + type t + + (** The textual representation of a value must not contain ','. *) + val of_string : string -> t + end +end) : sig + type parsed + + val default : S.Value.t -> parsed + + val set_base_default : S.Value.t -> parsed -> parsed + + val add_base_override : S.Key.t -> S.Value.t -> parsed -> parsed + + val reset_base_overrides : parsed -> parsed + + val set_user_default : S.Value.t -> parsed -> parsed + + val add_user_override : S.Key.t -> S.Value.t -> parsed -> parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:S.Key.t -> parsed -> S.Value.t +end + +end = struct +#1 "arg_helper.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +let fatal err = + prerr_endline err; + exit 2 + +module Make (S : sig + module Key : sig + type t + val of_string : string -> t + module Map : Map.S with type key = t + end + + module Value : sig + type t + val of_string : string -> t + end +end) = struct + type parsed = { + base_default : S.Value.t; + base_override : S.Value.t S.Key.Map.t; + user_default : S.Value.t option; + user_override : S.Value.t S.Key.Map.t; + } + + let default v = + { base_default = v; + base_override = S.Key.Map.empty; + user_default = None; + user_override = S.Key.Map.empty; } + + let set_base_default value t = + { t with base_default = value } + + let add_base_override key value t = + { t with base_override = S.Key.Map.add key value t.base_override } + + let reset_base_overrides t = + { t with base_override = S.Key.Map.empty } + + let set_user_default value t = + { t with user_default = Some value } + + let add_user_override key value t = + { t with user_override = S.Key.Map.add key value t.user_override } + + exception Parse_failure of exn + + let parse_exn str ~update = + (* Is the removal of empty chunks really relevant here? *) + (* (It has been added to mimic the old Misc.String.split.) *) + let values = String.split_on_char ',' str |> List.filter ((<>) "") in + let parsed = + List.fold_left (fun acc value -> + match String.index value '=' with + | exception Not_found -> + begin match S.Value.of_string value with + | value -> set_user_default value acc + | exception exn -> raise (Parse_failure exn) + end + | equals -> + let key_value_pair = value in + let length = String.length key_value_pair in + assert (equals >= 0 && equals < length); + if equals = 0 then begin + raise (Parse_failure ( + Failure "Missing key in argument specification")) + end; + let key = + let key = String.sub key_value_pair 0 equals in + try S.Key.of_string key + with exn -> raise (Parse_failure exn) + in + let value = + let value = + String.sub key_value_pair (equals + 1) (length - equals - 1) + in + try S.Value.of_string value + with exn -> raise (Parse_failure exn) + in + add_user_override key value acc) + !update + values + in + update := parsed + + let parse str help_text update = + match parse_exn str ~update with + | () -> () + | exception (Parse_failure exn) -> + fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) + + type parse_result = + | Ok + | Parse_failed of exn + + let parse_no_error str update = + match parse_exn str ~update with + | () -> Ok + | exception (Parse_failure exn) -> Parse_failed exn + + let get ~key parsed = + match S.Key.Map.find key parsed.user_override with + | value -> value + | exception Not_found -> + match parsed.user_default with + | Some value -> value + | None -> + match S.Key.Map.find key parsed.base_override with + | value -> value + | exception Not_found -> parsed.base_default + +end + +end +module Config_whole_compiler : sig +#1 "config_whole_compiler.mli" + +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* System configuration *) + +val version: string + (* The current version number of the system *) + +val standard_library: string + (* The directory containing the standard libraries *) +val standard_runtime: string + (* The full path to the standard bytecode interpreter ocamlrun *) +val ccomp_type: string + (* The "kind" of the C compiler, assembler and linker used: one of + "cc" (for Unix-style C compilers) + "msvc" (for Microsoft Visual C++ and MASM) *) +val c_compiler: string + (* The compiler to use for compiling C files *) +val c_output_obj: string + (* Name of the option of the C compiler for specifying the output file *) +val ocamlc_cflags : string + (* The flags ocamlc should pass to the C compiler *) +val ocamlc_cppflags : string + (* The flags ocamlc should pass to the C preprocessor *) +val ocamlopt_cflags : string + (* The flags ocamlopt should pass to the C compiler *) +val ocamlopt_cppflags : string + (* The flags ocamlopt should pass to the C preprocessor *) +val bytecomp_c_libraries: string + (* The C libraries to link with custom runtimes *) +val native_c_libraries: string + (* The C libraries to link with native-code programs *) +val native_pack_linker: string + (* The linker to use for packaging (ocamlopt -pack) and for partial + links (ocamlopt -output-obj). *) +val mkdll: string + (* The linker command line to build dynamic libraries. *) +val mkexe: string + (* The linker command line to build executables. *) +val mkmaindll: string + (* The linker command line to build main programs as dlls. *) +val ranlib: string + (* Command to randomize a library, or "" if not needed *) +val ar: string + (* Name of the ar command, or "" if not needed (MSVC) *) +val cc_profile : string + (* The command line option to the C compiler to enable profiling. *) + +val load_path: string list ref + (* Directories in the search path for .cmi and .cmo files *) + +val interface_suffix: string ref + (* Suffix for interface file names *) + +val exec_magic_number: string + (* Magic number for bytecode executable files *) +val cmi_magic_number: string + (* Magic number for compiled interface files *) +val cmo_magic_number: string + (* Magic number for object bytecode files *) +val cma_magic_number: string + (* Magic number for archive files *) +val cmx_magic_number: string + (* Magic number for compilation unit descriptions *) +val cmxa_magic_number: string + (* Magic number for libraries of compilation unit descriptions *) +val ast_intf_magic_number: string + (* Magic number for file holding an interface syntax tree *) +val ast_impl_magic_number: string + (* Magic number for file holding an implementation syntax tree *) +val cmxs_magic_number: string + (* Magic number for dynamically-loadable plugins *) +val cmt_magic_number: string + (* Magic number for compiled interface files *) + +val max_tag: int + (* Biggest tag that can be stored in the header of a regular block. *) +val lazy_tag : int + (* Normally the same as Obj.lazy_tag. Separate definition because + of technical reasons for bootstrapping. *) +val max_young_wosize: int + (* Maximal size of arrays that are directly allocated in the + minor heap *) +val stack_threshold: int + (* Size in words of safe area at bottom of VM stack, + see byterun/config.h *) +val stack_safety_margin: int + (* Size in words of the safety margin between the bottom of + the stack and the stack pointer. This margin can be used by + intermediate computations of some instructions, or the event + handler. *) + +val architecture: string + (* Name of processor type for the native-code compiler *) +val model: string + (* Name of processor submodel for the native-code compiler *) +val system: string + (* Name of operating system for the native-code compiler *) + +val asm: string + (* The assembler (and flags) to use for assembling + ocamlopt-generated code. *) + +val asm_cfi_supported: bool + (* Whether assembler understands CFI directives *) +val with_frame_pointers : bool + (* Whether assembler should maintain frame pointers *) + +val ext_obj: string + (* Extension for object files, e.g. [.o] under Unix. *) +val ext_asm: string + (* Extension for assembler files, e.g. [.s] under Unix. *) +val ext_lib: string + (* Extension for library files, e.g. [.a] under Unix. *) +val ext_dll: string + (* Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*) + +val default_executable_name: string + (* Name of executable produced by linking if none is given with -o, + e.g. [a.out] under Unix. *) + +val systhread_supported : bool + (* Whether the system thread library is implemented *) + +val flexdll_dirs : string list + (* Directories needed for the FlexDLL objects *) + +val host : string + (* Whether the compiler is a cross-compiler *) + +val target : string + (* Whether the compiler is a cross-compiler *) + +val print_config : out_channel -> unit;; + +val profiling : bool + (* Whether profiling with gprof is supported on this platform *) + +val flambda : bool + (* Whether the compiler was configured for flambda *) + +val spacetime : bool + (* Whether the compiler was configured for Spacetime profiling *) +val enable_call_counts : bool + (* Whether call counts are to be available when Spacetime profiling *) +val profinfo : bool + (* Whether the compiler was configured for profiling *) +val profinfo_width : int + (* How many bits are to be used in values' headers for profiling + information *) +val libunwind_available : bool + (* Whether the libunwind library is available on the target *) +val libunwind_link_flags : string + (* Linker flags to use libunwind *) + +val safe_string: bool + (* Whether the compiler was configured with -force-safe-string; + in that case, the -unsafe-string compile-time option is unavailable + + @since 4.05.0 *) +val default_safe_string: bool + (* Whether the compiler was configured to use the -safe-string + or -unsafe-string compile-time option by default. + + @since 4.06.0 *) +val flat_float_array : bool + (* Whether the compiler and runtime automagically flatten float + arrays *) +val windows_unicode: bool + (* Whether Windows Unicode runtime is enabled *) +val afl_instrument : bool + (* Whether afl-fuzz instrumentation is generated by default *) + + +end = struct +#1 "config_whole_compiler.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* The main OCaml version string has moved to ../VERSION *) +let version = "4.06.1+BS" +let standard_library = + Filename.concat (Filename.dirname Sys.executable_name) "ocaml" +let standard_library_default = standard_library + +let standard_runtime = "ocamlrun" (*dont care:path to ocamlrun*) +let ccomp_type = "cc" +let c_compiler = "gcc" +let c_output_obj = "-o " +let ocamlc_cflags = "-O2 -fno-strict-aliasing -fwrapv " +let ocamlc_cppflags = "-D_FILE_OFFSET_BITS=64 -D_REENTRANT" +let ocamlopt_cflags = "-O2 -fno-strict-aliasing -fwrapv" +let ocamlopt_cppflags = "-D_FILE_OFFSET_BITS=64 -D_REENTRANT" +let bytecomp_c_libraries = "-lcurses -lpthread " +(* bytecomp_c_compiler and native_c_compiler have been supported for a + long time and are retained for backwards compatibility. + For programs that don't need compatibility with older OCaml releases + the recommended approach is to use the constituent variables + c_compiler, ocamlc_cflags, ocamlc_cppflags etc., directly. +*) +let bytecomp_c_compiler = + "" +let native_c_compiler = + "" +let native_c_libraries = "" +let native_pack_linker = "ld -r -arch x86_64 -o\ " +let ranlib = "ranlib" +let ar = "ar" +let cc_profile = "-pg" +let mkdll = "" +let mkexe = "" +let mkmaindll = "" + +let profiling = true +let flambda = false +let safe_string = false +let default_safe_string = true +let windows_unicode = 0 != 0 + +let flat_float_array = true + +let afl_instrument = false + +let exec_magic_number = "Caml1999X011" +and cmi_magic_number = "Caml1999I022" +and cmo_magic_number = "Caml1999O022" +and cma_magic_number = "Caml1999A022" +and cmx_magic_number = + (* if flambda then + "Caml1999y022" + else *) + "Caml1999Y022" +and cmxa_magic_number = + (* if flambda then + "Caml1999z022" + else *) + "Caml1999Z022" +and ast_impl_magic_number = "Caml1999M022" +and ast_intf_magic_number = "Caml1999N022" +and cmxs_magic_number = "Caml1999D022" + (* cmxs_magic_number is duplicated in otherlibs/dynlink/natdynlink.ml *) +and cmt_magic_number = "Caml1999T022" + +let load_path = ref ([] : string list) + +let interface_suffix = ref ".mli" + +let max_tag = 245 +(* This is normally the same as in obj.ml, but we have to define it + separately because it can differ when we're in the middle of a + bootstrapping phase. *) +let lazy_tag = 246 + +let max_young_wosize = 256 +let stack_threshold = 256 (* see byterun/config.h *) +let stack_safety_margin = 60 + +let architecture = "amd64" +let model = "default" +let system = "macosx" + +let asm = "clang -arch x86_64 -Wno-trigraphs -c" +let asm_cfi_supported = true +let with_frame_pointers = false +let spacetime = false +let enable_call_counts = true +let libunwind_available = false +let libunwind_link_flags = "" +let profinfo = false +let profinfo_width = 0 + +let ext_exe = "" +let ext_obj = ".o" +let ext_asm = ".s" +let ext_lib = ".a" +let ext_dll = ".so" + +let host = "x86_64-apple-darwin17.7.0" +let target = "x86_64-apple-darwin17.7.0" + +let default_executable_name = + "" + +let systhread_supported = false;; + +let flexdll_dirs = [];; + +let print_config oc = + let p name valu = Printf.fprintf oc "%s: %s\n" name valu in + let p_int name valu = Printf.fprintf oc "%s: %d\n" name valu in + let p_bool name valu = Printf.fprintf oc "%s: %B\n" name valu in + p "version" version; + p "standard_library_default" standard_library_default; + p "standard_library" standard_library; + p "standard_runtime" standard_runtime; + p "ccomp_type" ccomp_type; + p "c_compiler" c_compiler; + p "ocamlc_cflags" ocamlc_cflags; + p "ocamlc_cppflags" ocamlc_cppflags; + p "ocamlopt_cflags" ocamlopt_cflags; + p "ocamlopt_cppflags" ocamlopt_cppflags; + p "bytecomp_c_compiler" bytecomp_c_compiler; + p "native_c_compiler" native_c_compiler; + p "bytecomp_c_libraries" bytecomp_c_libraries; + p "native_c_libraries" native_c_libraries; + p "native_pack_linker" native_pack_linker; + p "ranlib" ranlib; + p "cc_profile" cc_profile; + p "architecture" architecture; + p "model" model; + p_int "int_size" Sys.int_size; + p_int "word_size" Sys.word_size; + p "system" system; + p "asm" asm; + p_bool "asm_cfi_supported" asm_cfi_supported; + p_bool "with_frame_pointers" with_frame_pointers; + p "ext_exe" ext_exe; + p "ext_obj" ext_obj; + p "ext_asm" ext_asm; + p "ext_lib" ext_lib; + p "ext_dll" ext_dll; + p "os_type" Sys.os_type; + p "default_executable_name" default_executable_name; + p_bool "systhread_supported" systhread_supported; + p "host" host; + p "target" target; + p_bool "profiling" profiling; + p_bool "flambda" flambda; + p_bool "spacetime" spacetime; + p_bool "safe_string" safe_string; + p_bool "default_safe_string" default_safe_string; + p_bool "flat_float_array" flat_float_array; + p_bool "afl_instrument" afl_instrument; + p_bool "windows_unicode" windows_unicode; + + (* print the magic number *) + p "exec_magic_number" exec_magic_number; + p "cmi_magic_number" cmi_magic_number; + p "cmo_magic_number" cmo_magic_number; + p "cma_magic_number" cma_magic_number; + p "cmx_magic_number" cmx_magic_number; + p "cmxa_magic_number" cmxa_magic_number; + p "ast_impl_magic_number" ast_impl_magic_number; + p "ast_intf_magic_number" ast_intf_magic_number; + p "cmxs_magic_number" cmxs_magic_number; + p "cmt_magic_number" cmt_magic_number; + + flush oc; +;; + + +end +module Config = Config_whole_compiler +module Misc : sig +#1 "misc.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Miscellaneous useful types and functions *) + +val fatal_error: string -> 'a +val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a +exception Fatal_error + +val try_finally : (unit -> 'a) -> (unit -> unit) -> 'a;; + +val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list + (* [map_end f l t] is [map f l @ t], just more efficient. *) +val map_left_right: ('a -> 'b) -> 'a list -> 'b list + (* Like [List.map], with guaranteed left-to-right evaluation order *) +val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool + (* Same as [List.for_all] but for a binary predicate. + In addition, this [for_all2] never fails: given two lists + with different lengths, it returns false. *) +val replicate_list: 'a -> int -> 'a list + (* [replicate_list elem n] is the list with [n] elements + all identical to [elem]. *) +val list_remove: 'a -> 'a list -> 'a list + (* [list_remove x l] returns a copy of [l] with the first + element equal to [x] removed. *) +val split_last: 'a list -> 'a list * 'a + (* Return the last element and the other elements of the given list. *) +val may: ('a -> unit) -> 'a option -> unit +val may_map: ('a -> 'b) -> 'a option -> 'b option + +type ref_and_value = R : 'a ref * 'a -> ref_and_value + +val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a +(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l] + while executing [f]. The previous contents of the references is restored + even if [f] raises an exception. *) + +module Stdlib : sig + module List : sig + type 'a t = 'a list + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + (** The lexicographic order supported by the provided order. + There is no constraint on the relative lengths of the lists. *) + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + (** Returns [true] iff the given lists have the same length and content + with respect to the given equality function. *) + + val filter_map : ('a -> 'b option) -> 'a t -> 'b t + (** [filter_map f l] applies [f] to every element of [l], filters + out the [None] elements and returns the list of the arguments of + the [Some] elements. *) + + val some_if_all_elements_are_some : 'a option t -> 'a t option + (** If all elements of the given list are [Some _] then [Some xs] + is returned with the [xs] being the contents of those [Some]s, with + order preserved. Otherwise return [None]. *) + + val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t) + (** [let r1, r2 = map2_prefix f l1 l2] + If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n, + r1 is [List.map2 f l1 h1] and r2 is t2. *) + + val split_at : int -> 'a t -> 'a t * 'a t + (** [split_at n l] returns the pair [before, after] where [before] is + the [n] first elements of [l] and [after] the remaining ones. + If [l] has less than [n] elements, raises Invalid_argument. *) + end + + module Option : sig + type 'a t = 'a option + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val iter : ('a -> unit) -> 'a t -> unit + val map : ('a -> 'b) -> 'a t -> 'b t + val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b + end + + module Array : sig + val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + (* Same as [Array.exists], but for a two-argument predicate. Raise + Invalid_argument if the two arrays are determined to have + different lengths. *) + end +end + +val find_in_path: string list -> string -> string + (* Search a file in a list of directories. *) +val find_in_path_rel: string list -> string -> string + (* Search a relative file in a list of directories. *) +val find_in_path_uncap: string list -> string -> string + (* Same, but search also for uncapitalized name, i.e. + if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml + to match. *) +val remove_file: string -> unit + (* Delete the given file if it exists. Never raise an error. *) +val expand_directory: string -> string -> string + (* [expand_directory alt file] eventually expands a [+] at the + beginning of file into [alt] (an alternate root directory) *) + +val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t + (* Create a hashtable of the given size and fills it with the + given bindings. *) + +val copy_file: in_channel -> out_channel -> unit + (* [copy_file ic oc] reads the contents of file [ic] and copies + them to [oc]. It stops when encountering EOF on [ic]. *) +val copy_file_chunk: in_channel -> out_channel -> int -> unit + (* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies + them to [oc]. It raises [End_of_file] when encountering + EOF on [ic]. *) +val string_of_file: in_channel -> string + (* [string_of_file ic] reads the contents of file [ic] and copies + them to a string. It stops when encountering EOF on [ic]. *) +val output_to_file_via_temporary: + ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a + (* Produce output in temporary file, then rename it + (as atomically as possible) to the desired output file name. + [output_to_file_via_temporary filename fn] opens a temporary file + which is passed to [fn] (name + output channel). When [fn] returns, + the channel is closed and the temporary file is renamed to + [filename]. *) + +val log2: int -> int + (* [log2 n] returns [s] such that [n = 1 lsl s] + if [n] is a power of 2*) +val align: int -> int -> int + (* [align n a] rounds [n] upwards to a multiple of [a] + (a power of 2). *) +val no_overflow_add: int -> int -> bool + (* [no_overflow_add n1 n2] returns [true] if the computation of + [n1 + n2] does not overflow. *) +val no_overflow_sub: int -> int -> bool + (* [no_overflow_sub n1 n2] returns [true] if the computation of + [n1 - n2] does not overflow. *) +val no_overflow_mul: int -> int -> bool + (* [no_overflow_mul n1 n2] returns [true] if the computation of + [n1 * n2] does not overflow. *) +val no_overflow_lsl: int -> int -> bool + (* [no_overflow_lsl n k] returns [true] if the computation of + [n lsl k] does not overflow. *) + +module Int_literal_converter : sig + val int : string -> int + val int32 : string -> int32 + val int64 : string -> int64 + val nativeint : string -> nativeint +end + +val chop_extensions: string -> string + (* Return the given file name without its extensions. The extensions + is the longest suffix starting with a period and not including + a directory separator, [.xyz.uvw] for instance. + + Return the given name if it does not contain an extension. *) + +val search_substring: string -> string -> int -> int + (* [search_substring pat str start] returns the position of the first + occurrence of string [pat] in string [str]. Search starts + at offset [start] in [str]. Raise [Not_found] if [pat] + does not occur. *) + +val replace_substring: before:string -> after:string -> string -> string + (* [replace_substring ~before ~after str] replaces all + occurrences of [before] with [after] in [str] and returns + the resulting string. *) + +val rev_split_words: string -> string list + (* [rev_split_words s] splits [s] in blank-separated words, and returns + the list of words in reverse order. *) + +val get_ref: 'a list ref -> 'a list + (* [get_ref lr] returns the content of the list reference [lr] and reset + its content to the empty list. *) + + +val fst3: 'a * 'b * 'c -> 'a +val snd3: 'a * 'b * 'c -> 'b +val thd3: 'a * 'b * 'c -> 'c + +val fst4: 'a * 'b * 'c * 'd -> 'a +val snd4: 'a * 'b * 'c * 'd -> 'b +val thd4: 'a * 'b * 'c * 'd -> 'c +val for4: 'a * 'b * 'c * 'd -> 'd + +module LongString : + sig + type t = bytes array + val create : int -> t + val length : t -> int + val get : t -> int -> char + val set : t -> int -> char -> unit + val blit : t -> int -> t -> int -> int -> unit + val output : out_channel -> t -> int -> int -> unit + val unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit + val input_bytes : in_channel -> int -> t + end + +val edit_distance : string -> string -> int -> int option +(** [edit_distance a b cutoff] computes the edit distance between + strings [a] and [b]. To help efficiency, it uses a cutoff: if the + distance [d] is smaller than [cutoff], it returns [Some d], else + [None]. + + The distance algorithm currently used is Damerau-Levenshtein: it + computes the number of insertion, deletion, substitution of + letters, or swapping of adjacent letters to go from one word to the + other. The particular algorithm may change in the future. +*) + +val spellcheck : string list -> string -> string list +(** [spellcheck env name] takes a list of names [env] that exist in + the current environment and an erroneous [name], and returns a + list of suggestions taken from [env], that are close enough to + [name] that it may be a typo for one of them. *) + +val did_you_mean : Format.formatter -> (unit -> string list) -> unit +(** [did_you_mean ppf get_choices] hints that the user may have meant + one of the option returned by calling [get_choices]. It does nothing + if the returned list is empty. + + The [unit -> ...] thunking is meant to delay any potentially-slow + computation (typically computing edit-distance with many things + from the current environment) to when the hint message is to be + printed. You should print an understandable error message before + calling [did_you_mean], so that users get a clear notification of + the failure even if producing the hint is slow. +*) + +val cut_at : string -> char -> string * string +(** [String.cut_at s c] returns a pair containing the sub-string before + the first occurrence of [c] in [s], and the sub-string after the + first occurrence of [c] in [s]. + [let (before, after) = String.cut_at s c in + before ^ String.make 1 c ^ after] is the identity if [s] contains [c]. + + Raise [Not_found] if the character does not appear in the string + @since 4.01 +*) + + +module StringSet: Set.S with type elt = string +module StringMap: Map.S with type key = string +(* TODO: replace all custom instantiations of StringSet/StringMap in various + compiler modules with this one. *) + +(* Color handling *) +module Color : sig + type color = + | Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + ;; + + type style = + | FG of color (* foreground *) + | BG of color (* background *) + | Bold + | Reset + + | Dim + + + val ansi_of_style_l : style list -> string + (* ANSI escape sequence for the given style *) + + type styles = { + error: style list; + warning: style list; + loc: style list; + } + + val default_styles: styles + val get_styles: unit -> styles + val set_styles: styles -> unit + + type setting = Auto | Always | Never + + val setup : setting option -> unit + (* [setup opt] will enable or disable color handling on standard formatters + according to the value of color setting [opt]. + Only the first call to this function has an effect. *) + + val set_color_tag_handling : Format.formatter -> unit + (* adds functions to support color tags to the given formatter. *) +end + +val normalise_eol : string -> string +(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters + removed. Intended for pre-processing text which will subsequently be printed + on a channel which performs EOL transformations (i.e. Windows) *) + +val delete_eol_spaces : string -> string +(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of + line spaces removed. Intended to normalize the output of the + toplevel for tests. *) + + + +(** {1 Hook machinery} + + Hooks machinery: + [add_hook name f] will register a function that will be called on the + argument of a later call to [apply_hooks]. Hooks are applied in the + lexicographical order of their names. +*) + +type hook_info = { + sourcefile : string; +} + +exception HookExnWrapper of + { + error: exn; + hook_name: string; + hook_info: hook_info; + } + (** An exception raised by a hook will be wrapped into a + [HookExnWrapper] constructor by the hook machinery. *) + + +val raise_direct_hook_exn: exn -> 'a + (** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will + not be wrapped into a {!HookExnWrapper}. *) + +module type HookSig = sig + type t + val add_hook : string -> (hook_info -> t -> t) -> unit + val apply_hooks : hook_info -> t -> t +end + +module MakeHooks : functor (M : sig type t end) -> HookSig with type t = M.t + +end = struct +#1 "misc.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Errors *) + +exception Fatal_error + +let fatal_error msg = + prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error + +let fatal_errorf fmt = Format.kasprintf fatal_error fmt + +(* Exceptions *) + +let try_finally work cleanup = + let result = (try work () with e -> cleanup (); raise e) in + cleanup (); + result +;; + +type ref_and_value = R : 'a ref * 'a -> ref_and_value + +let protect_refs = + let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in + fun refs f -> + let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in + set_refs refs; + match f () with + | x -> set_refs backup; x + | exception e -> set_refs backup; raise e + +(* List functions *) + +let rec map_end f l1 l2 = + match l1 with + [] -> l2 + | hd::tl -> f hd :: map_end f tl l2 + +let rec map_left_right f = function + [] -> [] + | hd::tl -> let res = f hd in res :: map_left_right f tl + +let rec for_all2 pred l1 l2 = + match (l1, l2) with + ([], []) -> true + | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2 + | (_, _) -> false + +let rec replicate_list elem n = + if n <= 0 then [] else elem :: replicate_list elem (n-1) + +let rec list_remove x = function + [] -> [] + | hd :: tl -> + if hd = x then tl else hd :: list_remove x tl + +let rec split_last = function + [] -> assert false + | [x] -> ([], x) + | hd :: tl -> + let (lst, last) = split_last tl in + (hd :: lst, last) + +module Stdlib = struct + module List = struct + type 'a t = 'a list + + let rec compare cmp l1 l2 = + match l1, l2 with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | h1::t1, h2::t2 -> + let c = cmp h1 h2 in + if c <> 0 then c + else compare cmp t1 t2 + + let rec equal eq l1 l2 = + match l1, l2 with + | ([], []) -> true + | (hd1 :: tl1, hd2 :: tl2) -> eq hd1 hd2 && equal eq tl1 tl2 + | (_, _) -> false + + let filter_map f l = + let rec aux acc l = + match l with + | [] -> List.rev acc + | h :: t -> + match f h with + | None -> aux acc t + | Some v -> aux (v :: acc) t + in + aux [] l + + let map2_prefix f l1 l2 = + let rec aux acc l1 l2 = + match l1, l2 with + | [], _ -> (List.rev acc, l2) + | _ :: _, [] -> raise (Invalid_argument "map2_prefix") + | h1::t1, h2::t2 -> + let h = f h1 h2 in + aux (h :: acc) t1 t2 + in + aux [] l1 l2 + + let some_if_all_elements_are_some l = + let rec aux acc l = + match l with + | [] -> Some (List.rev acc) + | None :: _ -> None + | Some h :: t -> aux (h :: acc) t + in + aux [] l + + let split_at n l = + let rec aux n acc l = + if n = 0 + then List.rev acc, l + else + match l with + | [] -> raise (Invalid_argument "split_at") + | t::q -> aux (n-1) (t::acc) q + in + aux n [] l + end + + module Option = struct + type 'a t = 'a option + + let equal eq o1 o2 = + match o1, o2 with + | None, None -> true + | Some e1, Some e2 -> eq e1 e2 + | _, _ -> false + + let iter f = function + | Some x -> f x + | None -> () + + let map f = function + | Some x -> Some (f x) + | None -> None + + let fold f a b = + match a with + | None -> b + | Some a -> f a b + + let value_default f ~default a = + match a with + | None -> default + | Some a -> f a + end + + module Array = struct + let exists2 p a1 a2 = + let n = Array.length a1 in + if Array.length a2 <> n then invalid_arg "Misc.Stdlib.Array.exists2"; + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a1 i) (Array.unsafe_get a2 i) then true + else loop (succ i) in + loop 0 + end +end + +let may = Stdlib.Option.iter +let may_map = Stdlib.Option.map + +(* File functions *) + +let find_in_path path name = + if not (Filename.is_implicit name) then + if Sys.file_exists name then name else raise Not_found + else begin + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = Filename.concat dir name in + if Sys.file_exists fullname then fullname else try_dir rem + in try_dir path + end + +let find_in_path_rel path name = + let rec simplify s = + let open Filename in + let base = basename s in + let dir = dirname s in + if dir = s then dir + else if base = current_dir_name then simplify dir + else concat (simplify dir) base + in + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = simplify (Filename.concat dir name) in + if Sys.file_exists fullname then fullname else try_dir rem + in try_dir path + +let find_in_path_uncap path name = + let uname = String.uncapitalize_ascii name in + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = Filename.concat dir name + and ufullname = Filename.concat dir uname in + if Sys.file_exists ufullname then ufullname + else if Sys.file_exists fullname then fullname + else try_dir rem + in try_dir path + +let remove_file filename = + try + if Sys.file_exists filename + then Sys.remove filename + with Sys_error _msg -> + () + +(* Expand a -I option: if it starts with +, make it relative to the standard + library directory *) + +let expand_directory alt s = + if String.length s > 0 && s.[0] = '+' + then Filename.concat alt + (String.sub s 1 (String.length s - 1)) + else s + +(* Hashtable functions *) + +let create_hashtable size init = + let tbl = Hashtbl.create size in + List.iter (fun (key, data) -> Hashtbl.add tbl key data) init; + tbl + +(* File copy *) + +let copy_file ic oc = + let buff = Bytes.create 0x1000 in + let rec copy () = + let n = input ic buff 0 0x1000 in + if n = 0 then () else (output oc buff 0 n; copy()) + in copy() + +let copy_file_chunk ic oc len = + let buff = Bytes.create 0x1000 in + let rec copy n = + if n <= 0 then () else begin + let r = input ic buff 0 (min n 0x1000) in + if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r)) + end + in copy len + +let string_of_file ic = + let b = Buffer.create 0x10000 in + let buff = Bytes.create 0x1000 in + let rec copy () = + let n = input ic buff 0 0x1000 in + if n = 0 then Buffer.contents b else + (Buffer.add_subbytes b buff 0 n; copy()) + in copy() + +let output_to_file_via_temporary ?(mode = [Open_text]) filename fn = + let (temp_filename, oc) = + Filename.open_temp_file + ~mode ~perms:0o666 ~temp_dir:(Filename.dirname filename) + (Filename.basename filename) ".tmp" in + (* The 0o666 permissions will be modified by the umask. It's just + like what [open_out] and [open_out_bin] do. + With temp_dir = dirname filename, we ensure that the returned + temp file is in the same directory as filename itself, making + it safe to rename temp_filename to filename later. + With prefix = basename filename, we are almost certain that + the first generated name will be unique. A fixed prefix + would work too but might generate more collisions if many + files are being produced simultaneously in the same directory. *) + match fn temp_filename oc with + | res -> + close_out oc; + begin try + Sys.rename temp_filename filename; res + with exn -> + remove_file temp_filename; raise exn + end + | exception exn -> + close_out oc; remove_file temp_filename; raise exn + +(* Integer operations *) + +let rec log2 n = + if n <= 1 then 0 else 1 + log2(n asr 1) + +let align n a = + if n >= 0 then (n + a - 1) land (-a) else n land (-a) + +let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0 + +let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0 + +let no_overflow_mul a b = b <> 0 && (a * b) / b = a + +let no_overflow_lsl a k = + 0 <= k && k < Sys.word_size && min_int asr k <= a && a <= max_int asr k + +module Int_literal_converter = struct + (* To convert integer literals, allowing max_int + 1 (PR#4210) *) + let cvt_int_aux str neg of_string = + if String.length str = 0 || str.[0]= '-' + then of_string str + else neg (of_string ("-" ^ str)) + let int s = cvt_int_aux s (~-) int_of_string + let int32 s = cvt_int_aux s Int32.neg Int32.of_string + let int64 s = cvt_int_aux s Int64.neg Int64.of_string + let nativeint s = cvt_int_aux s Nativeint.neg Nativeint.of_string +end + +(* String operations *) + +let chop_extensions file = + let dirname = Filename.dirname file and basename = Filename.basename file in + try + let pos = String.index basename '.' in + let basename = String.sub basename 0 pos in + if Filename.is_implicit file && dirname = Filename.current_dir_name then + basename + else + Filename.concat dirname basename + with Not_found -> file + +let search_substring pat str start = + let rec search i j = + if j >= String.length pat then i + else if i + j >= String.length str then raise Not_found + else if str.[i + j] = pat.[j] then search i (j+1) + else search (i+1) 0 + in search start 0 + +let replace_substring ~before ~after str = + let rec search acc curr = + match search_substring before str curr with + | next -> + let prefix = String.sub str curr (next - curr) in + search (prefix :: acc) (next + String.length before) + | exception Not_found -> + let suffix = String.sub str curr (String.length str - curr) in + List.rev (suffix :: acc) + in String.concat after (search [] 0) + +let rev_split_words s = + let rec split1 res i = + if i >= String.length s then res else begin + match s.[i] with + ' ' | '\t' | '\r' | '\n' -> split1 res (i+1) + | _ -> split2 res i (i+1) + end + and split2 res i j = + if j >= String.length s then String.sub s i (j-i) :: res else begin + match s.[j] with + ' ' | '\t' | '\r' | '\n' -> split1 (String.sub s i (j-i) :: res) (j+1) + | _ -> split2 res i (j+1) + end + in split1 [] 0 + +let get_ref r = + let v = !r in + r := []; v + +let fst3 (x, _, _) = x +let snd3 (_,x,_) = x +let thd3 (_,_,x) = x + +let fst4 (x, _, _, _) = x +let snd4 (_,x,_, _) = x +let thd4 (_,_,x,_) = x +let for4 (_,_,_,x) = x + + +module LongString = struct + type t = bytes array + + let create str_size = + let tbl_size = str_size / Sys.max_string_length + 1 in + let tbl = Array.make tbl_size Bytes.empty in + for i = 0 to tbl_size - 2 do + tbl.(i) <- Bytes.create Sys.max_string_length; + done; + tbl.(tbl_size - 1) <- Bytes.create (str_size mod Sys.max_string_length); + tbl + + let length tbl = + let tbl_size = Array.length tbl in + Sys.max_string_length * (tbl_size - 1) + Bytes.length tbl.(tbl_size - 1) + + let get tbl ind = + Bytes.get tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) + + let set tbl ind c = + Bytes.set tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) + c + + let blit src srcoff dst dstoff len = + for i = 0 to len - 1 do + set dst (dstoff + i) (get src (srcoff + i)) + done + + let output oc tbl pos len = + for i = pos to pos + len - 1 do + output_char oc (get tbl i) + done + + let unsafe_blit_to_bytes src srcoff dst dstoff len = + for i = 0 to len - 1 do + Bytes.unsafe_set dst (dstoff + i) (get src (srcoff + i)) + done + + let input_bytes ic len = + let tbl = create len in + Array.iter (fun str -> really_input ic str 0 (Bytes.length str)) tbl; + tbl +end + + +let edit_distance a b cutoff = + let la, lb = String.length a, String.length b in + let cutoff = + (* using max_int for cutoff would cause overflows in (i + cutoff + 1); + we bring it back to the (max la lb) worstcase *) + min (max la lb) cutoff in + if abs (la - lb) > cutoff then None + else begin + (* initialize with 'cutoff + 1' so that not-yet-written-to cases have + the worst possible cost; this is useful when computing the cost of + a case just at the boundary of the cutoff diagonal. *) + let m = Array.make_matrix (la + 1) (lb + 1) (cutoff + 1) in + m.(0).(0) <- 0; + for i = 1 to la do + m.(i).(0) <- i; + done; + for j = 1 to lb do + m.(0).(j) <- j; + done; + for i = 1 to la do + for j = max 1 (i - cutoff - 1) to min lb (i + cutoff + 1) do + let cost = if a.[i-1] = b.[j-1] then 0 else 1 in + let best = + (* insert, delete or substitute *) + min (1 + min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost) + in + let best = + (* swap two adjacent letters; we use "cost" again in case of + a swap between two identical letters; this is slightly + redundant as this is a double-substitution case, but it + was done this way in most online implementations and + imitation has its virtues *) + if not (i > 1 && j > 1 && a.[i-1] = b.[j-2] && a.[i-2] = b.[j-1]) + then best + else min best (m.(i-2).(j-2) + cost) + in + m.(i).(j) <- best + done; + done; + let result = m.(la).(lb) in + if result > cutoff + then None + else Some result + end + +let spellcheck env name = + let cutoff = + match String.length name with + | 1 | 2 -> 0 + | 3 | 4 -> 1 + | 5 | 6 -> 2 + | _ -> 3 + in + let compare target acc head = + match edit_distance target head cutoff with + | None -> acc + | Some dist -> + let (best_choice, best_dist) = acc in + if dist < best_dist then ([head], dist) + else if dist = best_dist then (head :: best_choice, dist) + else acc + in + fst (List.fold_left (compare name) ([], max_int) env) + +let did_you_mean ppf get_choices = + (* flush now to get the error report early, in the (unheard of) case + where the search in the get_choices function would take a bit of + time; in the worst case, the user has seen the error, she can + interrupt the process before the spell-checking terminates. *) + Format.fprintf ppf "@?"; + match get_choices () with + | [] -> () + | choices -> + let rest, last = split_last choices in + Format.fprintf ppf "@\nHint: Did you mean %s%s%s?@?" + (String.concat ", " rest) + (if rest = [] then "" else " or ") + last + +let cut_at s c = + let pos = String.index s c in + String.sub s 0 pos, String.sub s (pos+1) (String.length s - pos - 1) + + +module StringSet = Set.Make(struct type t = string let compare = compare end) +module StringMap = Map.Make(struct type t = string let compare = compare end) + +(* Color handling *) +module Color = struct + (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *) + type color = + | Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + ;; + + type style = + | FG of color (* foreground *) + | BG of color (* background *) + | Bold + | Reset + + | Dim + + + let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" + + let code_of_style = function + | FG c -> "3" ^ ansi_of_color c + | BG c -> "4" ^ ansi_of_color c + | Bold -> "1" + | Reset -> "0" + + | Dim -> "2" + + + let ansi_of_style_l l = + let s = match l with + | [] -> code_of_style Reset + | [s] -> code_of_style s + | _ -> String.concat ";" (List.map code_of_style l) + in + "\x1b[" ^ s ^ "m" + + type styles = { + error: style list; + warning: style list; + loc: style list; + } + + let default_styles = { + warning = [Bold; FG Magenta]; + error = [Bold; FG Red]; + loc = [Bold]; + } + + let cur_styles = ref default_styles + let get_styles () = !cur_styles + let set_styles s = cur_styles := s + + (* map a tag to a style, if the tag is known. + @raise Not_found otherwise *) + let style_of_tag s = match s with + | "error" -> (!cur_styles).error + | "warning" -> (!cur_styles).warning + | "loc" -> (!cur_styles).loc + + | "info" -> [Bold; FG Yellow] + | "dim" -> [Dim] + | "filename" -> [FG Cyan] + + | _ -> raise Not_found + + let color_enabled = ref true + + (* either prints the tag of [s] or delegates to [or_else] *) + let mark_open_tag ~or_else s = + try + let style = style_of_tag s in + if !color_enabled then ansi_of_style_l style else "" + with Not_found -> or_else s + + let mark_close_tag ~or_else s = + try + let _ = style_of_tag s in + if !color_enabled then ansi_of_style_l [Reset] else "" + with Not_found -> or_else s + + (* add color handling to formatter [ppf] *) + let set_color_tag_handling ppf = + let open Format in + let functions = pp_get_formatter_tag_functions ppf () in + let functions' = {functions with + mark_open_tag=(mark_open_tag ~or_else:functions.mark_open_tag); + mark_close_tag=(mark_close_tag ~or_else:functions.mark_close_tag); + } in + pp_set_mark_tags ppf true; (* enable tags *) + pp_set_formatter_tag_functions ppf functions'; + (* also setup margins *) + pp_set_margin ppf (pp_get_margin std_formatter()); + () + + external isatty : out_channel -> bool = "caml_sys_isatty" + + (* reasonable heuristic on whether colors should be enabled *) + let should_enable_color () = + let term = try Sys.getenv "TERM" with Not_found -> "" in + term <> "dumb" + && term <> "" + && isatty stderr + + type setting = Auto | Always | Never + + let setup = + let first = ref true in (* initialize only once *) + let formatter_l = + [Format.std_formatter; Format.err_formatter; Format.str_formatter] + in + fun o -> + if !first then ( + first := false; + Format.set_mark_tags true; + List.iter set_color_tag_handling formatter_l; + color_enabled := (match o with + | Some Always -> true + | Some Auto -> should_enable_color () + | Some Never -> false + | None -> should_enable_color ()) + ); + () +end + +let normalise_eol s = + let b = Buffer.create 80 in + for i = 0 to String.length s - 1 do + if s.[i] <> '\r' then Buffer.add_char b s.[i] + done; + Buffer.contents b + +let delete_eol_spaces src = + let len_src = String.length src in + let dst = Bytes.create len_src in + let rec loop i_src i_dst = + if i_src = len_src then + i_dst + else + match src.[i_src] with + | ' ' | '\t' -> + loop_spaces 1 (i_src + 1) i_dst + | c -> + Bytes.set dst i_dst c; + loop (i_src + 1) (i_dst + 1) + and loop_spaces spaces i_src i_dst = + if i_src = len_src then + i_dst + else + match src.[i_src] with + | ' ' | '\t' -> + loop_spaces (spaces + 1) (i_src + 1) i_dst + | '\n' -> + Bytes.set dst i_dst '\n'; + loop (i_src + 1) (i_dst + 1) + | _ -> + for n = 0 to spaces do + Bytes.set dst (i_dst + n) src.[i_src - spaces + n] + done; + loop (i_src + 1) (i_dst + spaces + 1) + in + let stop = loop 0 0 in + Bytes.sub_string dst 0 stop + +type hook_info = { + sourcefile : string; +} + +exception HookExnWrapper of + { + error: exn; + hook_name: string; + hook_info: hook_info; + } + +exception HookExn of exn + +let raise_direct_hook_exn e = raise (HookExn e) + +let fold_hooks list hook_info ast = + List.fold_left (fun ast (hook_name,f) -> + try + f hook_info ast + with + | HookExn e -> raise e + | error -> raise (HookExnWrapper {error; hook_name; hook_info}) + (* when explicit reraise with backtrace will be available, + it should be used here *) + + ) ast (List.sort compare list) + +module type HookSig = sig + type t + + val add_hook : string -> (hook_info -> t -> t) -> unit + val apply_hooks : hook_info -> t -> t +end + +module MakeHooks(M: sig + type t + end) : HookSig with type t = M.t += struct + + type t = M.t + + let hooks = ref [] + let add_hook name f = hooks := (name, f) :: !hooks + let apply_hooks sourcefile intf = + fold_hooks !hooks sourcefile intf +end + +end +module Identifiable : sig +#1 "identifiable.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Uniform interface for common data structures over various things. *) + +module type Thing = sig + type t + + include Hashtbl.HashedType with type t := t + include Map.OrderedType with type t := t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit +end + +module Pair : functor (A : Thing) (B : Thing) -> Thing with type t = A.t * B.t + +module type Set = sig + module T : Set.OrderedType + include Set.S + with type elt = T.t + and type t = Set.Make (T).t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit + val to_string : t -> string + val of_list : elt list -> t + val map : (elt -> elt) -> t -> t +end + +module type Map = sig + module T : Map.OrderedType + include Map.S + with type key = T.t + and type 'a t = 'a Map.Make (T).t + + val filter_map : 'a t -> f:(key -> 'a -> 'b option) -> 'b t + val of_list : (key * 'a) list -> 'a t + + (** [disjoint_union m1 m2] contains all bindings from [m1] and + [m2]. If some binding is present in both and the associated + value is not equal, a Fatal_error is raised *) + val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t + + (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If + some binding is present in both, the one from [m2] is taken *) + val union_right : 'a t -> 'a t -> 'a t + + (** [union_left m1 m2 = union_right m2 m1] *) + val union_left : 'a t -> 'a t -> 'a t + + val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t + val rename : key t -> key -> key + val map_keys : (key -> key) -> 'a t -> 'a t + val keys : 'a t -> Set.Make(T).t + val data : 'a t -> 'a list + val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t + val transpose_keys_and_data : key t -> key t + val transpose_keys_and_data_set : key t -> Set.Make(T).t t + val print : + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit +end + +module type Tbl = sig + module T : sig + type t + include Map.OrderedType with type t := t + include Hashtbl.HashedType with type t := t + end + include Hashtbl.S + with type key = T.t + and type 'a t = 'a Hashtbl.Make (T).t + + val to_list : 'a t -> (T.t * 'a) list + val of_list : (T.t * 'a) list -> 'a t + + val to_map : 'a t -> 'a Map.Make(T).t + val of_map : 'a Map.Make(T).t -> 'a t + val memoize : 'a t -> (key -> 'a) -> key -> 'a + val map : 'a t -> ('a -> 'b) -> 'b t +end + +module type S = sig + type t + + module T : Thing with type t = t + include Thing with type t := T.t + + module Set : Set with module T := T + module Map : Map with module T := T + module Tbl : Tbl with module T := T +end + +module Make (T : Thing) : S with type t := T.t + +end = struct +#1 "identifiable.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +module type Thing = sig + type t + + include Hashtbl.HashedType with type t := t + include Map.OrderedType with type t := t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit +end + +module type Set = sig + module T : Set.OrderedType + include Set.S + with type elt = T.t + and type t = Set.Make (T).t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit + val to_string : t -> string + val of_list : elt list -> t + val map : (elt -> elt) -> t -> t +end + +module type Map = sig + module T : Map.OrderedType + include Map.S + with type key = T.t + and type 'a t = 'a Map.Make (T).t + + val filter_map : 'a t -> f:(key -> 'a -> 'b option) -> 'b t + val of_list : (key * 'a) list -> 'a t + + val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t + + val union_right : 'a t -> 'a t -> 'a t + + val union_left : 'a t -> 'a t -> 'a t + + val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t + val rename : key t -> key -> key + val map_keys : (key -> key) -> 'a t -> 'a t + val keys : 'a t -> Set.Make(T).t + val data : 'a t -> 'a list + val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t + val transpose_keys_and_data : key t -> key t + val transpose_keys_and_data_set : key t -> Set.Make(T).t t + val print : + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit +end + +module type Tbl = sig + module T : sig + type t + include Map.OrderedType with type t := t + include Hashtbl.HashedType with type t := t + end + include Hashtbl.S + with type key = T.t + and type 'a t = 'a Hashtbl.Make (T).t + + val to_list : 'a t -> (T.t * 'a) list + val of_list : (T.t * 'a) list -> 'a t + + val to_map : 'a t -> 'a Map.Make(T).t + val of_map : 'a Map.Make(T).t -> 'a t + val memoize : 'a t -> (key -> 'a) -> key -> 'a + val map : 'a t -> ('a -> 'b) -> 'b t +end + +module Pair (A : Thing) (B : Thing) : Thing with type t = A.t * B.t = struct + type t = A.t * B.t + + let compare (a1, b1) (a2, b2) = + let c = A.compare a1 a2 in + if c <> 0 then c + else B.compare b1 b2 + + let output oc (a, b) = Printf.fprintf oc " (%a, %a)" A.output a B.output b + let hash (a, b) = Hashtbl.hash (A.hash a, B.hash b) + let equal (a1, b1) (a2, b2) = A.equal a1 a2 && B.equal b1 b2 + let print ppf (a, b) = Format.fprintf ppf " (%a, @ %a)" A.print a B.print b +end + +module Make_map (T : Thing) = struct + include Map.Make (T) + + let filter_map t ~f = + fold (fun id v map -> + match f id v with + | None -> map + | Some r -> add id r map) t empty + + let of_list l = + List.fold_left (fun map (id, v) -> add id v map) empty l + + let disjoint_union ?eq ?print m1 m2 = + union (fun id v1 v2 -> + let ok = match eq with + | None -> false + | Some eq -> eq v1 v2 + in + if not ok then + let err = + match print with + | None -> + Format.asprintf "Map.disjoint_union %a" T.print id + | Some print -> + Format.asprintf "Map.disjoint_union %a => %a <> %a" + T.print id print v1 print v2 + in + Misc.fatal_error err + else Some v1) + m1 m2 + + let union_right m1 m2 = + merge (fun _id x y -> match x, y with + | None, None -> None + | None, Some v + | Some v, None + | Some _, Some v -> Some v) + m1 m2 + + let union_left m1 m2 = union_right m2 m1 + + let union_merge f m1 m2 = + let aux _ m1 m2 = + match m1, m2 with + | None, m | m, None -> m + | Some m1, Some m2 -> Some (f m1 m2) + in + merge aux m1 m2 + + let rename m v = + try find v m + with Not_found -> v + + let map_keys f m = + of_list (List.map (fun (k, v) -> f k, v) (bindings m)) + + let print f ppf s = + let elts ppf s = iter (fun id v -> + Format.fprintf ppf "@ (@[%a@ %a@])" T.print id f v) s in + Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s + + module T_set = Set.Make (T) + + let keys map = fold (fun k _ set -> T_set.add k set) map T_set.empty + + let data t = List.map snd (bindings t) + + let of_set f set = T_set.fold (fun e map -> add e (f e) map) set empty + + let transpose_keys_and_data map = fold (fun k v m -> add v k m) map empty + let transpose_keys_and_data_set map = + fold (fun k v m -> + let set = + match find v m with + | exception Not_found -> + T_set.singleton k + | set -> + T_set.add k set + in + add v set m) + map empty +end + +module Make_set (T : Thing) = struct + include Set.Make (T) + + let output oc s = + Printf.fprintf oc " ( "; + iter (fun v -> Printf.fprintf oc "%a " T.output v) s; + Printf.fprintf oc ")" + + let print ppf s = + let elts ppf s = iter (fun e -> Format.fprintf ppf "@ %a" T.print e) s in + Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s + + let to_string s = Format.asprintf "%a" print s + + let of_list l = match l with + | [] -> empty + | [t] -> singleton t + | t :: q -> List.fold_left (fun acc e -> add e acc) (singleton t) q + + let map f s = of_list (List.map f (elements s)) +end + +module Make_tbl (T : Thing) = struct + include Hashtbl.Make (T) + + module T_map = Make_map (T) + + let to_list t = + fold (fun key datum elts -> (key, datum)::elts) t [] + + let of_list elts = + let t = create 42 in + List.iter (fun (key, datum) -> add t key datum) elts; + t + + let to_map v = fold T_map.add v T_map.empty + + let of_map m = + let t = create (T_map.cardinal m) in + T_map.iter (fun k v -> add t k v) m; + t + + let memoize t f = fun key -> + try find t key with + | Not_found -> + let r = f key in + add t key r; + r + + let map t f = + of_map (T_map.map f (to_map t)) +end + +module type S = sig + type t + + module T : Thing with type t = t + include Thing with type t := T.t + + module Set : Set with module T := T + module Map : Map with module T := T + module Tbl : Tbl with module T := T +end + +module Make (T : Thing) = struct + module T = T + include T + + module Set = Make_set (T) + module Map = Make_map (T) + module Tbl = Make_tbl (T) +end + +end +module Numbers : sig +#1 "numbers.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Modules about numbers, some of which satisfy {!Identifiable.S}. *) + +module Int : sig + include Identifiable.S with type t = int + + (** [zero_to_n n] is the set of numbers \{0, ..., n\} (inclusive). *) + val zero_to_n : int -> Set.t +end + +module Int8 : sig + type t + + val zero : t + val one : t + + val of_int_exn : int -> t + val to_int : t -> int +end + +module Int16 : sig + type t + + val of_int_exn : int -> t + val of_int64_exn : Int64.t -> t + + val to_int : t -> int +end + +module Float : Identifiable.S with type t = float + +end = struct +#1 "numbers.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +module Int_base = Identifiable.Make (struct + type t = int + + let compare x y = x - y + let output oc x = Printf.fprintf oc "%i" x + let hash i = i + let equal (i : int) j = i = j + let print = Format.pp_print_int +end) + +module Int = struct + type t = int + + include Int_base + + let rec zero_to_n n = + if n < 0 then Set.empty else Set.add n (zero_to_n (n-1)) +end + +module Int8 = struct + type t = int + + let zero = 0 + let one = 1 + + let of_int_exn i = + if i < -(1 lsl 7) || i > ((1 lsl 7) - 1) then + Misc.fatal_errorf "Int8.of_int_exn: %d is out of range" i + else + i + + let to_int i = i +end + +module Int16 = struct + type t = int + + let of_int_exn i = + if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then + Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i + else + i + + let lower_int64 = Int64.neg (Int64.shift_left Int64.one 15) + let upper_int64 = Int64.sub (Int64.shift_left Int64.one 15) Int64.one + + let of_int64_exn i = + if Int64.compare i lower_int64 < 0 + || Int64.compare i upper_int64 > 0 + then + Misc.fatal_errorf "Int16.of_int64_exn: %Ld is out of range" i + else + Int64.to_int i + + let to_int t = t +end + +module Float = struct + type t = float + + include Identifiable.Make (struct + type t = float + + let compare x y = Pervasives.compare x y + let output oc x = Printf.fprintf oc "%f" x + let hash f = Hashtbl.hash f + let equal (i : float) j = i = j + let print = Format.pp_print_float + end) +end + +end +module Profile : sig +#1 "profile.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Compiler performance recording *) + +type file = string + +val reset : unit -> unit +(** erase all recorded profile information *) + +val record_call : ?accumulate:bool -> string -> (unit -> 'a) -> 'a +(** [record_call pass f] calls [f] and records its profile information. *) + +val record : ?accumulate:bool -> string -> ('a -> 'b) -> 'a -> 'b +(** [record pass f arg] records the profile information of [f arg] *) + +type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ] + +val print : Format.formatter -> column list -> unit +(** Prints the selected recorded profiling information to the formatter. *) + +(** Command line flags *) + +val options_doc : string +val all_columns : column list + +(** A few pass names that are needed in several places, and shared to + avoid typos. *) + +val generate : string +val transl : string +val typing : string + +end = struct +#1 "profile.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-18-40-42-48"] + +type file = string + +external time_include_children: bool -> float = "caml_sys_time_include_children" +let cpu_time () = time_include_children true + +module Measure = struct + type t = { + time : float; + allocated_words : float; + top_heap_words : int; + } + let create () = + let stat = Gc.quick_stat () in + { + time = cpu_time (); + allocated_words = stat.minor_words +. stat.major_words; + top_heap_words = stat.top_heap_words; + } + let zero = { time = 0.; allocated_words = 0.; top_heap_words = 0 } +end + +module Measure_diff = struct + let timestamp = let r = ref (-1) in fun () -> incr r; !r + type t = { + timestamp : int; + duration : float; + allocated_words : float; + top_heap_words_increase : int; + } + let zero () = { + timestamp = timestamp (); + duration = 0.; + allocated_words = 0.; + top_heap_words_increase = 0; + } + let accumulate t (m1 : Measure.t) (m2 : Measure.t) = { + timestamp = t.timestamp; + duration = t.duration +. (m2.time -. m1.time); + allocated_words = + t.allocated_words +. (m2.allocated_words -. m1.allocated_words); + top_heap_words_increase = + t.top_heap_words_increase + (m2.top_heap_words - m1.top_heap_words); + } + let of_diff m1 m2 = + accumulate (zero ()) m1 m2 +end + +type hierarchy = + | E of (string, Measure_diff.t * hierarchy) Hashtbl.t +[@@unboxed] + +let create () = E (Hashtbl.create 2) +let hierarchy = ref (create ()) +let initial_measure = ref None +let reset () = hierarchy := create (); initial_measure := None + +let record_call ?(accumulate = false) name f = + let E prev_hierarchy = !hierarchy in + let start_measure = Measure.create () in + if !initial_measure = None then initial_measure := Some start_measure; + let this_measure_diff, this_table = + (* We allow the recording of multiple categories by the same name, for tools + like ocamldoc that use the compiler libs but don't care about profile + information, and so may record, say, "parsing" multiple times. *) + if accumulate + then + match Hashtbl.find prev_hierarchy name with + | exception Not_found -> Measure_diff.zero (), Hashtbl.create 2 + | measure_diff, E table -> + Hashtbl.remove prev_hierarchy name; + measure_diff, table + else Measure_diff.zero (), Hashtbl.create 2 + in + hierarchy := E this_table; + Misc.try_finally f + (fun () -> + hierarchy := E prev_hierarchy; + let end_measure = Measure.create () in + let measure_diff = + Measure_diff.accumulate this_measure_diff start_measure end_measure in + Hashtbl.add prev_hierarchy name (measure_diff, E this_table)) + +let record ?accumulate pass f x = record_call ?accumulate pass (fun () -> f x) + +type display = { + to_string : max:float -> width:int -> string; + worth_displaying : max:float -> bool; +} + +let time_display v : display = + (* Because indentation is meaningful, and because the durations are + the first element of each row, we can't pad them with spaces. *) + let to_string_without_unit v ~width = Printf.sprintf "%0*.03f" width v in + let to_string ~max:_ ~width = + to_string_without_unit v ~width:(width - 1) ^ "s" in + let worth_displaying ~max:_ = + float_of_string (to_string_without_unit v ~width:0) <> 0. in + { to_string; worth_displaying } + +let memory_word_display = + (* To make memory numbers easily comparable across rows, we choose a single + scale for an entire column. To keep the display compact and not overly + precise (no one cares about the exact number of bytes), we pick the largest + scale we can and we only show 3 digits. Avoiding showing tiny numbers also + allows us to avoid displaying passes that barely allocate compared to the + rest of the compiler. *) + let bytes_of_words words = words *. float_of_int (Sys.word_size / 8) in + let to_string_without_unit v ~width scale = + let precision = 3 and precision_power = 1e3 in + let v_rescaled = bytes_of_words v /. scale in + let v_rounded = + floor (v_rescaled *. precision_power +. 0.5) /. precision_power in + let v_str = Printf.sprintf "%.*f" precision v_rounded in + let index_of_dot = String.index v_str '.' in + let v_str_truncated = + String.sub v_str 0 + (if index_of_dot >= precision + then index_of_dot + else precision + 1) + in + Printf.sprintf "%*s" width v_str_truncated + in + let choose_memory_scale = + let units = [|"B"; "kB"; "MB"; "GB"|] in + fun words -> + let bytes = bytes_of_words words in + let scale = ref (Array.length units - 1) in + while !scale > 0 && bytes < 1024. ** float_of_int !scale do + decr scale + done; + 1024. ** float_of_int !scale, units.(!scale) + in + fun ?previous v : display -> + let to_string ~max ~width = + let scale, scale_str = choose_memory_scale max in + let width = width - String.length scale_str in + to_string_without_unit v ~width scale ^ scale_str + in + let worth_displaying ~max = + let scale, _ = choose_memory_scale max in + float_of_string (to_string_without_unit v ~width:0 scale) <> 0. + && match previous with + | None -> true + | Some p -> + (* This branch is for numbers that represent absolute quantity, rather + than differences. It allows us to skip displaying the same absolute + quantity many times in a row. *) + to_string_without_unit p ~width:0 scale + <> to_string_without_unit v ~width:0 scale + in + { to_string; worth_displaying } + +let profile_list (E table) = + let l = Hashtbl.fold (fun k d l -> (k, d) :: l) table [] in + List.sort (fun (_, (p1, _)) (_, (p2, _)) -> + compare p1.Measure_diff.timestamp p2.Measure_diff.timestamp) l + +let compute_other_category (E table : hierarchy) (total : Measure_diff.t) = + let r = ref total in + Hashtbl.iter (fun _pass ((p2 : Measure_diff.t), _) -> + let p1 = !r in + r := { + timestamp = p1.timestamp; + duration = p1.duration -. p2.duration; + allocated_words = p1.allocated_words -. p2.allocated_words; + top_heap_words_increase = + p1.top_heap_words_increase - p2.top_heap_words_increase; + } + ) table; + !r + +type row = R of string * (float * display) list * row list +type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ] + +let rec rows_of_hierarchy ~nesting make_row name measure_diff hierarchy env = + let rows = + rows_of_hierarchy_list + ~nesting:(nesting + 1) make_row hierarchy measure_diff env in + let values, env = + make_row env measure_diff ~toplevel_other:(nesting = 0 && name = "other") in + R (name, values, rows), env + +and rows_of_hierarchy_list ~nesting make_row hierarchy total env = + let list = profile_list hierarchy in + let list = + if list <> [] || nesting = 0 + then list @ [ "other", (compute_other_category hierarchy total, create ()) ] + else [] + in + let env = ref env in + List.map (fun (name, (measure_diff, hierarchy)) -> + let a, env' = + rows_of_hierarchy ~nesting make_row name measure_diff hierarchy !env in + env := env'; + a + ) list + +let rows_of_hierarchy hierarchy measure_diff initial_measure columns = + (* Computing top heap size is a bit complicated: if the compiler applies a + list of passes n times (rather than applying pass1 n times, then pass2 n + times etc), we only show one row for that pass but what does "top heap + size at the end of that pass" even mean? + It seems the only sensible answer is to pretend the compiler applied pass1 + n times, pass2 n times by accumulating all the heap size increases that + happened during each pass, and then compute what the heap size would have + been. So that's what we do. + There's a bit of extra complication, which is that the heap can increase in + between measurements. So the heap sizes can be a bit off until the "other" + rows account for what's missing. We special case the toplevel "other" row + so that any increases that happened before the start of the compilation is + correctly reported, as a lot of code may run before the start of the + compilation (eg functor applications). *) + let make_row prev_top_heap_words (p : Measure_diff.t) ~toplevel_other = + let top_heap_words = + prev_top_heap_words + + p.top_heap_words_increase + - if toplevel_other + then initial_measure.Measure.top_heap_words + else 0 + in + let make value ~f = value, f value in + List.map (function + | `Time -> + make p.duration ~f:time_display + | `Alloc -> + make p.allocated_words ~f:memory_word_display + | `Top_heap -> + make (float_of_int p.top_heap_words_increase) ~f:memory_word_display + | `Abs_top_heap -> + make (float_of_int top_heap_words) + ~f:(memory_word_display ~previous:(float_of_int prev_top_heap_words)) + ) columns, + top_heap_words + in + rows_of_hierarchy_list ~nesting:0 make_row hierarchy measure_diff + initial_measure.top_heap_words + +let max_by_column ~n_columns rows = + let a = Array.make n_columns 0. in + let rec loop (R (_, values, rows)) = + List.iteri (fun i (v, _) -> a.(i) <- max a.(i) v) values; + List.iter loop rows + in + List.iter loop rows; + a + +let width_by_column ~n_columns ~display_cell rows = + let a = Array.make n_columns 1 in + let rec loop (R (_, values, rows)) = + List.iteri (fun i cell -> + let _, str = display_cell i cell ~width:0 in + a.(i) <- max a.(i) (String.length str) + ) values; + List.iter loop rows; + in + List.iter loop rows; + a + +let display_rows ppf rows = + let n_columns = + match rows with + | [] -> 0 + | R (_, values, _) :: _ -> List.length values + in + let maxs = max_by_column ~n_columns rows in + let display_cell i (_, c) ~width = + let display_cell = c.worth_displaying ~max:maxs.(i) in + display_cell, if display_cell + then c.to_string ~max:maxs.(i) ~width + else String.make width '-' + in + let widths = width_by_column ~n_columns ~display_cell rows in + let rec loop (R (name, values, rows)) ~indentation = + let worth_displaying, cell_strings = + values + |> List.mapi (fun i cell -> display_cell i cell ~width:widths.(i)) + |> List.split + in + if List.exists (fun b -> b) worth_displaying then + Format.fprintf ppf "%s%s %s@\n" + indentation (String.concat " " cell_strings) name; + List.iter (loop ~indentation:(" " ^ indentation)) rows; + in + List.iter (loop ~indentation:"") rows + +let print ppf columns = + match columns with + | [] -> () + | _ :: _ -> + let initial_measure = + match !initial_measure with + | Some v -> v + | None -> Measure.zero + in + let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in + display_rows ppf (rows_of_hierarchy !hierarchy total initial_measure columns) + +let column_mapping = [ + "time", `Time; + "alloc", `Alloc; + "top-heap", `Top_heap; + "absolute-top-heap", `Abs_top_heap; +] + +let column_names = List.map fst column_mapping + +let options_doc = + Printf.sprintf + " Print performance information for each pass\ + \n The columns are: %s." + (String.concat " " column_names) + +let all_columns = List.map snd column_mapping + +let generate = "generate" +let transl = "transl" +let typing = "typing" + +end +module Clflags : sig +#1 "clflags.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2005 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Command line flags *) + +(** Optimization parameters represented as ints indexed by round number. *) +module Int_arg_helper : sig + type parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:int -> parsed -> int +end + +(** Optimization parameters represented as floats indexed by round number. *) +module Float_arg_helper : sig + type parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:int -> parsed -> float +end + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + inline_branch_factor : float option; + inline_max_depth : int option; + inline_max_unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +val classic_arguments : inlining_arguments +val o1_arguments : inlining_arguments +val o2_arguments : inlining_arguments +val o3_arguments : inlining_arguments + +(** Set all the inlining arguments for a round. + The default is set if no round is provided. *) +val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit + +val objfiles : string list ref +val ccobjs : string list ref +val dllibs : string list ref +val compile_only : bool ref +val output_name : string option ref +val include_dirs : string list ref +val no_std_include : bool ref +val print_types : bool ref +val make_archive : bool ref +val debug : bool ref +val fast : bool ref +val use_linscan : bool ref +val link_everything : bool ref +val custom_runtime : bool ref +val no_check_prims : bool ref +val bytecode_compatible_32 : bool ref +val output_c_object : bool ref +val output_complete_object : bool ref +val all_ccopts : string list ref +val classic : bool ref +val nopervasives : bool ref +val open_modules : string list ref +val preprocessor : string option ref +val all_ppx : string list ref +val annotations : bool ref +val binary_annotations : bool ref +val use_threads : bool ref +val use_vmthreads : bool ref +val noassert : bool ref +val verbose : bool ref +val noprompt : bool ref +val nopromptcont : bool ref +val init_file : string option ref +val noinit : bool ref +val noversion : bool ref +val use_prims : string ref +val use_runtime : string ref +val principal : bool ref +val real_paths : bool ref +val recursive_types : bool ref +val strict_sequence : bool ref +val strict_formats : bool ref +val applicative_functors : bool ref +val make_runtime : bool ref +val gprofile : bool ref +val c_compiler : string option ref +val no_auto_link : bool ref +val dllpaths : string list ref +val make_package : bool ref +val for_package : string option ref +val error_size : int ref +val float_const_prop : bool ref +val transparent_modules : bool ref +val dump_source : bool ref +val dump_parsetree : bool ref +val dump_typedtree : bool ref +val dump_rawlambda : bool ref +val dump_lambda : bool ref +val dump_rawclambda : bool ref +val dump_clambda : bool ref +val dump_rawflambda : bool ref +val dump_flambda : bool ref +val dump_flambda_let : int option ref +val dump_instr : bool ref +val keep_asm_file : bool ref +val optimize_for_speed : bool ref +val dump_cmm : bool ref +val dump_selection : bool ref +val dump_cse : bool ref +val dump_live : bool ref +val dump_avail : bool ref +val debug_runavail : bool ref +val dump_spill : bool ref +val dump_split : bool ref +val dump_interf : bool ref +val dump_prefer : bool ref +val dump_regalloc : bool ref +val dump_reload : bool ref +val dump_scheduling : bool ref +val dump_linear : bool ref +val dump_interval : bool ref +val keep_startup_file : bool ref +val dump_combine : bool ref +val native_code : bool ref +val default_inline_threshold : float +val inline_threshold : Float_arg_helper.parsed ref +val inlining_report : bool ref +val simplify_rounds : int option ref +val default_simplify_rounds : int ref +val rounds : unit -> int +val default_inline_max_unroll : int +val inline_max_unroll : Int_arg_helper.parsed ref +val default_inline_toplevel_threshold : int +val inline_toplevel_threshold : Int_arg_helper.parsed ref +val default_inline_call_cost : int +val default_inline_alloc_cost : int +val default_inline_prim_cost : int +val default_inline_branch_cost : int +val default_inline_indirect_cost : int +val default_inline_lifting_benefit : int +val inline_call_cost : Int_arg_helper.parsed ref +val inline_alloc_cost : Int_arg_helper.parsed ref +val inline_prim_cost : Int_arg_helper.parsed ref +val inline_branch_cost : Int_arg_helper.parsed ref +val inline_indirect_cost : Int_arg_helper.parsed ref +val inline_lifting_benefit : Int_arg_helper.parsed ref +val default_inline_branch_factor : float +val inline_branch_factor : Float_arg_helper.parsed ref +val dont_write_files : bool ref +val std_include_flag : string -> string +val std_include_dir : unit -> string list +val shared : bool ref +val dlcode : bool ref +val pic_code : bool ref +val runtime_variant : string ref +val force_slash : bool ref +val keep_docs : bool ref +val keep_locs : bool ref +val unsafe_string : bool ref +val opaque : bool ref +val profile_columns : Profile.column list ref +val flambda_invariant_checks : bool ref +val unbox_closures : bool ref +val unbox_closures_factor : int ref +val default_unbox_closures_factor : int +val unbox_free_vars_of_closures : bool ref +val unbox_specialised_args : bool ref +val clambda_checks : bool ref +val default_inline_max_depth : int +val inline_max_depth : Int_arg_helper.parsed ref +val remove_unused_arguments : bool ref +val dump_flambda_verbose : bool ref +val classic_inlining : bool ref +val afl_instrument : bool ref +val afl_inst_ratio : int ref + +val all_passes : string list ref +val dumped_pass : string -> bool +val set_dumped_pass : string -> bool -> unit + +val parse_color_setting : string -> Misc.Color.setting option +val color : Misc.Color.setting option ref + +val unboxed_types : bool ref + +val arg_spec : (string * Arg.spec * string) list ref + +(* [add_arguments __LOC__ args] will add the arguments from [args] at + the end of [arg_spec], checking that they have not already been + added by [add_arguments] before. A warning is printed showing the + locations of the function from which the argument was previously + added. *) +val add_arguments : string -> (string * Arg.spec * string) list -> unit + +(* [parse_arguments anon_arg usage] will parse the arguments, using + the arguments provided in [Clflags.arg_spec]. It allows plugins to + provide their own arguments. +*) +val parse_arguments : Arg.anon_fun -> string -> unit + +(* [print_arguments usage] print the standard usage message *) +val print_arguments : string -> unit + +(* [reset_arguments ()] clear all declared arguments *) +val reset_arguments : unit -> unit + + +type mli_status = Mli_na | Mli_exists | Mli_non_exists +val no_implicit_current_dir : bool ref +val assume_no_mli : mli_status ref +val record_event_when_debug : bool ref +val bs_vscode : bool +val dont_record_crc_unit : string option ref +val bs_only : bool ref (* set true on bs top*) +val bs_gentype : string option ref +val no_assert_false : bool ref + + +end = struct +#1 "clflags.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Command-line parameters *) + +module Int_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Int + let of_string = int_of_string + end +end) +module Float_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Float + let of_string = float_of_string + end +end) + +let objfiles = ref ([] : string list) (* .cmo and .cma files *) +and ccobjs = ref ([] : string list) (* .o, .a, .so and -cclib -lxxx *) +and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *) + +let compile_only = ref false (* -c *) +and output_name = ref (None : string option) (* -o *) +and include_dirs = ref ([] : string list)(* -I *) +and no_std_include = ref false (* -nostdlib *) +and print_types = ref false (* -i *) +and make_archive = ref false (* -a *) +and debug = ref false (* -g *) +and fast = ref false (* -unsafe *) +and use_linscan = ref false (* -linscan *) +and link_everything = ref false (* -linkall *) +and custom_runtime = ref false (* -custom *) +and no_check_prims = ref false (* -no-check-prims *) +and bytecode_compatible_32 = ref false (* -compat-32 *) +and output_c_object = ref false (* -output-obj *) +and output_complete_object = ref false (* -output-complete-obj *) +and all_ccopts = ref ([] : string list) (* -ccopt *) +and classic = ref false (* -nolabels *) +and nopervasives = ref false (* -nopervasives *) +and preprocessor = ref(None : string option) (* -pp *) +and all_ppx = ref ([] : string list) (* -ppx *) +let annotations = ref false (* -annot *) +let binary_annotations = ref false (* -annot *) +and use_threads = ref false (* -thread *) +and use_vmthreads = ref false (* -vmthread *) +and noassert = ref false (* -noassert *) +and verbose = ref false (* -verbose *) +and noversion = ref false (* -no-version *) +and noprompt = ref false (* -noprompt *) +and nopromptcont = ref false (* -nopromptcont *) +and init_file = ref (None : string option) (* -init *) +and noinit = ref false (* -noinit *) +and open_modules = ref [] (* -open *) +and use_prims = ref "" (* -use-prims ... *) +and use_runtime = ref "" (* -use-runtime ... *) +and principal = ref false (* -principal *) +and real_paths = ref true (* -short-paths *) +and recursive_types = ref false (* -rectypes *) +and strict_sequence = ref false (* -strict-sequence *) +and strict_formats = ref false (* -strict-formats *) +and applicative_functors = ref true (* -no-app-funct *) +and make_runtime = ref false (* -make-runtime *) +and gprofile = ref false (* -p *) +and c_compiler = ref (None: string option) (* -cc *) +and no_auto_link = ref false (* -noautolink *) +and dllpaths = ref ([] : string list) (* -dllpath *) +and make_package = ref false (* -pack *) +and for_package = ref (None: string option) (* -for-pack *) +and error_size = ref 500 (* -error-size *) +and float_const_prop = ref true (* -no-float-const-prop *) +and transparent_modules = ref false (* -trans-mod *) +let dump_source = ref false (* -dsource *) +let dump_parsetree = ref false (* -dparsetree *) +and dump_typedtree = ref false (* -dtypedtree *) +and dump_rawlambda = ref false (* -drawlambda *) +and dump_lambda = ref false (* -dlambda *) +and dump_rawclambda = ref false (* -drawclambda *) +and dump_clambda = ref false (* -dclambda *) +and dump_rawflambda = ref false (* -drawflambda *) +and dump_flambda = ref false (* -dflambda *) +and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *) +and dump_flambda_verbose = ref false (* -dflambda-verbose *) +and dump_instr = ref false (* -dinstr *) + +let keep_asm_file = ref false (* -S *) +let optimize_for_speed = ref true (* -compact *) +and opaque = ref false (* -opaque *) + +and dump_cmm = ref false (* -dcmm *) +let dump_selection = ref false (* -dsel *) +let dump_cse = ref false (* -dcse *) +let dump_live = ref false (* -dlive *) +let dump_avail = ref false (* -davail *) +let dump_spill = ref false (* -dspill *) +let dump_split = ref false (* -dsplit *) +let dump_interf = ref false (* -dinterf *) +let dump_prefer = ref false (* -dprefer *) +let dump_regalloc = ref false (* -dalloc *) +let dump_reload = ref false (* -dreload *) +let dump_scheduling = ref false (* -dscheduling *) +let dump_linear = ref false (* -dlinear *) +let dump_interval = ref false (* -dinterval *) +let keep_startup_file = ref false (* -dstartup *) +let dump_combine = ref false (* -dcombine *) +let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *) + +let debug_runavail = ref false (* -drunavail *) + +let native_code = ref false (* set to true under ocamlopt *) + +let force_slash = ref false (* for ocamldep *) +let clambda_checks = ref false (* -clambda-checks *) + +let flambda_invariant_checks = ref true (* -flambda-invariants *) + +let dont_write_files = ref false (* set to true under ocamldoc *) + +let std_include_flag prefix = + if !no_std_include then "" + else (prefix ^ (Filename.quote Config.standard_library)) +;; + +let std_include_dir () = + if !no_std_include then [] else [Config.standard_library] +;; + +let shared = ref false (* -shared *) +let dlcode = ref true (* not -nodynlink *) + +let pic_code = ref (match Config.architecture with (* -fPIC *) + | "amd64" -> true + | _ -> false) + +let runtime_variant = ref "";; (* -runtime-variant *) + +let keep_docs = ref false (* -keep-docs *) +let keep_locs = ref true (* -keep-locs *) +let unsafe_string = + if Config.safe_string then ref false + else ref (not Config.default_safe_string) + (* -safe-string / -unsafe-string *) + +let classic_inlining = ref false (* -Oclassic *) +let inlining_report = ref false (* -inlining-report *) + +let afl_instrument = ref Config.afl_instrument (* -afl-instrument *) +let afl_inst_ratio = ref 100 (* -afl-inst-ratio *) + +let simplify_rounds = ref None (* -rounds *) +let default_simplify_rounds = ref 1 (* -rounds *) +let rounds () = + match !simplify_rounds with + | None -> !default_simplify_rounds + | Some r -> r + +let default_inline_threshold = if Config.flambda then 10. else 10. /. 8. +let inline_toplevel_multiplier = 16 +let default_inline_toplevel_threshold = + int_of_float ((float inline_toplevel_multiplier) *. default_inline_threshold) +let default_inline_call_cost = 5 +let default_inline_alloc_cost = 7 +let default_inline_prim_cost = 3 +let default_inline_branch_cost = 5 +let default_inline_indirect_cost = 4 +let default_inline_branch_factor = 0.1 +let default_inline_lifting_benefit = 1300 +let default_inline_max_unroll = 0 +let default_inline_max_depth = 1 + +let inline_threshold = ref (Float_arg_helper.default default_inline_threshold) +let inline_toplevel_threshold = + ref (Int_arg_helper.default default_inline_toplevel_threshold) +let inline_call_cost = ref (Int_arg_helper.default default_inline_call_cost) +let inline_alloc_cost = ref (Int_arg_helper.default default_inline_alloc_cost) +let inline_prim_cost = ref (Int_arg_helper.default default_inline_prim_cost) +let inline_branch_cost = + ref (Int_arg_helper.default default_inline_branch_cost) +let inline_indirect_cost = + ref (Int_arg_helper.default default_inline_indirect_cost) +let inline_branch_factor = + ref (Float_arg_helper.default default_inline_branch_factor) +let inline_lifting_benefit = + ref (Int_arg_helper.default default_inline_lifting_benefit) +let inline_max_unroll = + ref (Int_arg_helper.default default_inline_max_unroll) +let inline_max_depth = + ref (Int_arg_helper.default default_inline_max_depth) + + +let unbox_specialised_args = ref true (* -no-unbox-specialised-args *) +let unbox_free_vars_of_closures = ref true +let unbox_closures = ref false (* -unbox-closures *) +let default_unbox_closures_factor = 10 +let unbox_closures_factor = + ref default_unbox_closures_factor (* -unbox-closures-factor *) +let remove_unused_arguments = ref false (* -remove-unused-arguments *) + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + inline_branch_factor : float option; + inline_max_depth : int option; + inline_max_unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +let set_int_arg round (arg:Int_arg_helper.parsed ref) default value = + let value : int = + match value with + | None -> default + | Some value -> value + in + match round with + | None -> + arg := Int_arg_helper.set_base_default value + (Int_arg_helper.reset_base_overrides !arg) + | Some round -> + arg := Int_arg_helper.add_base_override round value !arg + +let set_float_arg round (arg:Float_arg_helper.parsed ref) default value = + let value = + match value with + | None -> default + | Some value -> value + in + match round with + | None -> + arg := Float_arg_helper.set_base_default value + (Float_arg_helper.reset_base_overrides !arg) + | Some round -> + arg := Float_arg_helper.add_base_override round value !arg + +let use_inlining_arguments_set ?round (arg:inlining_arguments) = + let set_int = set_int_arg round in + let set_float = set_float_arg round in + set_int inline_call_cost default_inline_call_cost arg.inline_call_cost; + set_int inline_alloc_cost default_inline_alloc_cost arg.inline_alloc_cost; + set_int inline_prim_cost default_inline_prim_cost arg.inline_prim_cost; + set_int inline_branch_cost + default_inline_branch_cost arg.inline_branch_cost; + set_int inline_indirect_cost + default_inline_indirect_cost arg.inline_indirect_cost; + set_int inline_lifting_benefit + default_inline_lifting_benefit arg.inline_lifting_benefit; + set_float inline_branch_factor + default_inline_branch_factor arg.inline_branch_factor; + set_int inline_max_depth + default_inline_max_depth arg.inline_max_depth; + set_int inline_max_unroll + default_inline_max_unroll arg.inline_max_unroll; + set_float inline_threshold + default_inline_threshold arg.inline_threshold; + set_int inline_toplevel_threshold + default_inline_toplevel_threshold arg.inline_toplevel_threshold + +(* o1 is the default *) +let o1_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = None; + inline_max_unroll = None; + inline_threshold = None; + inline_toplevel_threshold = None; +} + +let classic_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = None; + inline_max_unroll = None; + (* [inline_threshold] matches the current compiler's default. + Note that this particular fraction can be expressed exactly in + floating point. *) + inline_threshold = Some (10. /. 8.); + (* [inline_toplevel_threshold] is not used in classic mode. *) + inline_toplevel_threshold = Some 1; +} + +let o2_arguments = { + inline_call_cost = Some (2 * default_inline_call_cost); + inline_alloc_cost = Some (2 * default_inline_alloc_cost); + inline_prim_cost = Some (2 * default_inline_prim_cost); + inline_branch_cost = Some (2 * default_inline_branch_cost); + inline_indirect_cost = Some (2 * default_inline_indirect_cost); + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = Some 2; + inline_max_unroll = None; + inline_threshold = Some 25.; + inline_toplevel_threshold = Some (25 * inline_toplevel_multiplier); +} + +let o3_arguments = { + inline_call_cost = Some (3 * default_inline_call_cost); + inline_alloc_cost = Some (3 * default_inline_alloc_cost); + inline_prim_cost = Some (3 * default_inline_prim_cost); + inline_branch_cost = Some (3 * default_inline_branch_cost); + inline_indirect_cost = Some (3 * default_inline_indirect_cost); + inline_lifting_benefit = None; + inline_branch_factor = Some 0.; + inline_max_depth = Some 3; + inline_max_unroll = Some 1; + inline_threshold = Some 50.; + inline_toplevel_threshold = Some (50 * inline_toplevel_multiplier); +} + +let all_passes = ref [] +let dumped_passes_list = ref [] +let dumped_pass s = + assert(List.mem s !all_passes); + List.mem s !dumped_passes_list + +let set_dumped_pass s enabled = + if (List.mem s !all_passes) then begin + let passes_without_s = List.filter ((<>) s) !dumped_passes_list in + let dumped_passes = + if enabled then + s :: passes_without_s + else + passes_without_s + in + dumped_passes_list := dumped_passes + end + +let parse_color_setting = function + | "auto" -> Some Misc.Color.Auto + | "always" -> Some Misc.Color.Always + | "never" -> Some Misc.Color.Never + | _ -> None +let color = ref None ;; (* -color *) + +let unboxed_types = ref false + +let arg_spec = ref [] +let arg_names = ref Misc.StringMap.empty + +let reset_arguments () = + arg_spec := []; + arg_names := Misc.StringMap.empty + +let add_arguments loc args = + List.iter (function (arg_name, _, _) as arg -> + try + let loc2 = Misc.StringMap.find arg_name !arg_names in + Printf.eprintf + "Warning: plugin argument %s is already defined:\n" arg_name; + Printf.eprintf " First definition: %s\n" loc2; + Printf.eprintf " New definition: %s\n" loc; + with Not_found -> + arg_spec := !arg_spec @ [ arg ]; + arg_names := Misc.StringMap.add arg_name loc !arg_names + ) args + +let print_arguments usage = + Arg.usage !arg_spec usage + +(* This function is almost the same as [Arg.parse_expand], except + that [Arg.parse_expand] could not be used because it does not take a + reference for [arg_spec].*) +let parse_arguments f msg = + try + let argv = ref Sys.argv in + let current = ref (!Arg.current) in + Arg.parse_and_expand_argv_dynamic current argv arg_spec f msg + with + | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2 + | Arg.Help msg -> Printf.printf "%s" msg; exit 0 + + +type mli_status = Mli_na | Mli_exists | Mli_non_exists +let no_implicit_current_dir = ref false +let assume_no_mli = ref Mli_na +let record_event_when_debug = ref true (* turned off in BuckleScript*) +let bs_vscode = + try ignore @@ Sys.getenv "BS_VSCODE" ; true with _ -> false + (* We get it from environment variable mostly due to + we don't want to rebuild when flip on or off + *) +let dont_record_crc_unit : string option ref = ref None +let bs_only = ref false +let bs_gentype = ref None +let no_assert_false = ref false + + +end +module Terminfo : sig +#1 "terminfo.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Basic interface to the terminfo database *) + +type status = + | Uninitialised + | Bad_term + | Good_term of int (* number of lines of the terminal *) +;; +external setup : out_channel -> status = "caml_terminfo_setup";; +external backup : int -> unit = "caml_terminfo_backup";; +external standout : bool -> unit = "caml_terminfo_standout";; +external resume : int -> unit = "caml_terminfo_resume";; + +end = struct +#1 "terminfo.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Basic interface to the terminfo database *) + +type status = + | Uninitialised + | Bad_term + | Good_term of int +;; +external setup : out_channel -> status = "caml_terminfo_setup";; +external backup : int -> unit = "caml_terminfo_backup";; +external standout : bool -> unit = "caml_terminfo_standout";; +external resume : int -> unit = "caml_terminfo_resume";; + +end +module Warnings : sig +#1 "warnings.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) +(* *) +(* Copyright 1998 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +type t = + | Comment_start (* 1 *) + | Comment_not_end (* 2 *) + | Deprecated of string * loc * loc (* 3 *) + | Fragile_match of string (* 4 *) + | Partial_application (* 5 *) + | Labels_omitted of string list (* 6 *) + | Method_override of string list (* 7 *) + | Partial_match of string (* 8 *) + | Non_closed_record_pattern of string (* 9 *) + | Statement_type (* 10 *) + | Unused_match (* 11 *) + | Unused_pat (* 12 *) + | Instance_variable_override of string list (* 13 *) + | Illegal_backslash (* 14 *) + | Implicit_public_methods of string list (* 15 *) + | Unerasable_optional_argument (* 16 *) + | Undeclared_virtual_method of string (* 17 *) + | Not_principal of string (* 18 *) + | Without_principality of string (* 19 *) + | Unused_argument (* 20 *) + | Nonreturning_statement (* 21 *) + | Preprocessor of string (* 22 *) + | Useless_record_with (* 23 *) + | Bad_module_name of string (* 24 *) + | All_clauses_guarded (* 8, used to be 25 *) + | Unused_var of string (* 26 *) + | Unused_var_strict of string (* 27 *) + | Wildcard_arg_to_constant_constr (* 28 *) + | Eol_in_string (* 29 *) + | Duplicate_definitions of string * string * string * string (* 30 *) + | Multiple_definition of string * string * string (* 31 *) + | Unused_value_declaration of string (* 32 *) + | Unused_open of string (* 33 *) + | Unused_type_declaration of string (* 34 *) + | Unused_for_index of string (* 35 *) + | Unused_ancestor of string (* 36 *) + | Unused_constructor of string * bool * bool (* 37 *) + | Unused_extension of string * bool * bool * bool (* 38 *) + | Unused_rec_flag (* 39 *) + | Name_out_of_scope of string * string list * bool (* 40 *) + | Ambiguous_name of string list * string list * bool (* 41 *) + | Disambiguated_name of string (* 42 *) + | Nonoptional_label of string (* 43 *) + | Open_shadow_identifier of string * string (* 44 *) + | Open_shadow_label_constructor of string * string (* 45 *) + | Bad_env_variable of string * string (* 46 *) + | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) + | No_cmi_file of string * string option (* 49 *) + | Bad_docstring of bool (* 50 *) + | Expect_tailcall (* 51 *) + | Fragile_literal_pattern (* 52 *) + | Misplaced_attribute of string (* 53 *) + | Duplicated_attribute of string (* 54 *) + | Inlining_impossible of string (* 55 *) + | Unreachable_case (* 56 *) + | Ambiguous_pattern of string list (* 57 *) + | No_cmx_file of string (* 58 *) + | Assignment_to_non_mutable_value (* 59 *) + | Unused_module of string (* 60 *) + | Unboxable_type_in_prim_decl of string (* 61 *) + | Constraint_on_gadt (* 62 *) + + | Bs_unused_attribute of string (* 101 *) + | Bs_polymorphic_comparison (* 102 *) + | Bs_ffi_warning of string (* 103 *) + | Bs_derive_warning of string (* 104 *) + +;; + +val parse_options : bool -> string -> unit;; + +val without_warnings : (unit -> 'a) -> 'a + +val is_active : t -> bool;; +val is_error : t -> bool;; + +val defaults_w : string;; +val defaults_warn_error : string;; + +type reporting_information = + { number : int + ; message : string + ; is_error : bool + ; sub_locs : (loc * string) list; + } + +val report : t -> [ `Active of reporting_information | `Inactive ] + +exception Errors;; + +val check_fatal : unit -> unit;; +val reset_fatal: unit -> unit + +val help_warnings: unit -> unit + +type state +val backup: unit -> state +val restore: state -> unit +val mk_lazy: (unit -> 'a) -> 'a Lazy.t + (** Like [Lazy.of_fun], but the function is applied with + the warning settings at the time [mk_lazy] is called. *) + + +val message : t -> string +val number: t -> int +val super_report : + (t -> string) -> + t -> [ `Active of reporting_information | `Inactive ] + + +end = struct +#1 "warnings.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) +(* *) +(* Copyright 1998 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* When you change this, you need to update the documentation: + - man/ocamlc.m + - man/ocamlopt.m + - manual/manual/cmds/comp.etex + - manual/manual/cmds/native.etex +*) + +type loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +type t = + | Comment_start (* 1 *) + | Comment_not_end (* 2 *) + | Deprecated of string * loc * loc (* 3 *) + | Fragile_match of string (* 4 *) + | Partial_application (* 5 *) + | Labels_omitted of string list (* 6 *) + | Method_override of string list (* 7 *) + | Partial_match of string (* 8 *) + | Non_closed_record_pattern of string (* 9 *) + | Statement_type (* 10 *) + | Unused_match (* 11 *) + | Unused_pat (* 12 *) + | Instance_variable_override of string list (* 13 *) + | Illegal_backslash (* 14 *) + | Implicit_public_methods of string list (* 15 *) + | Unerasable_optional_argument (* 16 *) + | Undeclared_virtual_method of string (* 17 *) + | Not_principal of string (* 18 *) + | Without_principality of string (* 19 *) + | Unused_argument (* 20 *) + | Nonreturning_statement (* 21 *) + | Preprocessor of string (* 22 *) + | Useless_record_with (* 23 *) + | Bad_module_name of string (* 24 *) + | All_clauses_guarded (* 8, used to be 25 *) + | Unused_var of string (* 26 *) + | Unused_var_strict of string (* 27 *) + | Wildcard_arg_to_constant_constr (* 28 *) + | Eol_in_string (* 29 *) + | Duplicate_definitions of string * string * string * string (*30 *) + | Multiple_definition of string * string * string (* 31 *) + | Unused_value_declaration of string (* 32 *) + | Unused_open of string (* 33 *) + | Unused_type_declaration of string (* 34 *) + | Unused_for_index of string (* 35 *) + | Unused_ancestor of string (* 36 *) + | Unused_constructor of string * bool * bool (* 37 *) + | Unused_extension of string * bool * bool * bool (* 38 *) + | Unused_rec_flag (* 39 *) + | Name_out_of_scope of string * string list * bool (* 40 *) + | Ambiguous_name of string list * string list * bool (* 41 *) + | Disambiguated_name of string (* 42 *) + | Nonoptional_label of string (* 43 *) + | Open_shadow_identifier of string * string (* 44 *) + | Open_shadow_label_constructor of string * string (* 45 *) + | Bad_env_variable of string * string (* 46 *) + | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) + | No_cmi_file of string * string option (* 49 *) + | Bad_docstring of bool (* 50 *) + | Expect_tailcall (* 51 *) + | Fragile_literal_pattern (* 52 *) + | Misplaced_attribute of string (* 53 *) + | Duplicated_attribute of string (* 54 *) + | Inlining_impossible of string (* 55 *) + | Unreachable_case (* 56 *) + | Ambiguous_pattern of string list (* 57 *) + | No_cmx_file of string (* 58 *) + | Assignment_to_non_mutable_value (* 59 *) + | Unused_module of string (* 60 *) + | Unboxable_type_in_prim_decl of string (* 61 *) + | Constraint_on_gadt (* 62 *) + + + | Bs_unused_attribute of string (* 101 *) + | Bs_polymorphic_comparison (* 102 *) + | Bs_ffi_warning of string (* 103 *) + | Bs_derive_warning of string (* 104 *) + +;; + +(* If you remove a warning, leave a hole in the numbering. NEVER change + the numbers of existing warnings. + If you add a new warning, add it at the end with a new number; + do NOT reuse one of the holes. +*) + +let number = function + | Comment_start -> 1 + | Comment_not_end -> 2 + | Deprecated _ -> 3 + | Fragile_match _ -> 4 + | Partial_application -> 5 + | Labels_omitted _ -> 6 + | Method_override _ -> 7 + | Partial_match _ -> 8 + | Non_closed_record_pattern _ -> 9 + | Statement_type -> 10 + | Unused_match -> 11 + | Unused_pat -> 12 + | Instance_variable_override _ -> 13 + | Illegal_backslash -> 14 + | Implicit_public_methods _ -> 15 + | Unerasable_optional_argument -> 16 + | Undeclared_virtual_method _ -> 17 + | Not_principal _ -> 18 + | Without_principality _ -> 19 + | Unused_argument -> 20 + | Nonreturning_statement -> 21 + | Preprocessor _ -> 22 + | Useless_record_with -> 23 + | Bad_module_name _ -> 24 + | All_clauses_guarded -> 8 (* used to be 25 *) + | Unused_var _ -> 26 + | Unused_var_strict _ -> 27 + | Wildcard_arg_to_constant_constr -> 28 + | Eol_in_string -> 29 + | Duplicate_definitions _ -> 30 + | Multiple_definition _ -> 31 + | Unused_value_declaration _ -> 32 + | Unused_open _ -> 33 + | Unused_type_declaration _ -> 34 + | Unused_for_index _ -> 35 + | Unused_ancestor _ -> 36 + | Unused_constructor _ -> 37 + | Unused_extension _ -> 38 + | Unused_rec_flag -> 39 + | Name_out_of_scope _ -> 40 + | Ambiguous_name _ -> 41 + | Disambiguated_name _ -> 42 + | Nonoptional_label _ -> 43 + | Open_shadow_identifier _ -> 44 + | Open_shadow_label_constructor _ -> 45 + | Bad_env_variable _ -> 46 + | Attribute_payload _ -> 47 + | Eliminated_optional_arguments _ -> 48 + | No_cmi_file _ -> 49 + | Bad_docstring _ -> 50 + | Expect_tailcall -> 51 + | Fragile_literal_pattern -> 52 + | Misplaced_attribute _ -> 53 + | Duplicated_attribute _ -> 54 + | Inlining_impossible _ -> 55 + | Unreachable_case -> 56 + | Ambiguous_pattern _ -> 57 + | No_cmx_file _ -> 58 + | Assignment_to_non_mutable_value -> 59 + | Unused_module _ -> 60 + | Unboxable_type_in_prim_decl _ -> 61 + | Constraint_on_gadt -> 62 + + + | Bs_unused_attribute _ -> 101 + | Bs_polymorphic_comparison -> 102 + | Bs_ffi_warning _ -> 103 + | Bs_derive_warning _ -> 104 + +;; + +let last_warning_number = 104 +;; + +let letter_all = + let rec loop i = if i = 0 then [] else i :: loop (i - 1) in + loop last_warning_number + +(* Must be the max number returned by the [number] function. *) + +let letter = function + | 'a' -> letter_all + | 'b' -> [] + | 'c' -> [1; 2] + | 'd' -> [3] + | 'e' -> [4] + | 'f' -> [5] + | 'g' -> [] + | 'h' -> [] + | 'i' -> [] + | 'j' -> [] + | 'k' -> [32; 33; 34; 35; 36; 37; 38; 39] + | 'l' -> [6] + | 'm' -> [7] + | 'n' -> [] + | 'o' -> [] + | 'p' -> [8] + | 'q' -> [] + | 'r' -> [9] + | 's' -> [10] + | 't' -> [] + | 'u' -> [11; 12] + | 'v' -> [13] + | 'w' -> [] + | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 30] + | 'y' -> [26] + | 'z' -> [27] + | _ -> assert false +;; + +type state = + { + active: bool array; + error: bool array; + } + +let current = + ref + { + active = Array.make (last_warning_number + 1) true; + error = Array.make (last_warning_number + 1) false; + } + +let disabled = ref false + +let without_warnings f = + Misc.protect_refs [Misc.R(disabled, true)] f + +let backup () = !current + +let restore x = current := x + +let is_active x = not !disabled && (!current).active.(number x);; +let is_error x = not !disabled && (!current).error.(number x);; + +let mk_lazy f = + let state = backup () in + lazy + ( + let prev = backup () in + restore state; + try + let r = f () in + restore prev; + r + with exn -> + restore prev; + raise exn + ) + +let parse_opt error active flags s = + let set i = flags.(i) <- true in + let clear i = flags.(i) <- false in + let set_all i = active.(i) <- true; error.(i) <- true in + let error () = raise (Arg.Bad "Ill-formed list of warnings") in + let rec get_num n i = + if i >= String.length s then i, n + else match s.[i] with + | '0'..'9' -> get_num (10 * n + Char.code s.[i] - Char.code '0') (i + 1) + | _ -> i, n + in + let get_range i = + let i, n1 = get_num 0 i in + if i + 2 < String.length s && s.[i] = '.' && s.[i + 1] = '.' then + let i, n2 = get_num 0 (i + 2) in + if n2 < n1 then error (); + i, n1, n2 + else + i, n1, n1 + in + let rec loop i = + if i >= String.length s then () else + match s.[i] with + | 'A' .. 'Z' -> + List.iter set (letter (Char.lowercase_ascii s.[i])); + loop (i+1) + | 'a' .. 'z' -> + List.iter clear (letter s.[i]); + loop (i+1) + | '+' -> loop_letter_num set (i+1) + | '-' -> loop_letter_num clear (i+1) + | '@' -> loop_letter_num set_all (i+1) + | _ -> error () + and loop_letter_num myset i = + if i >= String.length s then error () else + match s.[i] with + | '0' .. '9' -> + let i, n1, n2 = get_range i in + for n = n1 to min n2 last_warning_number do myset n done; + loop i + | 'A' .. 'Z' -> + List.iter myset (letter (Char.lowercase_ascii s.[i])); + loop (i+1) + | 'a' .. 'z' -> + List.iter myset (letter s.[i]); + loop (i+1) + | _ -> error () + in + loop 0 +;; + +let parse_options errflag s = + let error = Array.copy (!current).error in + let active = Array.copy (!current).active in + parse_opt error active (if errflag then error else active) s; + current := {error; active} + +(* If you change these, don't forget to change them in man/ocamlc.m *) +let defaults_w = "+a-4-6-7-9-27-29-32..42-44-45-48-50-60-102";; +let defaults_warn_error = "-a+31";; + +let () = parse_options false defaults_w;; +let () = parse_options true defaults_warn_error;; + +let message = function + | Comment_start -> "this is the start of a comment." + | Comment_not_end -> "this is not the end of a comment." + | Deprecated (s, _, _) -> + (* Reduce \r\n to \n: + - Prevents any \r characters being printed on Unix when processing + Windows sources + - Prevents \r\r\n being generated on Windows, which affects the + testsuite + *) + "deprecated: " ^ Misc.normalise_eol s + | Fragile_match "" -> + "this pattern-matching is fragile." + | Fragile_match s -> + "this pattern-matching is fragile.\n\ + It will remain exhaustive when constructors are added to type " ^ s ^ "." + | Partial_application -> + "this function application is partial,\n\ + maybe some arguments are missing." + | Labels_omitted [] -> assert false + | Labels_omitted [l] -> + "label " ^ l ^ " was omitted in the application of this function." + | Labels_omitted ls -> + "labels " ^ String.concat ", " ls ^ + " were omitted in the application of this function." + | Method_override [lab] -> + "the method " ^ lab ^ " is overridden." + | Method_override (cname :: slist) -> + String.concat " " + ("the following methods are overridden by the class" + :: cname :: ":\n " :: slist) + | Method_override [] -> assert false + | Partial_match "" -> "this pattern-matching is not exhaustive." + | Partial_match s -> + "this pattern-matching is not exhaustive.\n\ + Here is an example of a case that is not matched:\n" ^ s + | Non_closed_record_pattern s -> + "the following labels are not bound in this record pattern:\n" ^ s ^ + "\nEither bind these labels explicitly or add '; _' to the pattern." + | Statement_type -> + "this expression should have type unit." + | Unused_match -> "this match case is unused." + | Unused_pat -> "this sub-pattern is unused." + | Instance_variable_override [lab] -> + "the instance variable " ^ lab ^ " is overridden.\n" ^ + "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" + | Instance_variable_override (cname :: slist) -> + String.concat " " + ("the following instance variables are overridden by the class" + :: cname :: ":\n " :: slist) ^ + "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" + | Instance_variable_override [] -> assert false + | Illegal_backslash -> "illegal backslash escape in string." + | Implicit_public_methods l -> + "the following private methods were made public implicitly:\n " + ^ String.concat " " l ^ "." + | Unerasable_optional_argument -> "this optional argument cannot be erased." + | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared." + | Not_principal s -> s^" is not principal." + | Without_principality s -> s^" without principality." + | Unused_argument -> "this argument will not be used by the function." + | Nonreturning_statement -> + "this statement never returns (or has an unsound type.)" + | Preprocessor s -> s + | Useless_record_with -> + "all the fields are explicitly listed in this record:\n\ + the 'with' clause is useless." + | Bad_module_name (modname) -> + "bad source file name: \"" ^ modname ^ "\" is not a valid module name." + | All_clauses_guarded -> + "this pattern-matching is not exhaustive.\n\ + All clauses in this pattern-matching are guarded." + | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "." + | Wildcard_arg_to_constant_constr -> + "wildcard pattern given as argument to a constant constructor" + | Eol_in_string -> + "unescaped end-of-line in a string constant (non-portable code)" + | Duplicate_definitions (kind, cname, tc1, tc2) -> + Printf.sprintf "the %s %s is defined in both types %s and %s." + kind cname tc1 tc2 + | Multiple_definition(modname, file1, file2) -> + Printf.sprintf + "files %s and %s both define a module named %s" + file1 file2 modname + | Unused_value_declaration v -> "unused value " ^ v ^ "." + | Unused_open s -> "unused open " ^ s ^ "." + | Unused_type_declaration s -> "unused type " ^ s ^ "." + | Unused_for_index s -> "unused for-loop index " ^ s ^ "." + | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "." + | Unused_constructor (s, false, false) -> "unused constructor " ^ s ^ "." + | Unused_constructor (s, true, _) -> + "constructor " ^ s ^ + " is never used to build values.\n\ + (However, this constructor appears in patterns.)" + | Unused_constructor (s, false, true) -> + "constructor " ^ s ^ + " is never used to build values.\n\ + Its type is exported as a private type." + | Unused_extension (s, is_exception, cu_pattern, cu_privatize) -> + let kind = + if is_exception then "exception" else "extension constructor" in + let name = kind ^ " " ^ s in + begin match cu_pattern, cu_privatize with + | false, false -> "unused " ^ name + | true, _ -> + name ^ + " is never used to build values.\n\ + (However, this constructor appears in patterns.)" + | false, true -> + name ^ + " is never used to build values.\n\ + It is exported or rebound as a private extension." + end + | Unused_rec_flag -> + "unused rec flag." + | Name_out_of_scope (ty, [nm], false) -> + nm ^ " was selected from type " ^ ty ^ + ".\nIt is not visible in the current scope, and will not \n\ + be selected if the type becomes unknown." + | Name_out_of_scope (_, _, false) -> assert false + | Name_out_of_scope (ty, slist, true) -> + "this record of type "^ ty ^" contains fields that are \n\ + not visible in the current scope: " + ^ String.concat " " slist ^ ".\n\ + They will not be selected if the type becomes unknown." + | Ambiguous_name ([s], tl, false) -> + s ^ " belongs to several types: " ^ String.concat " " tl ^ + "\nThe first one was selected. Please disambiguate if this is wrong." + | Ambiguous_name (_, _, false) -> assert false + | Ambiguous_name (_slist, tl, true) -> + "these field labels belong to several types: " ^ + String.concat " " tl ^ + "\nThe first one was selected. Please disambiguate if this is wrong." + | Disambiguated_name s -> + "this use of " ^ s ^ " relies on type-directed disambiguation,\n\ + it will not compile with OCaml 4.00 or earlier." + | Nonoptional_label s -> + "the label " ^ s ^ " is not optional." + | Open_shadow_identifier (kind, s) -> + Printf.sprintf + "this open statement shadows the %s identifier %s (which is later used)" + kind s + | Open_shadow_label_constructor (kind, s) -> + Printf.sprintf + "this open statement shadows the %s %s (which is later used)" + kind s + | Bad_env_variable (var, s) -> + Printf.sprintf "illegal environment variable %s : %s" var s + | Attribute_payload (a, s) -> + Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s + | Eliminated_optional_arguments sl -> + Printf.sprintf "implicit elimination of optional argument%s %s" + (if List.length sl = 1 then "" else "s") + (String.concat ", " sl) + | No_cmi_file(name, None) -> + "no cmi file was found in path for module " ^ name + | No_cmi_file(name, Some msg) -> + Printf.sprintf + "no valid cmi file was found in path for module %s. %s" + name msg + | Bad_docstring unattached -> + if unattached then "unattached documentation comment (ignored)" + else "ambiguous documentation comment" + | Expect_tailcall -> + Printf.sprintf "expected tailcall" + | Fragile_literal_pattern -> + Printf.sprintf + "Code should not depend on the actual values of\n\ + this constructor's arguments. They are only for information\n\ + and may change in future versions. (See manual section 8.5)" + | Unreachable_case -> + "this match case is unreachable.\n\ + Consider replacing it with a refutation case ' -> .'" + | Misplaced_attribute attr_name -> + Printf.sprintf "the %S attribute cannot appear in this context" attr_name + | Duplicated_attribute attr_name -> + Printf.sprintf "the %S attribute is used more than once on this \ + expression" + attr_name + | Inlining_impossible reason -> + Printf.sprintf "Cannot inline: %s" reason + | Ambiguous_pattern vars -> + let msg = + let vars = List.sort String.compare vars in + match vars with + | [] -> assert false + | [x] -> "variable " ^ x + | _::_ -> + "variables " ^ String.concat "," vars in + Printf.sprintf + "Ambiguous or-pattern variables under guard;\n\ + %s may match different arguments. (See manual section 8.5)" + msg + | No_cmx_file name -> + Printf.sprintf + "no cmx file was found in path for module %s, \ + and its interface was not compiled with -opaque" name + | Assignment_to_non_mutable_value -> + "A potential assignment to a non-mutable value was detected \n\ + in this source file. Such assignments may generate incorrect code \n\ + when using Flambda." + | Unused_module s -> "unused module " ^ s ^ "." + | Unboxable_type_in_prim_decl t -> + Printf.sprintf + "This primitive declaration uses type %s, which is unannotated and\n\ + unboxable. The representation of such types may change in future\n\ + versions. You should annotate the declaration of %s with [@@boxed]\n\ + or [@@unboxed]." t t + | Constraint_on_gadt -> + "Type constraints do not apply to GADT cases of variant types." + + + | Bs_unused_attribute s -> + "Unused BuckleScript attribute: " ^ s + | Bs_polymorphic_comparison -> + "polymorphic comparison introduced (maybe unsafe)" + | Bs_ffi_warning s -> + "BuckleScript FFI warning: " ^ s + | Bs_derive_warning s -> + "BuckleScript bs.deriving warning: " ^ s + +;; + +let sub_locs = function + | Deprecated (_, def, use) -> + [ + def, "Definition"; + use, "Expected signature"; + ] + | _ -> [] + +let nerrors = ref 0;; + +type reporting_information = + { number : int + ; message : string + ; is_error : bool + ; sub_locs : (loc * string) list; + } + +let report w = + match is_active w with + | false -> `Inactive + | true -> + if is_error w then incr nerrors; + `Active { number = number w; message = message w; is_error = is_error w; + sub_locs = sub_locs w; + } +;; + + +let super_report message w = + match is_active w with + | false -> `Inactive + | true -> + if is_error w then incr nerrors; + `Active { number = number w; message = message w; is_error = is_error w; + sub_locs = sub_locs w; + } +;; + +exception Errors;; + +let reset_fatal () = + nerrors := 0 + +let check_fatal () = + if !nerrors > 0 then begin + nerrors := 0; + raise Errors; + end; +;; + +let descriptions = + [ + 1, "Suspicious-looking start-of-comment mark."; + 2, "Suspicious-looking end-of-comment mark."; + 3, "Deprecated feature."; + 4, "Fragile pattern matching: matching that will remain complete even\n\ + \ if additional constructors are added to one of the variant types\n\ + \ matched."; + 5, "Partially applied function: expression whose result has function\n\ + \ type and is ignored."; + 6, "Label omitted in function application."; + 7, "Method overridden."; + 8, "Partial match: missing cases in pattern-matching."; + 9, "Missing fields in a record pattern."; + 10, "Expression on the left-hand side of a sequence that doesn't have \ + type\n\ + \ \"unit\" (and that is not a function, see warning number 5)."; + 11, "Redundant case in a pattern matching (unused match case)."; + 12, "Redundant sub-pattern in a pattern-matching."; + 13, "Instance variable overridden."; + 14, "Illegal backslash escape in a string constant."; + 15, "Private method made public implicitly."; + 16, "Unerasable optional argument."; + 17, "Undeclared virtual method."; + 18, "Non-principal type."; + 19, "Type without principality."; + 20, "Unused function argument."; + 21, "Non-returning statement."; + 22, "Preprocessor warning."; + 23, "Useless record \"with\" clause."; + 24, "Bad module name: the source file name is not a valid OCaml module \ + name."; + 25, "Deprecated: now part of warning 8."; + 26, "Suspicious unused variable: unused variable that is bound\n\ + \ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\ + \ character."; + 27, "Innocuous unused variable: unused variable that is not bound with\n\ + \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\ + \ character."; + 28, "Wildcard pattern given as argument to a constant constructor."; + 29, "Unescaped end-of-line in a string constant (non-portable code)."; + 30, "Two labels or constructors of the same name are defined in two\n\ + \ mutually recursive types."; + 31, "A module is linked twice in the same executable."; + 32, "Unused value declaration."; + 33, "Unused open statement."; + 34, "Unused type declaration."; + 35, "Unused for-loop index."; + 36, "Unused ancestor variable."; + 37, "Unused constructor."; + 38, "Unused extension constructor."; + 39, "Unused rec flag."; + 40, "Constructor or label name used out of scope."; + 41, "Ambiguous constructor or label name."; + 42, "Disambiguated constructor or label name (compatibility warning)."; + 43, "Nonoptional label applied as optional."; + 44, "Open statement shadows an already defined identifier."; + 45, "Open statement shadows an already defined label or constructor."; + 46, "Error in environment variable."; + 47, "Illegal attribute payload."; + 48, "Implicit elimination of optional arguments."; + 49, "Absent cmi file when looking up module alias."; + 50, "Unexpected documentation comment."; + 51, "Warning on non-tail calls if @tailcall present."; + 52, "Fragile constant pattern."; + 53, "Attribute cannot appear in this context"; + 54, "Attribute used more than once on an expression"; + 55, "Inlining impossible"; + 56, "Unreachable case in a pattern-matching (based on type information)."; + 57, "Ambiguous or-pattern variables under guard"; + 58, "Missing cmx file"; + 59, "Assignment to non-mutable value"; + 60, "Unused module declaration"; + 61, "Unboxable type in primitive declaration"; + 62, "Type constraint on GADT type declaration"; + + + 101, "Unused bs attributes"; + 102, "polymorphic comparison introduced (maybe unsafe)"; + 103, "BuckleScript FFI warning: " ; + 104, "BuckleScript bs.deriving warning: " + + ] +;; + +let help_warnings () = + List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions; + print_endline " A all warnings"; + for i = Char.code 'b' to Char.code 'z' do + let c = Char.chr i in + match letter c with + | [] -> () + | [n] -> + Printf.printf " %c Alias for warning %i.\n" (Char.uppercase_ascii c) n + | l -> + Printf.printf " %c warnings %s.\n" + (Char.uppercase_ascii c) + (String.concat ", " (List.map string_of_int l)) + done; + exit 0 +;; + +end +module Location : sig +#1 "location.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Source code locations (ranges of positions), used in parsetree. *) + +open Format + +type t = Warnings.loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +(** Note on the use of Lexing.position in this module. + If [pos_fname = ""], then use [!input_name] instead. + If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and + re-parse the file to get the line and character numbers. + Else all fields are correct. +*) + +val none : t +(** An arbitrary value of type [t]; describes an empty ghost range. *) + +val in_file : string -> t +(** Return an empty ghost range located in a given file. *) + +val init : Lexing.lexbuf -> string -> unit +(** Set the file name and line number of the [lexbuf] to be the start + of the named file. *) + +val curr : Lexing.lexbuf -> t +(** Get the location of the current token from the [lexbuf]. *) + +val symbol_rloc: unit -> t +val symbol_gloc: unit -> t + +(** [rhs_loc n] returns the location of the symbol at position [n], starting + at 1, in the current parser rule. *) +val rhs_loc: int -> t + +val input_name: string ref +val input_lexbuf: Lexing.lexbuf option ref + +val get_pos_info: Lexing.position -> string * int * int (* file, line, char *) +val print_loc: formatter -> t -> unit +val print_error: formatter -> t -> unit +val print_error_cur_file: formatter -> unit -> unit +val print_warning: t -> formatter -> Warnings.t -> unit +val formatter_for_warnings : formatter ref +val prerr_warning: t -> Warnings.t -> unit +val echo_eof: unit -> unit +val reset: unit -> unit + +val default_printer : formatter -> t -> unit +val printer : (formatter -> t -> unit) ref + +val warning_printer : (t -> formatter -> Warnings.t -> unit) ref +(** Hook for intercepting warnings. *) + +val default_warning_printer : t -> formatter -> Warnings.t -> unit +(** Original warning printer for use in hooks. *) + +val highlight_locations: formatter -> t list -> bool + +type 'a loc = { + txt : 'a; + loc : t; +} + +val mknoloc : 'a -> 'a loc +val mkloc : 'a -> t -> 'a loc + +val print: formatter -> t -> unit +val print_compact: formatter -> t -> unit +val print_filename: formatter -> string -> unit + +val absolute_path: string -> string + +val show_filename: string -> string + (** In -absname mode, return the absolute path for this filename. + Otherwise, returns the filename unchanged. *) + + +val absname: bool ref + +(** Support for located errors *) + +type error = + { + loc: t; + msg: string; + sub: error list; + if_highlight: string; (* alternative message if locations are highlighted *) + } + +exception Already_displayed_error +exception Error of error + +val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error + + +val print_error_prefix : Format.formatter -> unit +val pp_ksprintf : ?before:(formatter -> unit) -> (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b + + +val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + +val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, 'b) format4 -> 'a + +val error_of_printer: t -> (formatter -> 'a -> unit) -> 'a -> error + +val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error + +val error_of_exn: exn -> [ `Ok of error | `Already_displayed ] option + +val register_error_of_exn: (exn -> error option) -> unit +(** Each compiler module which defines a custom type of exception + which can surface as a user-visible error should register + a "printer" for this exception using [register_error_of_exn]. + The result of the printer is an [error] value containing + a location, a message, and optionally sub-messages (each of them + being located as well). *) + +val report_error: formatter -> error -> unit + +val error_reporter : (formatter -> error -> unit) ref +(** Hook for intercepting error reports. *) + +val default_error_reporter : formatter -> error -> unit +(** Original error reporter for use in hooks. *) + +val report_exception: formatter -> exn -> unit +(** Reraise the exception if it is unknown. *) + +val deprecated: ?def:t -> ?use:t -> t -> string -> unit + +end = struct +#1 "location.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Lexing + +let absname = ref false + (* This reference should be in Clflags, but it would create an additional + dependency and make bootstrapping Camlp4 more difficult. *) + +type t = Warnings.loc = { loc_start: position; loc_end: position; loc_ghost: bool };; + +let in_file name = + let loc = { + pos_fname = name; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = -1; + } in + { loc_start = loc; loc_end = loc; loc_ghost = true } +;; + +let none = in_file "_none_";; + +let curr lexbuf = { + loc_start = lexbuf.lex_start_p; + loc_end = lexbuf.lex_curr_p; + loc_ghost = false +};; + +let init lexbuf fname = + lexbuf.lex_curr_p <- { + pos_fname = fname; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0; + } +;; + +let symbol_rloc () = { + loc_start = Parsing.symbol_start_pos (); + loc_end = Parsing.symbol_end_pos (); + loc_ghost = false; +};; + +let symbol_gloc () = { + loc_start = Parsing.symbol_start_pos (); + loc_end = Parsing.symbol_end_pos (); + loc_ghost = true; +};; + +let rhs_loc n = { + loc_start = Parsing.rhs_start_pos n; + loc_end = Parsing.rhs_end_pos n; + loc_ghost = false; +};; + +let input_name = ref "_none_" +let input_lexbuf = ref (None : lexbuf option) + +(* Terminal info *) + +let status = ref Terminfo.Uninitialised + +let num_loc_lines = ref 0 (* number of lines already printed after input *) + +let print_updating_num_loc_lines ppf f arg = + let open Format in + let out_functions = pp_get_formatter_out_functions ppf () in + let out_string str start len = + let rec count i c = + if i = start + len then c + else if String.get str i = '\n' then count (succ i) (succ c) + else count (succ i) c in + num_loc_lines := !num_loc_lines + count start 0 ; + out_functions.out_string str start len in + pp_set_formatter_out_functions ppf + { out_functions with out_string } ; + f ppf arg ; + pp_print_flush ppf (); + pp_set_formatter_out_functions ppf out_functions + +(* Highlight the locations using standout mode. *) + +let highlight_terminfo ppf num_lines lb locs = + Format.pp_print_flush ppf (); (* avoid mixing Format and normal output *) + (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *) + let pos0 = -lb.lex_abs_pos in + (* Do nothing if the buffer does not contain the whole phrase. *) + if pos0 < 0 then raise Exit; + (* Count number of lines in phrase *) + let lines = ref !num_loc_lines in + for i = pos0 to lb.lex_buffer_len - 1 do + if Bytes.get lb.lex_buffer i = '\n' then incr lines + done; + (* If too many lines, give up *) + if !lines >= num_lines - 2 then raise Exit; + (* Move cursor up that number of lines *) + flush stdout; Terminfo.backup !lines; + (* Print the input, switching to standout for the location *) + let bol = ref false in + print_string "# "; + for pos = 0 to lb.lex_buffer_len - pos0 - 1 do + if !bol then (print_string " "; bol := false); + if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then + Terminfo.standout true; + if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then + Terminfo.standout false; + let c = Bytes.get lb.lex_buffer (pos + pos0) in + print_char c; + bol := (c = '\n') + done; + (* Make sure standout mode is over *) + Terminfo.standout false; + (* Position cursor back to original location *) + Terminfo.resume !num_loc_lines; + flush stdout + +(* Highlight the location by printing it again. *) + +let highlight_dumb ppf lb loc = + (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *) + let pos0 = -lb.lex_abs_pos in + (* Do nothing if the buffer does not contain the whole phrase. *) + if pos0 < 0 then raise Exit; + let end_pos = lb.lex_buffer_len - pos0 - 1 in + (* Determine line numbers for the start and end points *) + let line_start = ref 0 and line_end = ref 0 in + for pos = 0 to end_pos do + if Bytes.get lb.lex_buffer (pos + pos0) = '\n' then begin + if loc.loc_start.pos_cnum > pos then incr line_start; + if loc.loc_end.pos_cnum > pos then incr line_end; + end + done; + (* Print character location (useful for Emacs) *) + Format.fprintf ppf "@[Characters %i-%i:@," + loc.loc_start.pos_cnum loc.loc_end.pos_cnum; + (* Print the input, underlining the location *) + Format.pp_print_string ppf " "; + let line = ref 0 in + let pos_at_bol = ref 0 in + for pos = 0 to end_pos do + match Bytes.get lb.lex_buffer (pos + pos0) with + | '\n' -> + if !line = !line_start && !line = !line_end then begin + (* loc is on one line: underline location *) + Format.fprintf ppf "@, "; + for _i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do + Format.pp_print_char ppf ' ' + done; + for _i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do + Format.pp_print_char ppf '^' + done + end; + if !line >= !line_start && !line <= !line_end then begin + Format.fprintf ppf "@,"; + if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf " " + end; + incr line; + pos_at_bol := pos + 1 + | '\r' -> () (* discard *) + | c -> + if !line = !line_start && !line = !line_end then + (* loc is on one line: print whole line *) + Format.pp_print_char ppf c + else if !line = !line_start then + (* first line of multiline loc: + print a dot for each char before loc_start *) + if pos < loc.loc_start.pos_cnum then + Format.pp_print_char ppf '.' + else + Format.pp_print_char ppf c + else if !line = !line_end then + (* last line of multiline loc: print a dot for each char + after loc_end, even whitespaces *) + if pos < loc.loc_end.pos_cnum then + Format.pp_print_char ppf c + else + Format.pp_print_char ppf '.' + else if !line > !line_start && !line < !line_end then + (* intermediate line of multiline loc: print whole line *) + Format.pp_print_char ppf c + done; + Format.fprintf ppf "@]" + +(* Highlight the location using one of the supported modes. *) + +let rec highlight_locations ppf locs = + match !status with + Terminfo.Uninitialised -> + status := Terminfo.setup stdout; highlight_locations ppf locs + | Terminfo.Bad_term -> + begin match !input_lexbuf with + None -> false + | Some lb -> + let norepeat = + try Sys.getenv "TERM" = "norepeat" with Not_found -> false in + if norepeat then false else + let loc1 = List.hd locs in + try highlight_dumb ppf lb loc1; true + with Exit -> false + end + | Terminfo.Good_term num_lines -> + begin match !input_lexbuf with + None -> false + | Some lb -> + try highlight_terminfo ppf num_lines lb locs; true + with Exit -> false + end + +(* Print the location in some way or another *) + +open Format + +let absolute_path s = (* This function could go into Filename *) + let open Filename in + let s = if is_relative s then concat (Sys.getcwd ()) s else s in + (* Now simplify . and .. components *) + let rec aux s = + let base = basename s in + let dir = dirname s in + if dir = s then dir + else if base = current_dir_name then aux dir + else if base = parent_dir_name then dirname (aux dir) + else concat (aux dir) base + in + aux s + +let show_filename file = + if !absname then absolute_path file else file + +let print_filename ppf file = + Format.fprintf ppf "%s" (show_filename file) + +let reset () = + num_loc_lines := 0 + +let (msg_file, msg_line, msg_chars, msg_to, msg_colon) = + ("File \"", "\", line ", ", characters ", "-", ":") + +(* return file, line, char from the given position *) +let get_pos_info pos = + (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol) +;; + +let setup_colors () = + Misc.Color.setup !Clflags.color + +let print_loc ppf loc = + setup_colors (); + let (file, line, startchar) = get_pos_info loc.loc_start in + + let startchar = + if Clflags.bs_vscode then startchar + 1 else startchar in + + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + if file = "//toplevel//" then begin + if highlight_locations ppf [loc] then () else + fprintf ppf "Characters %i-%i" + loc.loc_start.pos_cnum loc.loc_end.pos_cnum + end else begin + fprintf ppf "%s@{%a%s%i" msg_file print_filename file msg_line line; + if startchar >= 0 then + fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar; + fprintf ppf "@}" + end +;; + +let default_printer ppf loc = + setup_colors (); + if loc.loc_start.pos_fname = "//toplevel//" + && highlight_locations ppf [loc] then () + else fprintf ppf "@{%a@}%s@," print_loc loc msg_colon +;; + +let printer = ref default_printer +let print ppf loc = !printer ppf loc + +let error_prefix = "Error" +let warning_prefix = "Warning" + +let print_error_prefix ppf = + setup_colors (); + fprintf ppf "@{%s@}" error_prefix; +;; + +let print_compact ppf loc = + if loc.loc_start.pos_fname = "//toplevel//" + && highlight_locations ppf [loc] then () + else begin + let (file, line, startchar) = get_pos_info loc.loc_start in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + fprintf ppf "%a:%i" print_filename file line; + if startchar >= 0 then fprintf ppf ",%i--%i" startchar endchar + end +;; + +let print_error ppf loc = + fprintf ppf "%a%t:" print loc print_error_prefix; +;; + +let print_error_cur_file ppf () = print_error ppf (in_file !input_name);; + +let default_warning_printer loc ppf w = + match Warnings.report w with + | `Inactive -> () + | `Active { Warnings. number; message; is_error; sub_locs } -> + setup_colors (); + fprintf ppf "@["; + print ppf loc; + if is_error + then + fprintf ppf "%t (%s %d): %s@," print_error_prefix + (String.uncapitalize_ascii warning_prefix) number message + else fprintf ppf "@{%s@} %d: %s@," warning_prefix number message; + List.iter + (fun (loc, msg) -> + if loc <> none then fprintf ppf " %a %s@," print loc msg + ) + sub_locs; + fprintf ppf "@]" +;; + +let warning_printer = ref default_warning_printer ;; + +let print_warning loc ppf w = + print_updating_num_loc_lines ppf (!warning_printer loc) w +;; + +let formatter_for_warnings = ref err_formatter;; +let prerr_warning loc w = print_warning loc !formatter_for_warnings w;; + +let echo_eof () = + print_newline (); + incr num_loc_lines + +type 'a loc = { + txt : 'a; + loc : t; +} + +let mkloc txt loc = { txt ; loc } +let mknoloc txt = mkloc txt none + + +type error = + { + loc: t; + msg: string; + sub: error list; + if_highlight: string; (* alternative message if locations are highlighted *) + } + +let pp_ksprintf ?before k fmt = + let buf = Buffer.create 64 in + let ppf = Format.formatter_of_buffer buf in + Misc.Color.set_color_tag_handling ppf; + begin match before with + | None -> () + | Some f -> f ppf + end; + kfprintf + (fun _ -> + pp_print_flush ppf (); + let msg = Buffer.contents buf in + k msg) + ppf fmt + +(* Shift the formatter's offset by the length of the error prefix, which + is always added by the compiler after the message has been formatted *) +let print_phanton_error_prefix ppf = + Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" + +let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = + pp_ksprintf + ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let error ?(loc = none) ?(sub = []) ?(if_highlight = "") msg = + {loc; msg; sub; if_highlight} + +let error_of_exn : (exn -> error option) list ref = ref [] + +let register_error_of_exn f = error_of_exn := f :: !error_of_exn + +exception Already_displayed_error = Warnings.Errors + +let error_of_exn exn = + match exn with + | Already_displayed_error -> Some `Already_displayed + | _ -> + let rec loop = function + | [] -> None + | f :: rest -> + match f exn with + | Some error -> Some (`Ok error) + | None -> loop rest + in + loop !error_of_exn + +let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = + let highlighted = + if if_highlight <> "" && loc.loc_start.pos_fname = "//toplevel//" then + let rec collect_locs locs {loc; sub; _} = + List.fold_left collect_locs (loc :: locs) sub + in + let locs = collect_locs [] err in + highlight_locations ppf locs + else + false + in + if highlighted then + Format.pp_print_string ppf if_highlight + else begin + fprintf ppf "@[%a %s" print_error loc msg; + List.iter (Format.fprintf ppf "@,@[<2>%a@]" default_error_reporter) sub; + fprintf ppf "@]" + end + +let error_reporter = ref default_error_reporter + +let report_error ppf err = + print_updating_num_loc_lines ppf !error_reporter err +;; + +let error_of_printer loc print x = + errorf ~loc "%a@?" print x + +let error_of_printer_file print x = + error_of_printer (in_file !input_name) print x + +let () = + register_error_of_exn + (function + | Sys_error msg -> + Some (errorf ~loc:(in_file !input_name) + "I/O error: %s" msg) + + | Misc.HookExnWrapper {error = e; hook_name; + hook_info={Misc.sourcefile}} -> + let sub = match error_of_exn e with + | None | Some `Already_displayed -> error (Printexc.to_string e) + | Some (`Ok err) -> err + in + Some + (errorf ~loc:(in_file sourcefile) + "In hook %S:" hook_name + ~sub:[sub]) + | _ -> None + ) + +external reraise : exn -> 'a = "%reraise" + +let rec report_exception_rec n ppf exn = + try + match error_of_exn exn with + | None -> reraise exn + | Some `Already_displayed -> () + | Some (`Ok err) -> fprintf ppf "@[%a@]@." report_error err + with exn when n > 0 -> report_exception_rec (n-1) ppf exn + +let report_exception ppf exn = report_exception_rec 5 ppf exn + + +exception Error of error + +let () = + register_error_of_exn + (function + | Error e -> Some e + | _ -> None + ) + +let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = + pp_ksprintf + ~before:print_phanton_error_prefix + (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + +let deprecated ?(def = none) ?(use = none) loc msg = + prerr_warning loc (Warnings.Deprecated (msg, def, use)) + +end +module Bs_exception : sig +#1 "bs_exception.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. *) + +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string +(* +TODO: In the futrue, we should refine dependency [bsb] +should not rely on such exception, it should have its own exception handling +*) + +(* exception Error of error *) + +(* val report_error : Format.formatter -> error -> unit *) + +val error : error -> 'a + +end = struct +#1 "bs_exception.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. *) + + +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 *) + | Bs_package_not_found of string + | Bs_main_not_exist of string + | Bs_invalid_path of string + | Missing_ml_dependency of string + | Dependency_script_module_dependent_not of string + (** TODO: we need add location handling *) +exception Error of error + +let error err = raise (Error err) + +let report_error ppf = function + | Dependency_script_module_dependent_not s + -> + Format.fprintf ppf + "%s is compiled in script mode while its dependent is not" + s + | Missing_ml_dependency s -> + Format.fprintf ppf "Missing dependency %s in search path" s + | Cmj_not_found s -> + Format.fprintf ppf "%s not found, it means either the module does not exist or it is a namespace" 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@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_space + Format.pp_print_string) + str + | Bs_duplicate_exports str -> + Format.fprintf ppf "%s are exported as twice" str + | Bs_duplicated_module (a,b) + -> + Format.fprintf ppf "The build system does not support two files with same names yet %s, %s" a b + | Bs_main_not_exist main + -> + Format.fprintf ppf "File %s not found " main + + | Bs_package_not_found package + -> + Format.fprintf ppf "Package %s not found or %s/lib/ocaml does not exist or please set npm_config_prefix correctly" + package package + | Bs_invalid_path path + -> Format.pp_print_string ppf ("Invalid path: " ^ path ) + + +let () = + Location.register_error_of_exn + (function + | Error err + -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) + +end +(** Interface as module *) +module Asttypes += struct +#1 "asttypes.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Auxiliary AST types used by parsetree and typedtree. *) + +type constant = + Const_int of int + | Const_char of char + | Const_string of string * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + +type rec_flag = Nonrecursive | Recursive + +type direction_flag = Upto | Downto + +(* Order matters, used in polymorphic comparison *) +type private_flag = Private | Public + +type mutable_flag = Immutable | Mutable + +type virtual_flag = Virtual | Concrete + +type override_flag = Override | Fresh + +type closed_flag = Closed | Open + +type label = string + +type arg_label = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) + +type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; +} + + +type variance = + | Covariant + | Contravariant + | Invariant + +end +module Longident : sig +#1 "longident.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Long identifiers, used in parsetree. *) + +type t = + Lident of string + | Ldot of t * string + | Lapply of t * t + +val flatten: t -> string list +val unflatten: string list -> t option +val last: t -> string +val parse: string -> t + +end = struct +#1 "longident.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type t = + Lident of string + | Ldot of t * string + | Lapply of t * t + +let rec flat accu = function + Lident s -> s :: accu + | Ldot(lid, s) -> flat (s :: accu) lid + | Lapply(_, _) -> Misc.fatal_error "Longident.flat" + +let flatten lid = flat [] lid + +let last = function + Lident s -> s + | Ldot(_, s) -> s + | Lapply(_, _) -> Misc.fatal_error "Longident.last" + +let rec split_at_dots s pos = + try + let dot = String.index_from s pos '.' in + String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) + with Not_found -> + [String.sub s pos (String.length s - pos)] + +let unflatten l = + match l with + | [] -> None + | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl) + +let parse s = + match unflatten (split_at_dots s 0) with + | None -> Lident "" (* should not happen, but don't put assert false + so as not to crash the toplevel (see Genprintval) *) + | Some v -> v + +end +(** Interface as module *) +module Parsetree += struct +#1 "parsetree.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Abstract syntax tree produced by parsing *) + +open Asttypes + +type constant = + Pconst_integer of string * char option + (* 3 3l 3L 3n + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes except 'l', 'L' and 'n' are rejected by the typechecker + *) + | Pconst_char of char + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + +(** {1 Extension points} *) + +type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + +and extension = string loc * payload + (* [%id ARG] + [%%id ARG] + + Sub-language placeholder -- rejected by the typechecker. + *) + +and attributes = attribute list + +and payload = + | PStr of structure + | PSig of signature (* : SIG *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + +(** {1 Core language} *) + +(* Type expressions *) + +and core_type = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and core_type_desc = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string loc list * core_type + (* 'a1 ... 'an. T + + Can only appear in the following context: + + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + +and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + +and row_field = + | Rtag of label loc * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd field is true if the tag contains a + constant (empty) constructor. + - '&' occurs when several types are used for the same constructor + (see 4.2 in the manual) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + +and object_field = + | Otag of label loc * attributes * core_type + | Oinherit of core_type + +(* Patterns *) + +and pattern = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and pattern_desc = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + +(* Value expressions *) + +and expression = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and expression_desc = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (Some E0) + + Invariant: n > 0 + *) + | Pexp_field of expression * Longident.t loc + (* E.l *) + | Pexp_setfield of expression * Longident.t loc * expression + (* E1.l <- E2 *) + | Pexp_array of expression list + (* [| E1; ...; En |] *) + | Pexp_ifthenelse of expression * expression * expression option + (* if E1 then E2 else E3 *) + | Pexp_sequence of expression * expression + (* E1; E2 *) + | Pexp_while of expression * expression + (* while E1 do E2 done *) + | Pexp_for of + pattern * expression * expression * direction_flag * expression + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * label loc + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of label loc * expression + (* x <- 2 *) + | Pexp_override of (label loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string loc * module_expr * expression + (* let module M = ME in E *) + | Pexp_letexception of extension_constructor * expression + (* let exception C in E *) + | Pexp_assert of expression + (* assert E + Note: "assert false" is treated in a special way by the + type-checker. *) + | Pexp_lazy of expression + (* lazy E *) + | Pexp_poly of expression * core_type option + (* Used for method bodies. + + Can only be used as the expression under Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + +and case = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + +(* Value descriptions *) + +and value_description = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (* ... [@@id1] [@@id2] *) + pval_loc: Location.t; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) +*) + +(* Type declarations *) + +and type_declaration = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) +*) + +and type_kind = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty list *) + | Ptype_record of label_declaration list + (* Invariant: non-empty list *) + | Ptype_open + +and label_declaration = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: Location.t; + pld_attributes: attributes; (* l : T [@id1] [@id2] *) + } + +(* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. +*) + +and constructor_declaration = + { + pcd_name: string loc; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) + } + +and constructor_arguments = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) +*) + +and type_extension = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + type t += ... +*) + +and extension_constructor = + { + pext_name: string loc; + pext_kind : extension_constructor_kind; + pext_loc : Location.t; + pext_attributes: attributes; (* C of ... [@id1] [@id2] *) + } + +and extension_constructor_kind = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + +(** {1 Class language} *) + +(* Type expressions for the class language *) + +and class_type = + { + pcty_desc: class_type_desc; + pcty_loc: Location.t; + pcty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_type_desc = + | Pcty_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcty_signature of class_signature + (* object ... end *) + | Pcty_arrow of arg_label * core_type * class_type + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + | Pcty_open of override_flag * Longident.t loc * class_type + (* let open M in CT *) + +and class_signature = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } +(* object('selfpat) ... end + object ... end (self = Ptyp_any) + *) + +and class_type_field = + { + pctf_desc: class_type_field_desc; + pctf_loc: Location.t; + pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_type_field_desc = + | Pctf_inherit of class_type + (* inherit CT *) + | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (label loc * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a Ptyp_poly. + *) + | Pctf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pctf_attribute of attribute + (* [@@@id] *) + | Pctf_extension of extension + (* [%%id] *) + +and 'a class_infos = + { + pci_virt: virtual_flag; + pci_params: (core_type * variance) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. +*) + +and class_description = class_type class_infos + +and class_type_declaration = class_type class_infos + +(* Value expressions for the class language *) + +and class_expr = + { + pcl_desc: class_expr_desc; + pcl_loc: Location.t; + pcl_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_expr_desc = + | Pcl_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* CE ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + | Pcl_open of override_flag * Longident.t loc * class_expr + (* let open M in CE *) + + +and class_structure = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } +(* object(selfpat) ... end + object ... end (self = Ppat_any) + *) + +and class_field = + { + pcf_desc: class_field_desc; + pcf_loc: Location.t; + pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_field_desc = + | Pcf_inherit of override_flag * class_expr * string loc option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a Ptyp_poly) + *) + | Pcf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pcf_initializer of expression + (* initializer E *) + | Pcf_attribute of attribute + (* [@@@id] *) + | Pcf_extension of extension + (* [%%id] *) + +and class_field_kind = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + +and class_declaration = class_expr class_infos + +(** {1 Module language} *) + +(* Type expressions for the module language *) + +and module_type = + { + pmty_desc: module_type_desc; + pmty_loc: Location.t; + pmty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_type_desc = + | Pmty_ident of Longident.t loc + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * module_type + (* functor(X : MT1) -> MT2 *) + | Pmty_with of module_type * with_constraint list + (* MT with ... *) + | Pmty_typeof of module_expr + (* module type of ME *) + | Pmty_extension of extension + (* [%id] *) + | Pmty_alias of Longident.t loc + (* (module M) *) + +and signature = signature_item list + +and signature_item = + { + psig_desc: signature_item_desc; + psig_loc: Location.t; + } + +and signature_item_desc = + | Psig_value of value_description + (* + val x: T + external x: T = "s1" ... "sn" + *) + | Psig_type of rec_flag * type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Psig_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + module type S *) + | Psig_open of open_description + (* open X *) + | Psig_include of include_description + (* include MT *) + | Psig_class of class_description list + (* class c1 : ... and ... and cn : ... *) + | Psig_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Psig_attribute of attribute + (* [@@@id] *) + | Psig_extension of extension * attributes + (* [%%id] *) + +and module_declaration = + { + pmd_name: string loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } +(* S : MT *) + +and module_type_declaration = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmtd_loc: Location.t; + } +(* S = MT + S (abstract module type declaration, pmtd_type = None) +*) + +and open_description = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } +(* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + +and 'a include_infos = + { + pincl_mod: 'a; + pincl_loc: Location.t; + pincl_attributes: attributes; + } + +and include_description = module_type include_infos +(* include MT *) + +and include_declaration = module_expr include_infos +(* include ME *) + +and with_constraint = + | Pwith_type of Longident.t loc * type_declaration + (* with type X.t = ... + + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (* with module X.Y = Z *) + | Pwith_typesubst of Longident.t loc * type_declaration + (* with type X.t := ..., same format as [Pwith_type] *) + | Pwith_modsubst of Longident.t loc * Longident.t loc + (* with module X.Y := Z *) + +(* Value expressions for the module language *) + +and module_expr = + { + pmod_desc: module_expr_desc; + pmod_loc: Location.t; + pmod_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_expr_desc = + | Pmod_ident of Longident.t loc + (* X *) + | Pmod_structure of structure + (* struct ... end *) + | Pmod_functor of string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | Pmod_constraint of module_expr * module_type + (* (ME : MT) *) + | Pmod_unpack of expression + (* (val E) *) + | Pmod_extension of extension + (* [%id] *) + +and structure = structure_item list + +and structure_item = + { + pstr_desc: structure_item_desc; + pstr_loc: Location.t; + } + +and structure_item_desc = + | Pstr_eval of expression * attributes + (* E *) + | Pstr_value of rec_flag * value_binding list + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = Recursive) + *) + | Pstr_primitive of value_description + (* val x: T + external x: T = "s1" ... "sn" *) + | Pstr_type of rec_flag * type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Pstr_typext of type_extension + (* type t1 += ... *) + | Pstr_exception of extension_constructor + (* exception C of T + exception C = M.X *) + | Pstr_module of module_binding + (* module X = ME *) + | Pstr_recmodule of module_binding list + (* module rec X1 = ME1 and ... and Xn = MEn *) + | Pstr_modtype of module_type_declaration + (* module type S = MT *) + | Pstr_open of open_description + (* open X *) + | Pstr_class of class_declaration list + (* class c1 = ... and ... and cn = ... *) + | Pstr_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Pstr_include of include_declaration + (* include ME *) + | Pstr_attribute of attribute + (* [@@@id] *) + | Pstr_extension of extension * attributes + (* [%%id] *) + +and value_binding = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + +and module_binding = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } +(* X = ME *) + +(** {1 Toplevel} *) + +(* Toplevel phrases *) + +type toplevel_phrase = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + +and directive_argument = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + +end +module Builtin_attributes : sig +#1 "builtin_attributes.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Support for some of the builtin attributes: + + ocaml.deprecated + ocaml.error + ocaml.ppwarning + ocaml.warning + ocaml.warnerror + ocaml.explicit_arity (for camlp4/camlp5) + ocaml.warn_on_literal_pattern + ocaml.deprecated_mutable + ocaml.immediate + ocaml.boxed / ocaml.unboxed +*) + + +val check_deprecated: Location.t -> Parsetree.attributes -> string -> unit +val check_deprecated_inclusion: + def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes -> + Parsetree.attributes -> string -> unit +val deprecated_of_attrs: Parsetree.attributes -> string option +val deprecated_of_sig: Parsetree.signature -> string option +val deprecated_of_str: Parsetree.structure -> string option + +val check_deprecated_mutable: + Location.t -> Parsetree.attributes -> string -> unit +val check_deprecated_mutable_inclusion: + def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes -> + Parsetree.attributes -> string -> unit + +val error_of_extension: Parsetree.extension -> Location.error + +val warning_attribute: ?ppwarning:bool -> Parsetree.attribute -> unit + (** Apply warning settings from the specified attribute. + "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix) + are processed and other attributes are ignored. + + Also implement ocaml.ppwarning (unless ~ppwarning:false is + passed). + *) + +val warning_scope: + ?ppwarning:bool -> + Parsetree.attributes -> (unit -> 'a) -> 'a + (** Execute a function in a new scope for warning settings. This + means that the effect of any call to [warning_attribute] during + the execution of this function will be discarded after + execution. + + The function also takes a list of attributes which are processed + with [warning_attribute] in the fresh scope before the function + is executed. + *) + +val warn_on_literal_pattern: Parsetree.attributes -> bool +val explicit_arity: Parsetree.attributes -> bool + + +val immediate: Parsetree.attributes -> bool + +val has_unboxed: Parsetree.attributes -> bool +val has_boxed: Parsetree.attributes -> bool + +end = struct +#1 "builtin_attributes.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Asttypes +open Parsetree + +let string_of_cst = function + | Pconst_string(s, _) -> Some s + | _ -> None + +let string_of_payload = function + | PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] -> + string_of_cst c + | _ -> None + +let string_of_opt_payload p = + match string_of_payload p with + | Some s -> s + | None -> "" + +let rec error_of_extension ext = + match ext with + | ({txt = ("ocaml.error"|"error") as txt; loc}, p) -> + let rec sub_from inner = + match inner with + | {pstr_desc=Pstr_extension (ext, _)} :: rest -> + error_of_extension ext :: sub_from rest + | _ :: rest -> + (Location.errorf ~loc + "Invalid syntax for sub-error of extension '%s'." txt) :: + sub_from rest + | [] -> [] + in + begin match p with + | PStr [] -> raise Location.Already_displayed_error + | PStr({pstr_desc=Pstr_eval + ({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}:: + {pstr_desc=Pstr_eval + ({pexp_desc=Pexp_constant(Pconst_string(if_highlight,_))}, _)}:: + inner) -> + Location.error ~loc ~if_highlight ~sub:(sub_from inner) msg + | PStr({pstr_desc=Pstr_eval + ({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}::inner) -> + Location.error ~loc ~sub:(sub_from inner) msg + | _ -> Location.errorf ~loc "Invalid syntax for extension '%s'." txt + end + | ({txt; loc}, _) -> + Location.errorf ~loc "Uninterpreted extension '%s'." txt + +let cat s1 s2 = + if s2 = "" then s1 else + + if Clflags.bs_vscode then s1 ^ " " ^ s2 + else s1 ^ "\n" ^ s2 + + +let rec deprecated_of_attrs = function + | [] -> None + | ({txt = "ocaml.deprecated"|"deprecated"; _}, p) :: _ -> + Some (string_of_opt_payload p) + | _ :: tl -> deprecated_of_attrs tl + +let check_deprecated loc attrs s = + match deprecated_of_attrs attrs with + | None -> () + | Some txt -> Location.deprecated loc (cat s txt) + +let check_deprecated_inclusion ~def ~use loc attrs1 attrs2 s = + match deprecated_of_attrs attrs1, deprecated_of_attrs attrs2 with + | None, _ | Some _, Some _ -> () + | Some txt, None -> Location.deprecated ~def ~use loc (cat s txt) + +let rec deprecated_mutable_of_attrs = function + | [] -> None + | ({txt = "ocaml.deprecated_mutable"|"deprecated_mutable"; _}, p) :: _ -> + Some (string_of_opt_payload p) + | _ :: tl -> deprecated_mutable_of_attrs tl + +let check_deprecated_mutable loc attrs s = + match deprecated_mutable_of_attrs attrs with + | None -> () + | Some txt -> + Location.deprecated loc (Printf.sprintf "mutating field %s" (cat s txt)) + +let check_deprecated_mutable_inclusion ~def ~use loc attrs1 attrs2 s = + match deprecated_mutable_of_attrs attrs1, + deprecated_mutable_of_attrs attrs2 + with + | None, _ | Some _, Some _ -> () + | Some txt, None -> + Location.deprecated ~def ~use loc + (Printf.sprintf "mutating field %s" (cat s txt)) + +let rec deprecated_of_sig = function + | {psig_desc = Psig_attribute a} :: tl -> + begin match deprecated_of_attrs [a] with + | None -> deprecated_of_sig tl + | Some _ as r -> r + end + | _ -> None + + +let rec deprecated_of_str = function + | {pstr_desc = Pstr_attribute a} :: tl -> + begin match deprecated_of_attrs [a] with + | None -> deprecated_of_str tl + | Some _ as r -> r + end + | _ -> None + + +let warning_attribute ?(ppwarning = true) = + let process loc txt errflag payload = + match string_of_payload payload with + | Some s -> + begin try Warnings.parse_options errflag s + with Arg.Bad _ -> + Location.prerr_warning loc + (Warnings.Attribute_payload + (txt, "Ill-formed list of warnings")) + end + | None -> + Location.prerr_warning loc + (Warnings.Attribute_payload + (txt, "A single string literal is expected")) + in + function + | ({txt = ("ocaml.warning"|"warning") as txt; loc}, payload) -> + process loc txt false payload + | ({txt = ("ocaml.warnerror"|"warnerror") as txt; loc}, payload) -> + process loc txt true payload + | {txt="ocaml.ppwarning"|"ppwarning"}, + PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant + (Pconst_string (s, _))},_); + pstr_loc}] when ppwarning -> + Location.prerr_warning pstr_loc (Warnings.Preprocessor s) + | _ -> + () + +let warning_scope ?ppwarning attrs f = + let prev = Warnings.backup () in + try + List.iter (warning_attribute ?ppwarning) (List.rev attrs); + let ret = f () in + Warnings.restore prev; + ret + with exn -> + Warnings.restore prev; + raise exn + + +let warn_on_literal_pattern = + List.exists + (function + | ({txt="ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern"; _}, _) + -> true + | _ -> false + ) + +let explicit_arity = + List.exists + (function + | ({txt="ocaml.explicit_arity"|"explicit_arity"; _}, _) -> true + | _ -> false + ) + +let immediate = + List.exists + (function + | ({txt="ocaml.immediate"|"immediate"; _}, _) -> true + | _ -> false + ) + +(* The "ocaml.boxed (default)" and "ocaml.unboxed (default)" + attributes cannot be input by the user, they are added by the + compiler when applying the default setting. This is done to record + in the .cmi the default used by the compiler when compiling the + source file because the default can change between compiler + invocations. *) + +let check l (x, _) = List.mem x.txt l + +let has_unboxed attr = + List.exists (check ["ocaml.unboxed"; "unboxed"]) + attr + +let has_boxed attr = + List.exists (check ["ocaml.boxed"; "boxed"]) attr + +end +module Depend : sig +#1 "depend.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Module dependencies. *) + +module StringSet : Set.S with type elt = string +module StringMap : Map.S with type key = string + +type map_tree = Node of StringSet.t * bound_map +and bound_map = map_tree StringMap.t +val make_leaf : string -> map_tree +val make_node : bound_map -> map_tree +val weaken_map : StringSet.t -> map_tree -> map_tree + +val free_structure_names : StringSet.t ref + +(* dependencies found by preprocessing tools (plugins) *) +val pp_deps : string list ref + +val open_module : bound_map -> Longident.t -> bound_map + +val add_use_file : bound_map -> Parsetree.toplevel_phrase list -> unit + +val add_signature : bound_map -> Parsetree.signature -> unit + +val add_implementation : bound_map -> Parsetree.structure -> unit + +val add_implementation_binding : bound_map -> Parsetree.structure -> bound_map +val add_signature_binding : bound_map -> Parsetree.signature -> bound_map + +end = struct +#1 "depend.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Asttypes +open Location +open Longident +open Parsetree + +let pp_deps = ref [] + +module StringSet = Set.Make(struct type t = string let compare = compare end) +module StringMap = Map.Make(String) + +(* Module resolution map *) +(* Node (set of imports for this path, map for submodules) *) +type map_tree = Node of StringSet.t * bound_map +and bound_map = map_tree StringMap.t +let bound = Node (StringSet.empty, StringMap.empty) + +(*let get_free (Node (s, _m)) = s*) +let get_map (Node (_s, m)) = m +let make_leaf s = Node (StringSet.singleton s, StringMap.empty) +let make_node m = Node (StringSet.empty, m) +let rec weaken_map s (Node(s0,m0)) = + Node (StringSet.union s s0, StringMap.map (weaken_map s) m0) +let rec collect_free (Node (s, m)) = + StringMap.fold (fun _ n -> StringSet.union (collect_free n)) m s + +(* Returns the imports required to access the structure at path p *) +(* Only raises Not_found if the head of p is not in the toplevel map *) +let rec lookup_free p m = + match p with + [] -> raise Not_found + | s::p -> + let Node (f, m') = StringMap.find s m in + try lookup_free p m' with Not_found -> f + +(* Returns the node corresponding to the structure at path p *) +let rec lookup_map lid m = + match lid with + Lident s -> StringMap.find s m + | Ldot (l, s) -> StringMap.find s (get_map (lookup_map l m)) + | Lapply _ -> raise Not_found + +(* Collect free module identifiers in the a.s.t. *) + +let free_structure_names = ref StringSet.empty + +let add_names s = + free_structure_names := StringSet.union s !free_structure_names + +let rec add_path bv ?(p=[]) = function + | Lident s -> + let free = + try lookup_free (s::p) bv with Not_found -> StringSet.singleton s + in + (*StringSet.iter (fun s -> Printf.eprintf "%s " s) free; + prerr_endline "";*) + add_names free + | Ldot(l, s) -> add_path bv ~p:(s::p) l + | Lapply(l1, l2) -> add_path bv l1; add_path bv l2 + +let open_module bv lid = + match lookup_map lid bv with + | Node (s, m) -> + add_names s; + StringMap.fold StringMap.add m bv + | exception Not_found -> + add_path bv lid; bv + +let add_parent bv lid = + match lid.txt with + Ldot(l, _s) -> add_path bv l + | _ -> () + +let add = add_parent + +let addmodule bv lid = add_path bv lid.txt + +let handle_extension ext = + match (fst ext).txt with + | "error" | "ocaml.error" -> + raise (Location.Error + (Builtin_attributes.error_of_extension ext)) + | _ -> + () + +let rec add_type bv ty = + match ty.ptyp_desc with + Ptyp_any -> () + | Ptyp_var _ -> () + | Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2 + | Ptyp_tuple tl -> List.iter (add_type bv) tl + | Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl + | Ptyp_object (fl, _) -> + List.iter + (function Otag (_, _, t) -> add_type bv t + | Oinherit t -> add_type bv t) fl + | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl + | Ptyp_alias(t, _) -> add_type bv t + | Ptyp_variant(fl, _, _) -> + List.iter + (function Rtag(_,_,_,stl) -> List.iter (add_type bv) stl + | Rinherit sty -> add_type bv sty) + fl + | Ptyp_poly(_, t) -> add_type bv t + | Ptyp_package pt -> add_package_type bv pt + | Ptyp_extension e -> handle_extension e + +and add_package_type bv (lid, l) = + add bv lid; + List.iter (add_type bv) (List.map (fun (_, e) -> e) l) + +let add_opt add_fn bv = function + None -> () + | Some x -> add_fn bv x + +let add_constructor_arguments bv = function + | Pcstr_tuple l -> List.iter (add_type bv) l + | Pcstr_record l -> List.iter (fun l -> add_type bv l.pld_type) l + +let add_constructor_decl bv pcd = + add_constructor_arguments bv pcd.pcd_args; + Misc.may (add_type bv) pcd.pcd_res + +let add_type_declaration bv td = + List.iter + (fun (ty1, ty2, _) -> add_type bv ty1; add_type bv ty2) + td.ptype_cstrs; + add_opt add_type bv td.ptype_manifest; + let add_tkind = function + Ptype_abstract -> () + | Ptype_variant cstrs -> + List.iter (add_constructor_decl bv) cstrs + | Ptype_record lbls -> + List.iter (fun pld -> add_type bv pld.pld_type) lbls + | Ptype_open -> () in + add_tkind td.ptype_kind + +let add_extension_constructor bv ext = + match ext.pext_kind with + Pext_decl(args, rty) -> + add_constructor_arguments bv args; + Misc.may (add_type bv) rty + | Pext_rebind lid -> add bv lid + +let add_type_extension bv te = + add bv te.ptyext_path; + List.iter (add_extension_constructor bv) te.ptyext_constructors + +let rec add_class_type bv cty = + match cty.pcty_desc with + Pcty_constr(l, tyl) -> + add bv l; List.iter (add_type bv) tyl + | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } -> + add_type bv ty; + List.iter (add_class_type_field bv) fieldl + | Pcty_arrow(_, ty1, cty2) -> + add_type bv ty1; add_class_type bv cty2 + | Pcty_extension e -> handle_extension e + | Pcty_open (_ovf, m, e) -> + let bv = open_module bv m.txt in add_class_type bv e + +and add_class_type_field bv pctf = + match pctf.pctf_desc with + Pctf_inherit cty -> add_class_type bv cty + | Pctf_val(_, _, _, ty) -> add_type bv ty + | Pctf_method(_, _, _, ty) -> add_type bv ty + | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2 + | Pctf_attribute _ -> () + | Pctf_extension e -> handle_extension e + +let add_class_description bv infos = + add_class_type bv infos.pci_expr + +let add_class_type_declaration = add_class_description + +let pattern_bv = ref StringMap.empty + +let rec add_pattern bv pat = + match pat.ppat_desc with + Ppat_any -> () + | Ppat_var _ -> () + | Ppat_alias(p, _) -> add_pattern bv p + | Ppat_interval _ + | Ppat_constant _ -> () + | Ppat_tuple pl -> List.iter (add_pattern bv) pl + | Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op + | Ppat_record(pl, _) -> + List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl + | Ppat_array pl -> List.iter (add_pattern bv) pl + | Ppat_or(p1, p2) -> add_pattern bv p1; add_pattern bv p2 + | Ppat_constraint(p, ty) -> add_pattern bv p; add_type bv ty + | Ppat_variant(_, op) -> add_opt add_pattern bv op + | Ppat_type li -> add bv li + | Ppat_lazy p -> add_pattern bv p + | Ppat_unpack id -> pattern_bv := StringMap.add id.txt bound !pattern_bv + | Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p + | Ppat_exception p -> add_pattern bv p + | Ppat_extension e -> handle_extension e + +let add_pattern bv pat = + pattern_bv := bv; + add_pattern bv pat; + !pattern_bv + +let rec add_expr bv exp = + match exp.pexp_desc with + Pexp_ident l -> add bv l + | Pexp_constant _ -> () + | Pexp_let(rf, pel, e) -> + let bv = add_bindings rf bv pel in add_expr bv e + | Pexp_fun (_, opte, p, e) -> + add_opt add_expr bv opte; add_expr (add_pattern bv p) e + | Pexp_function pel -> + add_cases bv pel + | Pexp_apply(e, el) -> + add_expr bv e; List.iter (fun (_,e) -> add_expr bv e) el + | Pexp_match(e, pel) -> add_expr bv e; add_cases bv pel + | Pexp_try(e, pel) -> add_expr bv e; add_cases bv pel + | Pexp_tuple el -> List.iter (add_expr bv) el + | Pexp_construct(c, opte) -> add bv c; add_opt add_expr bv opte + | Pexp_variant(_, opte) -> add_opt add_expr bv opte + | Pexp_record(lblel, opte) -> + List.iter (fun (lbl, e) -> add bv lbl; add_expr bv e) lblel; + add_opt add_expr bv opte + | Pexp_field(e, fld) -> add_expr bv e; add bv fld + | Pexp_setfield(e1, fld, e2) -> add_expr bv e1; add bv fld; add_expr bv e2 + | Pexp_array el -> List.iter (add_expr bv) el + | Pexp_ifthenelse(e1, e2, opte3) -> + add_expr bv e1; add_expr bv e2; add_opt add_expr bv opte3 + | Pexp_sequence(e1, e2) -> add_expr bv e1; add_expr bv e2 + | Pexp_while(e1, e2) -> add_expr bv e1; add_expr bv e2 + | Pexp_for( _, e1, e2, _, e3) -> + add_expr bv e1; add_expr bv e2; add_expr bv e3 + | Pexp_coerce(e1, oty2, ty3) -> + add_expr bv e1; + add_opt add_type bv oty2; + add_type bv ty3 + | Pexp_constraint(e1, ty2) -> + add_expr bv e1; + add_type bv ty2 + | Pexp_send(e, _m) -> add_expr bv e + | Pexp_new li -> add bv li + | Pexp_setinstvar(_v, e) -> add_expr bv e + | Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel + | Pexp_letmodule(id, m, e) -> + let b = add_module_binding bv m in + add_expr (StringMap.add id.txt b bv) e + | Pexp_letexception(_, e) -> add_expr bv e + | Pexp_assert (e) -> add_expr bv e + | Pexp_lazy (e) -> add_expr bv e + | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t + | Pexp_object { pcstr_self = pat; pcstr_fields = fieldl } -> + let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl + | Pexp_newtype (_, e) -> add_expr bv e + | Pexp_pack m -> add_module bv m + | Pexp_open (_ovf, m, e) -> + let bv = open_module bv m.txt in add_expr bv e + | Pexp_extension (({ txt = ("ocaml.extension_constructor"| + "extension_constructor"); _ }, + PStr [item]) as e) -> + begin match item.pstr_desc with + | Pstr_eval ({ pexp_desc = Pexp_construct (c, None) }, _) -> add bv c + | _ -> handle_extension e + end + | Pexp_extension e -> handle_extension e + | Pexp_unreachable -> () + +and add_cases bv cases = + List.iter (add_case bv) cases + +and add_case bv {pc_lhs; pc_guard; pc_rhs} = + let bv = add_pattern bv pc_lhs in + add_opt add_expr bv pc_guard; + add_expr bv pc_rhs + +and add_bindings recf bv pel = + let bv' = List.fold_left (fun bv x -> add_pattern bv x.pvb_pat) bv pel in + let bv = if recf = Recursive then bv' else bv in + List.iter (fun x -> add_expr bv x.pvb_expr) pel; + bv' + +and add_modtype bv mty = + match mty.pmty_desc with + Pmty_ident l -> add bv l + | Pmty_alias l -> addmodule bv l + | Pmty_signature s -> add_signature bv s + | Pmty_functor(id, mty1, mty2) -> + Misc.may (add_modtype bv) mty1; + add_modtype (StringMap.add id.txt bound bv) mty2 + | Pmty_with(mty, cstrl) -> + add_modtype bv mty; + List.iter + (function + | Pwith_type (_, td) -> add_type_declaration bv td + | Pwith_module (_, lid) -> addmodule bv lid + | Pwith_typesubst (_, td) -> add_type_declaration bv td + | Pwith_modsubst (_, lid) -> addmodule bv lid + ) + cstrl + | Pmty_typeof m -> add_module bv m + | Pmty_extension e -> handle_extension e + +and add_module_alias bv l = + try + add_parent bv l; + lookup_map l.txt bv + with Not_found -> + match l.txt with + Lident s -> make_leaf s + | _ -> addmodule bv l; bound (* cannot delay *) + +and add_modtype_binding bv mty = + if not !Clflags.transparent_modules then add_modtype bv mty; + match mty.pmty_desc with + Pmty_alias l -> + add_module_alias bv l + | Pmty_signature s -> + make_node (add_signature_binding bv s) + | Pmty_typeof modl -> + add_module_binding bv modl + | _ -> + if !Clflags.transparent_modules then add_modtype bv mty; bound + +and add_signature bv sg = + ignore (add_signature_binding bv sg) + +and add_signature_binding bv sg = + snd (List.fold_left add_sig_item (bv, StringMap.empty) sg) + +and add_sig_item (bv, m) item = + match item.psig_desc with + Psig_value vd -> + add_type bv vd.pval_type; (bv, m) + | Psig_type (_, dcls) -> + List.iter (add_type_declaration bv) dcls; (bv, m) + | Psig_typext te -> + add_type_extension bv te; (bv, m) + | Psig_exception pext -> + add_extension_constructor bv pext; (bv, m) + | Psig_module pmd -> + let m' = add_modtype_binding bv pmd.pmd_type in + let add = StringMap.add pmd.pmd_name.txt m' in + (add bv, add m) + | Psig_recmodule decls -> + let add = + List.fold_right (fun pmd -> StringMap.add pmd.pmd_name.txt bound) + decls + in + let bv' = add bv and m' = add m in + List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls; + (bv', m') + | Psig_modtype x -> + begin match x.pmtd_type with + None -> () + | Some mty -> add_modtype bv mty + end; + (bv, m) + | Psig_open od -> + (open_module bv od.popen_lid.txt, m) + | Psig_include incl -> + let Node (s, m') = add_modtype_binding bv incl.pincl_mod in + add_names s; + let add = StringMap.fold StringMap.add m' in + (add bv, add m) + | Psig_class cdl -> + List.iter (add_class_description bv) cdl; (bv, m) + | Psig_class_type cdtl -> + List.iter (add_class_type_declaration bv) cdtl; (bv, m) + | Psig_attribute _ -> (bv, m) + | Psig_extension (e, _) -> + handle_extension e; + (bv, m) + +and add_module_binding bv modl = + if not !Clflags.transparent_modules then add_module bv modl; + match modl.pmod_desc with + Pmod_ident l -> + begin try + add_parent bv l; + lookup_map l.txt bv + with Not_found -> + match l.txt with + Lident s -> make_leaf s + | _ -> addmodule bv l; bound + end + | Pmod_structure s -> + make_node (snd (add_structure_binding bv s)) + | _ -> + if !Clflags.transparent_modules then add_module bv modl; bound + +and add_module bv modl = + match modl.pmod_desc with + Pmod_ident l -> addmodule bv l + | Pmod_structure s -> ignore (add_structure bv s) + | Pmod_functor(id, mty, modl) -> + Misc.may (add_modtype bv) mty; + add_module (StringMap.add id.txt bound bv) modl + | Pmod_apply(mod1, mod2) -> + add_module bv mod1; add_module bv mod2 + | Pmod_constraint(modl, mty) -> + add_module bv modl; add_modtype bv mty + | Pmod_unpack(e) -> + add_expr bv e + | Pmod_extension e -> + handle_extension e + +and add_structure bv item_list = + let (bv, m) = add_structure_binding bv item_list in + add_names (collect_free (make_node m)); + bv + +and add_structure_binding bv item_list = + List.fold_left add_struct_item (bv, StringMap.empty) item_list + +and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t = + match item.pstr_desc with + Pstr_eval (e, _attrs) -> + add_expr bv e; (bv, m) + | Pstr_value(rf, pel) -> + let bv = add_bindings rf bv pel in (bv, m) + | Pstr_primitive vd -> + add_type bv vd.pval_type; (bv, m) + | Pstr_type (_, dcls) -> + List.iter (add_type_declaration bv) dcls; (bv, m) + | Pstr_typext te -> + add_type_extension bv te; + (bv, m) + | Pstr_exception pext -> + add_extension_constructor bv pext; (bv, m) + | Pstr_module x -> + let b = add_module_binding bv x.pmb_expr in + let add = StringMap.add x.pmb_name.txt b in + (add bv, add m) + | Pstr_recmodule bindings -> + let add = + List.fold_right (fun x -> StringMap.add x.pmb_name.txt bound) bindings + in + let bv' = add bv and m = add m in + List.iter + (fun x -> add_module bv' x.pmb_expr) + bindings; + (bv', m) + | Pstr_modtype x -> + begin match x.pmtd_type with + None -> () + | Some mty -> add_modtype bv mty + end; + (bv, m) + | Pstr_open od -> + (open_module bv od.popen_lid.txt, m) + | Pstr_class cdl -> + List.iter (add_class_declaration bv) cdl; (bv, m) + | Pstr_class_type cdtl -> + List.iter (add_class_type_declaration bv) cdtl; (bv, m) + | Pstr_include incl -> + let Node (s, m') = add_module_binding bv incl.pincl_mod in + add_names s; + let add = StringMap.fold StringMap.add m' in + (add bv, add m) + | Pstr_attribute _ -> (bv, m) + | Pstr_extension (e, _) -> + handle_extension e; + (bv, m) + +and add_use_file bv top_phrs = + ignore (List.fold_left add_top_phrase bv top_phrs) + +and add_implementation bv l = + if !Clflags.transparent_modules then + ignore (add_structure_binding bv l) + else ignore (add_structure bv l) + +and add_implementation_binding bv l = + snd (add_structure_binding bv l) + +and add_top_phrase bv = function + | Ptop_def str -> add_structure bv str + | Ptop_dir (_, _) -> bv + +and add_class_expr bv ce = + match ce.pcl_desc with + Pcl_constr(l, tyl) -> + add bv l; List.iter (add_type bv) tyl + | Pcl_structure { pcstr_self = pat; pcstr_fields = fieldl } -> + let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl + | Pcl_fun(_, opte, pat, ce) -> + add_opt add_expr bv opte; + let bv = add_pattern bv pat in add_class_expr bv ce + | Pcl_apply(ce, exprl) -> + add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl + | Pcl_let(rf, pel, ce) -> + let bv = add_bindings rf bv pel in add_class_expr bv ce + | Pcl_constraint(ce, ct) -> + add_class_expr bv ce; add_class_type bv ct + | Pcl_extension e -> handle_extension e + | Pcl_open (_ovf, m, e) -> + let bv = open_module bv m.txt in add_class_expr bv e + +and add_class_field bv pcf = + match pcf.pcf_desc with + Pcf_inherit(_, ce, _) -> add_class_expr bv ce + | Pcf_val(_, _, Cfk_concrete (_, e)) + | Pcf_method(_, _, Cfk_concrete (_, e)) -> add_expr bv e + | Pcf_val(_, _, Cfk_virtual ty) + | Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty + | Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2 + | Pcf_initializer e -> add_expr bv e + | Pcf_attribute _ -> () + | Pcf_extension e -> handle_extension e + +and add_class_declaration bv decl = + add_class_expr bv decl.pci_expr + +end +module Ext_array : sig +#1 "ext_array.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. *) + + + + + + +(** Some utilities for {!Array} operations *) +val reverse_range : 'a array -> int -> int -> unit +val reverse_in_place : 'a array -> unit +val reverse : 'a array -> 'a array +val reverse_of_list : 'a list -> 'a array + +val filter : ('a -> bool) -> 'a array -> 'a array + +val filter_map : ('a -> 'b option) -> 'a array -> 'b array + +val range : int -> int -> int array + +val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array + +val to_list_f : ('a -> 'b) -> 'a array -> 'b list +val to_list_map : ('a -> 'b option) -> 'a array -> 'b list + +val to_list_map_acc : + 'a array -> + 'b list -> + ('a -> 'b option) -> + 'b list + +val of_list_map : + 'a list -> + ('a -> 'b) -> + 'b array + +val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int + + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] + +val rfind_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val find_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val exists : ('a -> bool) -> 'a array -> bool + +val is_empty : 'a array -> bool + +val for_all2_no_exn : + 'a array -> + 'b array -> + ('a -> 'b -> bool) -> + bool + +val map : + 'a array -> + ('a -> 'b) -> + 'b array + +val iter : + 'a array -> + ('a -> unit) -> + unit + +val fold_left : + 'b array -> + 'a -> + ('a -> 'b -> 'a) -> + 'a +end = struct +#1 "ext_array.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 reverse_range a i len = + if len = 0 then () + else + for k = 0 to (len-1)/2 do + let t = Array.unsafe_get a (i+k) in + Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k)); + Array.unsafe_set a (i+len-1-k) t; + done + + +let reverse_in_place a = + reverse_range a 0 (Array.length a) + +let reverse a = + let b_len = Array.length a in + if b_len = 0 then [||] else + let b = Array.copy a in + for i = 0 to b_len - 1 do + Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) + done; + b + +let reverse_of_list = function + | [] -> [||] + | hd::tl as l -> + let len = List.length l in + let a = Array.make len hd in + let rec fill i = function + | [] -> a + | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in + fill 0 tl + +let filter f a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + if f v then + aux (v::acc) (i+1) + else aux acc (i + 1) + in aux [] 0 + + +let filter_map (f : _ -> _ option) a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + match f v with + | Some v -> + aux (v::acc) (i+1) + | None -> + aux acc (i + 1) + in aux [] 0 + +let range from to_ = + if from > to_ then invalid_arg "Ext_array.range" + else Array.init (to_ - from + 1) (fun i -> i + from) + +let map2i f a b = + let len = Array.length a in + if len <> Array.length b then + invalid_arg "Ext_array.map2i" + else + Array.mapi (fun i a -> f i a ( Array.unsafe_get b i )) a + +let rec tolist_f_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_f_aux a f (i - 1) + (f v :: res) + +let to_list_f f a = tolist_f_aux a f (Array.length a - 1) [] + +let rec tolist_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_aux a f (i - 1) + (match f v with + | Some v -> v :: res + | None -> res) + +let to_list_map f a = + tolist_aux a f (Array.length a - 1) [] + +let to_list_map_acc a acc f = + tolist_aux a f (Array.length a - 1) acc + + +let of_list_map a f = + match a with + | [] -> [||] + | [a0] -> + let b0 = f a0 in + [|b0|] + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + [|b0;b1|] + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + [|b0;b1;b2|] + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + [|b0;b1;b2;b3|] + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + [|b0;b1;b2;b3;b4|] + + | a0::a1::a2::a3::a4::tl -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + let len = List.length tl + 5 in + let arr = Array.make len b0 in + Array.unsafe_set arr 1 b1 ; + Array.unsafe_set arr 2 b2 ; + Array.unsafe_set arr 3 b3 ; + Array.unsafe_set arr 4 b4 ; + let rec fill i = function + | [] -> arr + | hd :: tl -> + Array.unsafe_set arr i (f hd); + fill (i + 1) tl in + fill 5 tl + +(** + {[ + # rfind_with_index [|1;2;3|] (=) 2;; + - : int = 1 + # rfind_with_index [|1;2;3|] (=) 1;; + - : int = 0 + # rfind_with_index [|1;2;3|] (=) 3;; + - : int = 2 + # rfind_with_index [|1;2;3|] (=) 4;; + - : int = -1 + ]} +*) +let rfind_with_index arr cmp v = + let len = Array.length arr in + let rec aux i = + if i < 0 then i + else if cmp (Array.unsafe_get arr i) v then i + else aux (i - 1) in + aux (len - 1) + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] +let rfind_and_split arr cmp v : _ split = + let i = rfind_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i , Array.sub arr (i + 1 ) (Array.length arr - i - 1 )) + + +let find_with_index arr cmp v = + let len = Array.length arr in + let rec aux i len = + if i >= len then -1 + else if cmp (Array.unsafe_get arr i ) v then i + else aux (i + 1) len in + aux 0 len + +let find_and_split arr cmp v : _ split = + let i = find_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1)) + +(** TODO: available since 4.03, use {!Array.exists} *) + +let exists p a = + let n = Array.length a in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + + +let is_empty arr = + Array.length arr = 0 + + +let rec unsafe_loop index len p xs ys = + if index >= len then true + else + p + (Array.unsafe_get xs index) + (Array.unsafe_get ys index) && + unsafe_loop (succ index) len p xs ys + +let for_all2_no_exn xs ys p = + let len_xs = Array.length xs in + let len_ys = Array.length ys in + len_xs = len_ys && + unsafe_loop 0 len_xs p xs ys + + +let map a f = + let open Array in + let l = length a in + if l = 0 then [||] else begin + let r = make l (f(unsafe_get a 0)) in + for i = 1 to l - 1 do + unsafe_set r i (f(unsafe_get a i)) + done; + r + end + +let iter a f = + let open Array in + for i = 0 to length a - 1 do f(unsafe_get a i) done + + + let fold_left a x f = + let open Array in + let r = ref x in + for i = 0 to length a - 1 do + r := f !r (unsafe_get a i) + done; + !r + +end +module Ext_format : sig +#1 "ext_format.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. *) + + + + + + + + +(** Simplified wrapper module for the standard library [Format] module. + *) + +type t = private Format.formatter + +val string : t -> string -> unit + +val break : t -> unit + +val break1 : t -> unit + +val space : t -> unit + +val group : t -> int -> (unit -> 'a) -> 'a +(** [group] will record current indentation + and indent futher + *) + +val vgroup : t -> int -> (unit -> 'a) -> 'a + +val paren : t -> (unit -> 'a) -> 'a + +val paren_group : t -> int -> (unit -> 'a) -> 'a + +val brace_group : t -> int -> (unit -> 'a) -> 'a + +val brace_vgroup : t -> int -> (unit -> 'a) -> 'a + +val bracket_group : t -> int -> (unit -> 'a) -> 'a + +val newline : t -> unit + +val to_out_channel : out_channel -> t + +val flush : t -> unit -> unit + +val pp_print_queue : + ?pp_sep:(Format.formatter -> unit -> unit) -> + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Queue.t -> unit + +end = struct +#1 "ext_format.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. *) + + + + + + + + +open Format + +type t = formatter + +let string = pp_print_string + +let break = fun fmt -> pp_print_break fmt 0 0 + +let break1 = + fun fmt -> pp_print_break fmt 0 1 + +let space fmt = + pp_print_break fmt 1 0 + +let vgroup fmt indent u = + pp_open_vbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let group fmt indent u = + pp_open_hovbox fmt indent; + let v = u () in + pp_close_box fmt (); + v + +let paren fmt u = + string fmt "("; + let v = u () in + string fmt ")"; + v + +let brace fmt u = + string fmt "{"; + (* break1 fmt ; *) + let v = u () in + string fmt "}"; + v + +let bracket fmt u = + string fmt "["; + let v = u () in + string fmt "]"; + v + +let paren_group st n action = + group st n (fun _ -> paren st action) + +let brace_group st n action = + group st n (fun _ -> brace st action ) + +let brace_vgroup st n action = + vgroup st n (fun _ -> + string st "{"; + pp_print_break st 0 2; + let v = vgroup st 0 action in + pp_print_break st 0 0; + string st "}"; + v + ) +let bracket_group st n action = + group st n (fun _ -> bracket st action) + +let newline fmt = pp_print_newline fmt () + +let to_out_channel = formatter_of_out_channel + +(* let non_breaking_space fmt = string fmt " " *) +(* let set_needed_space_function _ _ = () *) +let flush = pp_print_flush + +let list = pp_print_list + +let rec pp_print_queue ?(pp_sep = pp_print_cut) pp_v ppf q = + Queue.iter (fun q -> pp_v ppf q ; pp_sep ppf ()) q + +end +module Ext_bytes : sig +#1 "ext_bytes.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. *) + + + + + + + +(** Port the {!Bytes.escaped} from trunk to make it not locale sensitive *) + +val escaped : bytes -> bytes + +end = struct +#1 "ext_bytes.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. *) + + + + + + + + +external char_code: char -> int = "%identity" +external char_chr: int -> char = "%identity" + +let escaped s = + let n = Pervasives.ref 0 in + for i = 0 to Bytes.length s - 1 do + n := !n + + (match Bytes.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | ' ' .. '~' -> 1 + | _ -> 4) + done; + if !n = Bytes.length s then Bytes.copy s else begin + let s' = Bytes.create !n in + n := 0; + for i = 0 to Bytes.length s - 1 do + begin match Bytes.unsafe_get s i with + | ('"' | '\\') as c -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c + | '\n' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' + | '\t' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' + | '\r' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' + | '\b' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' + | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c + | c -> + let a = char_code c in + Bytes.unsafe_set s' !n '\\'; + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a / 100)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a mod 10)); + end; + incr n + done; + s' + end + +end +module Ext_pervasives : sig +#1 "ext_pervasives.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. *) + + + + + + + + +(** Extension to standard library [Pervavives] module, safe to open + *) + +external reraise: exn -> 'a = "%reraise" + +val finally : 'a -> ('a -> 'c) -> ('a -> 'b) -> 'b + +val try_it : (unit -> 'a) -> unit + +val with_file_as_chan : string -> (out_channel -> 'a) -> 'a + +val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a + +val is_pos_pow : Int32.t -> int + +val failwithf : loc:string -> ('a, unit, string, 'b) format4 -> 'a + +val invalid_argf : ('a, unit, string, 'b) format4 -> 'a + +val bad_argf : ('a, unit, string, 'b) format4 -> 'a + + + + +external id : 'a -> 'a = "%identity" + +(** Copied from {!Btype.hash_variant}: + need sync up and add test case + *) +val hash_variant : string -> int + +val todo : string -> 'a +end = struct +#1 "ext_pervasives.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. *) + + + + + + +external reraise: exn -> 'a = "%reraise" + +let finally v action f = + match f v with + | exception e -> + action v ; + reraise e + | e -> action v ; e + +let try_it f = + try ignore (f ()) with _ -> () + +let with_file_as_chan filename f = + finally (open_out_bin filename) close_out f + +let with_file_as_pp filename f = + finally (open_out_bin filename) close_out + (fun chan -> + let fmt = Format.formatter_of_out_channel chan in + let v = f fmt in + Format.pp_print_flush fmt (); + v + ) + + +let is_pos_pow n = + let module M = struct exception E end in + let rec aux c (n : Int32.t) = + if n <= 0l then -2 + else if n = 1l then c + else if Int32.logand n 1l = 0l then + aux (c + 1) (Int32.shift_right n 1 ) + else raise M.E in + try aux 0 n with M.E -> -1 + +let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s)) + fmt + +let invalid_argf fmt = Format.ksprintf invalid_arg fmt + +let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt + +external id : 'a -> 'a = "%identity" + + +let hash_variant s = + let accu = ref 0 in + for i = 0 to String.length s - 1 do + accu := 223 * !accu + Char.code s.[i] + done; + (* reduce to 31 bits *) + accu := !accu land (1 lsl 31 - 1); + (* make it signed for 64 bits architectures *) + if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu + +let todo loc = + failwith (loc ^ " Not supported yet") +end +module Ext_string : sig +#1 "ext_string.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. *) + + + + + + + + +(** Extension to the standard library [String] module, fixed some bugs like + avoiding locale sensitivity *) + +(** default is false *) +val split_by : ?keep_empty:bool -> (char -> bool) -> string -> string list + + +(** remove whitespace letters ('\t', '\n', ' ') on both side*) +val trim : string -> string + + +(** default is false *) +val split : ?keep_empty:bool -> string -> char -> string list + +(** split by space chars for quick scripting *) +val quick_split_by_ws : string -> string list + + + +val starts_with : string -> string -> bool + +(** + return [-1] when not found, the returned index is useful + see [ends_with_then_chop] +*) +val ends_with_index : string -> string -> int + +val ends_with : string -> string -> bool + +(** + [ends_with_then_chop name ext] + @example: + {[ + ends_with_then_chop "a.cmj" ".cmj" + "a" + ]} + This is useful in controlled or file case sensitve system +*) +val ends_with_then_chop : string -> string -> string option + + +val escaped : string -> string + +(** + [for_all_from s start p] + if [start] is negative, it raises, + if [start] is too large, it returns true +*) +val for_all_from: + string -> + int -> + (char -> bool) -> + bool + +val for_all : + string -> + (char -> bool) -> + bool + +val is_empty : string -> bool + +val repeat : int -> string -> string + +val equal : string -> string -> bool + +(** + [extract_until s cursor sep] + When [sep] not found, the cursor is updated to -1, + otherwise cursor is increased to 1 + [sep_position] + User can not determine whether it is found or not by + telling the return string is empty since + "\n\n" would result in an empty string too. +*) +val extract_until: + string -> + int ref -> (* cursor to be updated *) + char -> + string + +val index_count: + string -> + int -> + char -> + int -> + int + +(** + [find ~start ~sub s] + returns [-1] if not found +*) +val find : ?start:int -> sub:string -> string -> int + +val contain_substring : string -> string -> bool + +val non_overlap_count : sub:string -> string -> int + +val rfind : sub:string -> string -> int + +(** [tail_from s 1] + return a substring from offset 1 (inclusive) +*) +val tail_from : string -> int -> string + + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option + +type check_result = + | Good | Invalid_module_name | Suffix_mismatch + +val is_valid_source_name : + string -> check_result + + + + + +val no_char : string -> char -> int -> int -> bool + + +val no_slash : string -> bool + +(** return negative means no slash, otherwise [i] means the place for first slash *) +val no_slash_idx : string -> int + +val no_slash_idx_from : string -> int -> int + +(** if no conversion happens, reference equality holds *) +val replace_slash_backward : string -> string + +(** if no conversion happens, reference equality holds *) +val replace_backward_slash : string -> string + +val empty : string + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +val single_space : string + +val concat3 : string -> string -> string -> string +val concat4 : string -> string -> string -> string -> string +val concat5 : string -> string -> string -> string -> string -> string +val inter2 : string -> string -> string +val inter3 : string -> string -> string -> string +val inter4 : string -> string -> string -> string -> string +val concat_array : string -> string array -> string + +val single_colon : string + +val parent_dir_lit : string +val current_dir_lit : string + +val capitalize_ascii : string -> string + +val uncapitalize_ascii : string -> string + +val lowercase_ascii : string -> string +end = struct +#1 "ext_string.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. *) + + + + + + + +(* + {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} +*) +let split_by ?(keep_empty=false) is_delim str = + let len = String.length str in + let rec loop acc last_pos pos = + if pos = -1 then + if last_pos = 0 && not keep_empty then + + acc + else + String.sub str 0 last_pos :: acc + else + if is_delim str.[pos] then + let new_len = (last_pos - pos - 1) in + if new_len <> 0 || keep_empty then + let v = String.sub str (pos + 1) new_len in + loop ( v :: acc) + pos (pos - 1) + else loop acc pos (pos - 1) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) + +let trim s = + let i = ref 0 in + let j = String.length s in + while !i < j && + let u = String.unsafe_get s !i in + u = '\t' || u = '\n' || u = ' ' + do + incr i; + done; + let k = ref (j - 1) in + while !k >= !i && + let u = String.unsafe_get s !k in + u = '\t' || u = '\n' || u = ' ' do + decr k ; + done; + String.sub s !i (!k - !i + 1) + +let split ?keep_empty str on = + if str = "" then [] else + split_by ?keep_empty (fun x -> (x : char) = on) str ;; + +let quick_split_by_ws str : string list = + split_by ~keep_empty:false (fun x -> x = '\t' || x = '\n' || x = ' ') str + +let starts_with s beg = + let beg_len = String.length beg in + let s_len = String.length s in + beg_len <= s_len && + (let i = ref 0 in + while !i < beg_len + && String.unsafe_get s !i = + String.unsafe_get beg !i do + incr i + done; + !i = beg_len + ) + +let rec ends_aux s end_ j k = + if k < 0 then (j + 1) + else if String.unsafe_get s j = String.unsafe_get end_ k then + ends_aux s end_ (j - 1) (k - 1) + else -1 + +(** return an index which is minus when [s] does not + end with [beg] +*) +let ends_with_index s end_ = + let s_finish = String.length s - 1 in + let s_beg = String.length end_ - 1 in + if s_beg > s_finish then -1 + else + ends_aux s end_ s_finish s_beg + +let ends_with s end_ = ends_with_index s end_ >= 0 + +let ends_with_then_chop s beg = + let i = ends_with_index s beg in + if i >= 0 then Some (String.sub s 0 i) + else None + +let check_suffix_case = ends_with +let check_suffix_case_then_chop = ends_with_then_chop + +let check_any_suffix_case s suffixes = + List.exists (fun x -> check_suffix_case s x) suffixes + +let check_any_suffix_case_then_chop s suffixes = + let rec aux suffixes = + match suffixes with + | [] -> None + | x::xs -> + let id = ends_with_index s x in + if id >= 0 then Some (String.sub s 0 id) + else aux xs in + aux suffixes + + + +(** In OCaml 4.02.3, {!String.escaped} is locale senstive, + this version try to make it not locale senstive, this bug is fixed + in the compiler trunk +*) +let escaped s = + let rec needs_escape i = + if i >= String.length s then false else + match String.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true + | ' ' .. '~' -> needs_escape (i+1) + | _ -> true + in + if needs_escape 0 then + Bytes.unsafe_to_string (Ext_bytes.escaped (Bytes.unsafe_of_string s)) + else + s + +(* it is unsafe to expose such API as unsafe since + user can provide bad input range + +*) +let rec unsafe_for_all_range s ~start ~finish p = + start > finish || + p (String.unsafe_get s start) && + unsafe_for_all_range s ~start:(start + 1) ~finish p + +let for_all_from s start p = + let len = String.length s in + if start < 0 then invalid_arg "Ext_string.for_all_from" + else unsafe_for_all_range s ~start ~finish:(len - 1) p + + +let for_all s (p : char -> bool) = + unsafe_for_all_range s ~start:0 ~finish:(String.length s - 1) p + +let is_empty s = String.length s = 0 + + +let repeat n s = + let len = String.length s in + let res = Bytes.create(n * len) in + for i = 0 to pred n do + String.blit s 0 res (i * len) len + done; + Bytes.to_string res + +let equal (x : string) y = x = y + + + +let unsafe_is_sub ~sub i s j ~len = + let rec check k = + if k = len + then true + else + String.unsafe_get sub (i+k) = + String.unsafe_get s (j+k) && check (k+1) + in + j+len <= String.length s && check 0 + + +exception Local_exit +let find ?(start=0) ~sub s = + let n = String.length sub in + let s_len = String.length s in + let i = ref start in + try + while !i + n <= s_len do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + incr i + done; + -1 + with Local_exit -> + !i + +let contain_substring s sub = + find s ~sub >= 0 + +(** TODO: optimize + avoid nonterminating when string is empty +*) +let non_overlap_count ~sub s = + let sub_len = String.length sub in + let rec aux acc off = + let i = find ~start:off ~sub s in + if i < 0 then acc + else aux (acc + 1) (i + sub_len) in + if String.length sub = 0 then invalid_arg "Ext_string.non_overlap_count" + else aux 0 0 + + +let rfind ~sub s = + let n = String.length sub in + let i = ref (String.length s - n) in + let module M = struct exception Exit end in + try + while !i >= 0 do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + decr i + done; + -1 + with Local_exit -> + !i + +let tail_from s x = + let len = String.length s in + if x > len then invalid_arg ("Ext_string.tail_from " ^s ^ " : "^ string_of_int x ) + else String.sub s x (len - x) + +let equal (x : string) y = x = y + +let rec index_rec s lim i c = + if i >= lim then -1 else + if String.unsafe_get s i = c then i + else index_rec s lim (i + 1) c + +let rec index_rec_count s lim i c count = + if i >= lim then -1 else + if String.unsafe_get s i = c then + if count = 1 then i + else index_rec_count s lim (i + 1) c (count - 1) + else index_rec_count s lim (i + 1) c count + +let index_count s i c count = + let lim = String.length s in + if i < 0 || i >= lim || count < 1 then + Ext_pervasives.invalid_argf "index_count: (%d,%d)" i count; + + index_rec_count s lim i c count +let extract_until s cursor c = + let len = String.length s in + let start = !cursor in + if start < 0 || start >= len then ( + cursor := -1; + "" + ) + else + let i = index_rec s len start c in + let finish = + if i < 0 then ( + cursor := -1 ; + len + ) + else ( + cursor := i + 1; + i + ) in + String.sub s start (finish - start) + +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;; + +let is_valid_module_file (s : string) = + let len = String.length s in + len > 0 && + match String.unsafe_get s 0 with + | 'A' .. 'Z' + | 'a' .. 'z' -> + unsafe_for_all_range s ~start:1 ~finish:(len - 1) + (fun x -> + match x with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> true + | _ -> false ) + | _ -> false + + + + +type check_result = + | Good + | Invalid_module_name + | Suffix_mismatch + (** + TODO: move to another module + Make {!Ext_filename} not stateful + *) +let is_valid_source_name name : check_result = + match check_any_suffix_case_then_chop name [ + ".ml"; + ".re"; + ".mli"; + ".rei" + ] with + | None -> Suffix_mismatch + | Some x -> + if is_valid_module_file x then + Good + else Invalid_module_name + +(** TODO: can be improved to return a positive integer instead *) +let rec unsafe_no_char x ch i last_idx = + i > last_idx || + (String.unsafe_get x i <> ch && unsafe_no_char x ch (i + 1) last_idx) + +let rec unsafe_no_char_idx x ch i last_idx = + if i > last_idx then -1 + else + if String.unsafe_get x i <> ch then + unsafe_no_char_idx x ch (i + 1) last_idx + else i + +let no_char x ch i len : bool = + let str_len = String.length x in + if i < 0 || i >= str_len || len >= str_len then invalid_arg "Ext_string.no_char" + else unsafe_no_char x ch i len + + +let no_slash x = + unsafe_no_char x '/' 0 (String.length x - 1) + +let no_slash_idx x = + unsafe_no_char_idx x '/' 0 (String.length x - 1) + +let no_slash_idx_from x from = + let last_idx = String.length x - 1 in + assert (from >= 0); + unsafe_no_char_idx x '/' from last_idx + +let replace_slash_backward (x : string ) = + let len = String.length x in + if unsafe_no_char x '/' 0 (len - 1) then x + else + String.map (function + | '/' -> '\\' + | x -> x ) x + +let replace_backward_slash (x : string)= + let len = String.length x in + if unsafe_no_char x '\\' 0 (len -1) then x + else + String.map (function + |'\\'-> '/' + | x -> x) x + +let empty = "" + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +let single_space = " " +let single_colon = ":" + +let concat_array sep (s : string array) = + let s_len = Array.length s in + match s_len with + | 0 -> empty + | 1 -> Array.unsafe_get s 0 + | _ -> + let sep_len = String.length sep in + let len = ref 0 in + for i = 0 to s_len - 1 do + len := !len + String.length (Array.unsafe_get s i) + done; + let target = + Bytes.create + (!len + (s_len - 1) * sep_len ) in + let hd = (Array.unsafe_get s 0) in + let hd_len = String.length hd in + String.unsafe_blit hd 0 target 0 hd_len; + let current_offset = ref hd_len in + for i = 1 to s_len - 1 do + String.unsafe_blit sep 0 target !current_offset sep_len; + let cur = Array.unsafe_get s i in + let cur_len = String.length cur in + let new_off_set = (!current_offset + sep_len ) in + String.unsafe_blit cur 0 target new_off_set cur_len; + current_offset := + new_off_set + cur_len ; + done; + Bytes.unsafe_to_string target + +let concat3 a b c = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let len = a_len + b_len + c_len in + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + Bytes.unsafe_to_string target + +let concat4 a b c d = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let len = a_len + b_len + c_len + d_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + Bytes.unsafe_to_string target + + +let concat5 a b c d e = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let e_len = String.length e in + let len = a_len + b_len + c_len + d_len + e_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + String.unsafe_blit e 0 target (a_len + b_len + c_len + d_len) e_len; + Bytes.unsafe_to_string target + + + +let inter2 a b = + concat3 a single_space b + + +let inter3 a b c = + concat5 a single_space b single_space c + + + + + +let inter4 a b c d = + concat_array single_space [| a; b ; c; d|] + + +let parent_dir_lit = ".." +let current_dir_lit = "." + + +(* reference {!Bytes.unppercase} *) +let capitalize_ascii (s : string) : string = + if String.length s = 0 then s + else + begin + let c = String.unsafe_get s 0 in + if (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') then + let uc = Char.unsafe_chr (Char.code c - 32) in + let bytes = Bytes.of_string s in + Bytes.unsafe_set bytes 0 uc; + Bytes.unsafe_to_string bytes + else s + end + +let uncapitalize_ascii = + + String.uncapitalize_ascii + + + + +let lowercase_ascii = String.lowercase_ascii + + + + + +end +module Ext_list : sig +#1 "ext_list.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 map : + 'a list -> + ('a -> 'b) -> + 'b list + +val has_string : + string list -> + string -> + bool +val map_split_opt : + 'a list -> + ('a -> 'b option * 'c option) -> + 'b list * 'c list + +val mapi : + 'a list -> + (int -> 'a -> 'b) -> + 'b list + +val map_snd : ('a * 'b) list -> ('b -> 'c) -> ('a * 'c) list + +(** [map_last f xs ] + will pass [true] to [f] for the last element, + [false] otherwise. + For empty list, it returns empty +*) +val map_last : + 'a list -> + (bool -> 'a -> 'b) -> 'b list + +(** [last l] + return the last element + raise if the list is empty +*) +val last : 'a list -> 'a + +val append : + 'a list -> + 'a list -> + 'a list + +val append_one : + 'a list -> + 'a -> + 'a list + +val map_append : + 'b list -> + 'a list -> + ('b -> 'a) -> + 'a list + +val fold_right : + 'a list -> + 'b -> + ('a -> 'b -> 'b) -> + 'b + +val fold_right2 : + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) -> 'c + +val map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c) -> + 'c list + +val fold_left_with_offset : + 'a list -> + 'acc -> + int -> + ('a -> 'acc -> int -> 'acc) -> + 'acc + + +(** @unused *) +val filter_map : + 'a list -> + ('a -> 'b option) -> + 'b list + +(** [exclude p l] is the opposite of [filter p l] *) +val exclude : + 'a list -> + ('a -> bool) -> + 'a list + +(** [excludes p l] + return a tuple [excluded,newl] + where [exluded] is true indicates that at least one + element is removed,[newl] is the new list where all [p x] for [x] is false + +*) +val exclude_with_val : + 'a list -> + ('a -> bool) -> + 'a list option + + +val same_length : 'a list -> 'b list -> bool + +val init : int -> (int -> 'a) -> 'a list + +(** [split_at n l] + will split [l] into two lists [a,b], [a] will be of length [n], + otherwise, it will raise +*) +val split_at : + 'a list -> + int -> + 'a list * 'a list + + +(** [split_at_last l] + It is equivalent to [split_at (List.length l - 1) l ] +*) +val split_at_last : 'a list -> 'a list * 'a + +val filter_mapi : + 'a list -> + ('a -> int -> 'b option) -> + 'b list + +val filter_map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c option) -> + 'c list + + +val length_compare : 'a list -> int -> [`Gt | `Eq | `Lt ] + +val length_ge : 'a list -> int -> bool + +(** + + {[length xs = length ys + n ]} + input n should be positive + TODO: input checking +*) + +val length_larger_than_n : + 'a list -> + 'a list -> + int -> + bool + + +(** + [rev_map_append f l1 l2] + [map f l1] and reverse it to append [l2] + This weird semantics is due to it is the most efficient operation + we can do +*) +val rev_map_append : + 'a list -> + 'b list -> + ('a -> 'b) -> + 'b list + + +val flat_map : + 'a list -> + ('a -> 'b list) -> + 'b list + +val flat_map_append : + 'a list -> + 'b list -> + ('a -> 'b list) -> + 'b list + + +(** + [stable_group eq lst] + Example: + Input: + {[ + stable_group (=) [1;2;3;4;3] + ]} + Output: + {[ + [[1];[2];[4];[3;3]] + ]} + TODO: this is O(n^2) behavior + which could be improved later +*) +val stable_group : + 'a list -> + ('a -> 'a -> bool) -> + 'a list list + +(** [drop n list] + raise when [n] is negative + raise when list's length is less than [n] +*) +val drop : + 'a list -> + int -> + 'a list + +val find_first : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_first_not p lst ] + if all elements in [lst] pass, return [None] + otherwise return the first element [e] as [Some e] which + fails the predicate +*) +val find_first_not : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_opt f l] returns [None] if all return [None], + otherwise returns the first one. +*) + +val find_opt : + 'a list -> + ('a -> 'b option) -> + 'b option + + +val rev_iter : + 'a list -> + ('a -> unit) -> + unit + +val iter: + 'a list -> + ('a -> unit) -> + unit + +val for_all: + 'a list -> + ('a -> bool) -> + bool +val for_all_snd: + ('a * 'b) list -> + ('b -> bool) -> + bool + +(** [for_all2_no_exn p xs ys] + return [true] if all satisfied, + [false] otherwise or length not equal +*) +val for_all2_no_exn : + 'a list -> + 'b list -> + ('a -> 'b -> bool) -> + bool + + + +(** [f] is applied follow the list order *) +val split_map : + 'a list -> + ('a -> 'b * 'c) -> + 'b list * 'c list + +(** [fn] is applied from left to right *) +val reduce_from_left : + 'a list -> + ('a -> 'a -> 'a) -> + 'a + +val sort_via_array : + 'a list -> + ('a -> 'a -> int) -> + 'a list + + + + +(** [assoc_by_string default key lst] + if [key] is found in the list return that val, + other unbox the [default], + otherwise [assert false ] +*) +val assoc_by_string : + (string * 'a) list -> + string -> + 'a option -> + 'a + +val assoc_by_int : + (int * 'a) list -> + int -> + 'a option -> + 'a + + +val nth_opt : 'a list -> int -> 'a option + +val iter_snd : ('a * 'b) list -> ('b -> unit) -> unit + +val iter_fst : ('a * 'b) list -> ('a -> unit) -> unit + +val exists : 'a list -> ('a -> bool) -> bool +val exists_snd : ('a * 'b) list -> ('b -> bool) -> bool + +val concat_append: + 'a list list -> + 'a list -> + 'a list + +val fold_left2: + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) + -> 'c + +val fold_left: + 'a list -> + 'b -> + ('b -> 'a -> 'b) -> + 'b + +val singleton_exn: + 'a list -> 'a +end = struct +#1 "ext_list.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 rec map l f = + match l with + | [] -> + [] + | [x1] -> + let y1 = f x1 in + [y1] + | [x1; x2] -> + let y1 = f x1 in + let y2 = f x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::x5::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + y1::y2::y3::y4::y5::(map tail f) + +let rec has_string l f = + match l with + | [] -> + false + | [x1] -> + x1 = f + | [x1; x2] -> + x1 = f || x2 = f + | [x1; x2; x3] -> + x1 = f || x2 = f || x3 = f + | x1 :: x2 :: x3 :: x4 -> + x1 = f || x2 = f || x3 = f || has_string x4 f + + +let rec map_split_opt + (xs : 'a list) (f : 'a -> 'b option * 'c option) + : 'b list * 'c list = + match xs with + | [] -> [], [] + | x::xs -> + let c,d = f x in + let cs,ds = map_split_opt xs f in + (match c with Some c -> c::cs | None -> cs), + (match d with Some d -> d::ds | None -> ds) + +let rec map_snd l f = + match l with + | [] -> + [] + | [ v1,x1 ] -> + let y1 = f x1 in + [v1,y1] + | [v1, x1; v2, x2] -> + let y1 = f x1 in + let y2 = f x2 in + [v1, y1; v2, y2] + | [ v1, x1; v2, x2; v3, x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [v1, y1; v2, y2; v3, y3] + | [ v1, x1; v2, x2; v3, x3; v4, x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [v1, y1; v2, y2; v3, y3; v4, y4] + | (v1, x1) ::(v2, x2) :: (v3, x3)::(v4, x4) :: (v5, x5) ::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + (v1, y1)::(v2, y2) :: (v3, y3) :: (v4, y4) :: (v5, y5) :: (map_snd tail f) + + +let rec map_last l f= + match l with + | [] -> + [] + | [x1] -> + let y1 = f true x1 in + [y1] + | [x1; x2] -> + let y1 = f false x1 in + let y2 = f true x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f true x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f true x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::tail -> + (* make sure that tail is not empty *) + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f false x4 in + y1::y2::y3::y4::(map_last tail f) + +let rec mapi_aux lst i f = + match lst with + [] -> [] + | a::l -> + let r = f i a in r :: mapi_aux l (i + 1) f + +let mapi lst f = mapi_aux lst 0 f + +let rec last xs = + match xs with + | [x] -> x + | _ :: tl -> last tl + | [] -> invalid_arg "Ext_list.last" + + + +let rec append_aux l1 l2 = + match l1 with + | [] -> l2 + | [a0] -> a0::l2 + | [a0;a1] -> a0::a1::l2 + | [a0;a1;a2] -> a0::a1::a2::l2 + | [a0;a1;a2;a3] -> a0::a1::a2::a3::l2 + | [a0;a1;a2;a3;a4] -> a0::a1::a2::a3::a4::l2 + | a0::a1::a2::a3::a4::rest -> a0::a1::a2::a3::a4::append_aux rest l2 + +let append l1 l2 = + match l2 with + | [] -> l1 + | _ -> append_aux l1 l2 + +let append_one l1 x = append_aux l1 [x] + +let rec map_append l1 l2 f = + match l1 with + | [] -> l2 + | [a0] -> f a0::l2 + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + b0::b1::l2 + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + b0::b1::b2::l2 + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + b0::b1::b2::b3::l2 + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::l2 + + | a0::a1::a2::a3::a4::rest -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::map_append rest l2 f + + + +let rec fold_right l acc f = + match l with + | [] -> acc + | [a0] -> f a0 acc + | [a0;a1] -> f a0 (f a1 acc) + | [a0;a1;a2] -> f a0 (f a1 (f a2 acc)) + | [a0;a1;a2;a3] -> f a0 (f a1 (f a2 (f a3 acc))) + | [a0;a1;a2;a3;a4] -> + f a0 (f a1 (f a2 (f a3 (f a4 acc)))) + | a0::a1::a2::a3::a4::rest -> + f a0 (f a1 (f a2 (f a3 (f a4 (fold_right rest acc f ))))) + +let rec fold_right2 l r acc f = + match l,r with + | [],[] -> acc + | [a0],[b0] -> f a0 b0 acc + | [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc) + | [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc)) + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc))) + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc)))) + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f ))))) + | _, _ -> invalid_arg "Ext_list.fold_right2" + +let rec map2 l r f = + match l,r with + | [],[] -> [] + | [a0],[b0] -> [f a0 b0] + | [a0;a1],[b0;b1] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + [c0; c1] + | [a0;a1;a2],[b0;b1;b2] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + [c0;c1;c2] + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + [c0;c1;c2;c3] + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + [c0;c1;c2;c3;c4] + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + c0::c1::c2::c3::c4::map2 arest brest f + | _, _ -> invalid_arg "Ext_list.map2" + +let rec fold_left_with_offset l accu i f = + match l with + | [] -> accu + | a::l -> + fold_left_with_offset + l + (f a accu i) + (i + 1) + f + + +let rec filter_map xs (f: 'a -> 'b option)= + match xs with + | [] -> [] + | y :: ys -> + begin match f y with + | None -> filter_map ys f + | Some z -> z :: filter_map ys f + end + +let rec exclude (xs : 'a list) (p : 'a -> bool) : 'a list = + match xs with + | [] -> [] + | x::xs -> + if p x then exclude xs p + else x:: exclude xs p + +let rec exclude_with_val l p = + match l with + | [] -> None + | a0::xs -> + if p a0 then Some (exclude xs p) + else + match xs with + | [] -> None + | a1::rest -> + if p a1 then + Some (a0:: exclude rest p) + else + match exclude_with_val rest p with + | None -> None + | Some rest -> Some (a0::a1::rest) + + + +let rec same_length xs ys = + match xs, ys with + | [], [] -> true + | _::xs, _::ys -> same_length xs ys + | _, _ -> false + + +let init n f = + match n with + | 0 -> [] + | 1 -> + let a0 = f 0 in + [a0] + | 2 -> + let a0 = f 0 in + let a1 = f 1 in + [a0; a1] + | 3 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + [a0; a1; a2] + | 4 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + [a0; a1; a2; a3] + | 5 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + let a4 = f 4 in + [a0; a1; a2; a3; a4] + | _ -> + Array.to_list (Array.init n f) + +let rec small_split_at n acc l = + if n <= 0 then List.rev acc , l + else + match l with + | x::xs -> small_split_at (n - 1) (x ::acc) xs + | _ -> invalid_arg "Ext_list.split_at" + +let split_at l n = + small_split_at n [] l + +let rec split_at_last_aux acc x = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [ x] -> List.rev acc, x + | y0::ys -> split_at_last_aux (y0::acc) ys + +let split_at_last (x : 'a list) = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [a0] -> + [], a0 + | [a0;a1] -> + [a0], a1 + | [a0;a1;a2] -> + [a0;a1], a2 + | [a0;a1;a2;a3] -> + [a0;a1;a2], a3 + | [a0;a1;a2;a3;a4] -> + [a0;a1;a2;a3], a4 + | a0::a1::a2::a3::a4::rest -> + let rev, last = split_at_last_aux [] rest + in + a0::a1::a2::a3::a4:: rev , last + +(** + can not do loop unroll due to state combination +*) +let filter_mapi xs f = + let rec aux i xs = + match xs with + | [] -> [] + | y :: ys -> + begin match f y i with + | None -> aux (i + 1) ys + | Some z -> z :: aux (i + 1) ys + end in + aux 0 xs + +let rec filter_map2 xs ys (f: 'a -> 'b -> 'c option) = + match xs,ys with + | [],[] -> [] + | u::us, v :: vs -> + begin match f u v with + | None -> filter_map2 us vs f (* idea: rec f us vs instead? *) + | Some z -> z :: filter_map2 us vs f + end + | _ -> invalid_arg "Ext_list.filter_map2" + + +let rec rev_map_append l1 l2 f = + match l1 with + | [] -> l2 + | a :: l -> rev_map_append l (f a :: l2) f + + +let rec rev_append l1 l2 = + match l1 with + [] -> l2 + | a :: l -> rev_append l (a :: l2) + +(** It is not worth loop unrolling, + it is already tail-call, and we need to be careful + about evaluation order when unroll +*) +let rec flat_map_aux f acc append lx = + match lx with + | [] -> rev_append acc append + | a0::rest -> flat_map_aux f (rev_append (f a0) acc ) append rest + +let flat_map lx f = + flat_map_aux f [] [] lx + +let flat_map_append lx append f = + flat_map_aux f [] append lx + + +let rec length_compare l n = + if n < 0 then `Gt + else + begin match l with + | _ ::xs -> length_compare xs (n - 1) + | [] -> + if n = 0 then `Eq + else `Lt + end + +let rec length_ge l n = + if n > 0 then + match l with + | _ :: tl -> length_ge tl (n - 1) + | [] -> false + else true +(** + + {[length xs = length ys + n ]} +*) +let rec length_larger_than_n xs ys n = + match xs, ys with + | _, [] -> length_compare xs n = `Eq + | _::xs, _::ys -> + length_larger_than_n xs ys n + | [], _ -> false + + + + +let rec group (eq : 'a -> 'a -> bool) lst = + match lst with + | [] -> [] + | x::xs -> + aux eq x (group eq xs ) + +and aux eq (x : 'a) (xss : 'a list list) : 'a list list = + match xss with + | [] -> [[x]] + | (y0::_ as y)::ys -> (* cannot be empty *) + if eq x y0 then + (x::y) :: ys + else + y :: aux eq x ys + | _ :: _ -> assert false + +let stable_group lst eq = group eq lst |> List.rev + +let rec drop h n = + if n < 0 then invalid_arg "Ext_list.drop" + else + if n = 0 then h + else + match h with + | [] -> + invalid_arg "Ext_list.drop" + | _ :: tl -> + drop tl (n - 1) + +let rec find_first x p = + match x with + | [] -> None + | x :: l -> + if p x then Some x + else find_first l p + +let rec find_first_not xs p = + match xs with + | [] -> None + | a::l -> + if p a + then find_first_not l p + else Some a + + +let rec rev_iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x2 ; f x1 + | [x1; x2; x3] -> + f x3 ; f x2 ; f x1 + | [x1; x2; x3; x4] -> + f x4; f x3; f x2; f x1 + | x1::x2::x3::x4::x5::tail -> + rev_iter tail f; + f x5; f x4 ; f x3; f x2 ; f x1 + +let rec iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x1 ; f x2 + | [x1; x2; x3] -> + f x1 ; f x2 ; f x3 + | [x1; x2; x3; x4] -> + f x1; f x2; f x3; f x4 + | x1::x2::x3::x4::x5::tail -> + f x1; f x2 ; f x3; f x4 ; f x5; + iter tail f + + +let rec for_all lst p = + match lst with + [] -> true + | a::l -> p a && for_all l p + +let rec for_all_snd lst p = + match lst with + [] -> true + | (_,a)::l -> p a && for_all_snd l p + + +let rec for_all2_no_exn l1 l2 p = + match (l1, l2) with + | ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_no_exn l1 l2 p + | (_, _) -> false + + +let rec find_opt xs p = + match xs with + | [] -> None + | x :: l -> + match p x with + | Some _ as v -> v + | None -> find_opt l p + + + +let rec split_map l f = + match l with + | [] -> + [],[] + | [x1] -> + let a0,b0 = f x1 in + [a0],[b0] + | [x1; x2] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + [a1;a2],[b1;b2] + | [x1; x2; x3] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + [a1;a2;a3], [b1;b2;b3] + | [x1; x2; x3; x4] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + [a1;a2;a3;a4], [b1;b2;b3;b4] + | x1::x2::x3::x4::x5::tail -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + let a5,b5 = f x5 in + let ass,bss = split_map tail f in + a1::a2::a3::a4::a5::ass, + b1::b2::b3::b4::b5::bss + + + + +let sort_via_array lst cmp = + let arr = Array.of_list lst in + Array.sort cmp arr; + Array.to_list arr + + + + +let rec assoc_by_string lst (k : string) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if Ext_string.equal k1 k then v1 else + assoc_by_string rest k def + +let rec assoc_by_int lst (k : int) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if k1 = k then v1 else + assoc_by_int rest k def + + +let rec nth_aux l n = + match l with + | [] -> None + | a::l -> if n = 0 then Some a else nth_aux l (n-1) + +let nth_opt l n = + if n < 0 then None + else + nth_aux l n + +let rec iter_snd lst f = + match lst with + | [] -> () + | (_,x)::xs -> + f x ; + iter_snd xs f + +let rec iter_fst lst f = + match lst with + | [] -> () + | (x,_)::xs -> + f x ; + iter_fst xs f + +let rec exists l p = + match l with + [] -> false + | x :: xs -> p x || exists xs p + +let rec exists_snd l p = + match l with + [] -> false + | (_, a)::l -> p a || exists_snd l p + +let rec concat_append + (xss : 'a list list) + (xs : 'a list) : 'a list = + match xss with + | [] -> xs + | l::r -> append l (concat_append r xs) + +let rec fold_left l accu f = + match l with + [] -> accu + | a::l -> fold_left l (f accu a) f + +let reduce_from_left lst fn = + match lst with + | first :: rest -> fold_left rest first fn + | _ -> invalid_arg "Ext_list.reduce_from_left" + +let rec fold_left2 l1 l2 accu f = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> fold_left2 l1 l2 (f a1 a2 accu) f + | (_, _) -> invalid_arg "List.fold_left2" + +let singleton_exn xs = match xs with [x] -> x | _ -> assert false + + +end +module Ext_char : sig +#1 "ext_char.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. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool + +val is_lower_case : char -> bool + +val uppercase_ascii : char -> char + +val lowercase_ascii : char -> char +end = struct +#1 "ext_char.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. *) + + + + + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) + +let escaped = Char.escaped + + +let valid_hex x = + match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> true + | _ -> false + + + +let is_lower_case c = + (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') +let uppercase_ascii = + + Char.uppercase_ascii + + +let lowercase_ascii = + + Char.lowercase_ascii + + +end +module Ext_sys : sig +#1 "ext_sys.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. *) + + +(* Not used yet *) +(* val is_directory_no_exn : string -> bool *) + + +val is_windows_or_cygwin : bool + +val getenv_opt : + string -> + string option +end = struct +#1 "ext_sys.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. *) + +(** TODO: not exported yet, wait for Windows Fix*) +let is_directory_no_exn f = + try Sys.is_directory f with _ -> false + + +let is_windows_or_cygwin = Sys.win32 || Sys.cygwin + + +let getenv_opt = Sys.getenv_opt + +end +module Literals : sig +#1 "literals.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 js_array_ctor : string +val js_type_number : string +val js_type_string : string +val js_type_object : string +val js_type_boolean : string +val js_undefined : string +val js_prop_length : string + +val param : string +val partial_arg : string +val prim : string + +(**temporary varaible used in {!Js_ast_util} *) +val tmp : string + +val create : string +val runtime : string +val stdlib : string +val imul : string + +val setter_suffix : string +val setter_suffix_len : int + + +val debugger : string +val raw_expr : string +val raw_stmt : string +val raw_function : string +val unsafe_downgrade : string +val fn_run : string +val method_run : string +val fn_method : string +val fn_mk : string + +(** callback actually, not exposed to user yet *) +(* val js_fn_runmethod : string *) + +val bs_deriving : string +val bs_deriving_dot : string +val bs_type : string + +(** nodejs *) + +val node_modules : string +val node_modules_length : int +val package_json : string +val bsconfig_json : string +val build_ninja : string + +(* Name of the library file created for each external dependency. *) +val library_file : string + +val suffix_a : string +val suffix_cmj : string +val suffix_cmo : string +val suffix_cma : string +val suffix_cmi : string +val suffix_cmx : string +val suffix_cmxa : string +val suffix_ml : string +val suffix_mlast : string +val suffix_mlast_simple : string +val suffix_mliast : string +val suffix_mliast_simple : string +val suffix_mlmap : string +val suffix_mll : string +val suffix_re : string +val suffix_rei : string + +val suffix_d : string +val suffix_js : string +val suffix_bs_js : string +(* val suffix_re_js : string *) +val suffix_gen_js : string +val suffix_gen_tsx: string + +val suffix_tsx : string +val suffix_mlastd : string +val suffix_mliastd : string + +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string + +val commonjs : string +val amdjs : string +val es6 : string +val es6_global : string +val amdjs_global : string +val unused_attribute : string +val dash_nostdlib : string + +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string + +val native : string +val bytecode : string +val js : string + +val node_sep : string +val node_parent : string +val node_current : string +val gentype_import : string +end = struct +#1 "literals.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 js_array_ctor = "Array" +let js_type_number = "number" +let js_type_string = "string" +let js_type_object = "object" +let js_type_boolean = "boolean" +let js_undefined = "undefined" +let js_prop_length = "length" + +let prim = "prim" +let param = "param" +let partial_arg = "partial_arg" +let tmp = "tmp" + +let create = "create" (* {!Caml_exceptions.create}*) + +let runtime = "runtime" (* runtime directory *) + +let stdlib = "stdlib" + +let imul = "imul" (* signed int32 mul *) + +let setter_suffix = "#=" +let setter_suffix_len = String.length setter_suffix + +let debugger = "debugger" +let raw_expr = "raw_expr" +let raw_stmt = "raw_stmt" +let raw_function = "raw_function" +let unsafe_downgrade = "unsafe_downgrade" +let fn_run = "fn_run" +let method_run = "method_run" + +let fn_method = "fn_method" +let fn_mk = "fn_mk" +(*let js_fn_runmethod = "js_fn_runmethod"*) + +let bs_deriving = "bs.deriving" +let bs_deriving_dot = "bs.deriving." +let bs_type = "bs.type" + + +(** nodejs *) +let node_modules = "node_modules" +let node_modules_length = String.length "node_modules" +let package_json = "package.json" +let bsconfig_json = "bsconfig.json" +let build_ninja = "build.ninja" + +(* Name of the library file created for each external dependency. *) +let library_file = "lib" + +let suffix_a = ".a" +let suffix_cmj = ".cmj" +let suffix_cmo = ".cmo" +let suffix_cma = ".cma" +let suffix_cmi = ".cmi" +let suffix_cmx = ".cmx" +let suffix_cmxa = ".cmxa" +let suffix_mll = ".mll" +let suffix_ml = ".ml" +let suffix_mli = ".mli" +let suffix_re = ".re" +let suffix_rei = ".rei" +let suffix_mlmap = ".mlmap" + +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" +let suffix_mlast = ".mlast" +let suffix_mlast_simple = ".mlast_simple" +let suffix_mliast = ".mliast" +let suffix_mliast_simple = ".mliast_simple" +let suffix_d = ".d" +let suffix_mlastd = ".mlast.d" +let suffix_mliastd = ".mliast.d" +let suffix_js = ".js" +let suffix_bs_js = ".bs.js" +(* let suffix_re_js = ".re.js" *) +let suffix_gen_js = ".gen.js" +let suffix_gen_tsx = ".gen.tsx" +let suffix_tsx = ".tsx" + +let commonjs = "commonjs" +let amdjs = "amdjs" +let es6 = "es6" +let es6_global = "es6-global" +let amdjs_global = "amdjs-global" +let unused_attribute = "Unused attribute " +let dash_nostdlib = "-nostdlib" + +let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" +let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" + +let native = "native" +let bytecode = "bytecode" +let js = "js" + + + +(** Used when produce node compatible paths *) +let node_sep = "/" +let node_parent = ".." +let node_current = "." + +let gentype_import = "genType.import" +end +module Ext_path : sig +#1 "ext_path.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t + + + + + +(** + [combine path1 path2] + 1. add some simplifications when concatenating + 2. when [path2] is absolute, return [path2] +*) +val combine : + string -> + string -> + string + + + +val chop_extension : ?loc:string -> string -> string + + +val chop_extension_if_any : string -> string + +val chop_all_extensions_if_any : + string -> string + +(** + {[ + get_extension "a.txt" = ".txt" + get_extension "a" = "" + ]} +*) +val get_extension : string -> string + + + + +val node_rebase_file : + from:string -> + to_:string -> + string -> + string + +(** + TODO: could be highly optimized + if [from] and [to] resolve to the same path, a zero-length string is returned + Given that two paths are directory + + A typical use case is + {[ + Filename.concat + (rel_normalized_absolute_path cwd (Filename.dirname a)) + (Filename.basename a) + ]} +*) +val rel_normalized_absolute_path : from:string -> string -> string + + +val normalize_absolute_path : string -> string + +val absolute_path : string Lazy.t -> string -> string + +(** [concat dirname filename] + The same as {!Filename.concat} except a tiny optimization + for current directory simplification +*) +val concat : string -> string -> string + +val check_suffix_case : + string -> string -> bool +end = struct +#1 "ext_path.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t = + | File of string + | Dir of string + + + + + + +let split_by_sep_per_os : string -> string list = + if Ext_sys.is_windows_or_cygwin then + fun x -> + (* on Windows, we can still accept -bs-package-output lib/js *) + Ext_string.split_by + (fun x -> match x with |'/' |'\\' -> true | _ -> false) x + else + fun x -> Ext_string.split x '/' + +(** example + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + ]} + + The other way + {[ + + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + ]} + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib//ocaml_array.ml" + ]} + {[ + /a/b + /c/d + ]} +*) +let node_relative_path + ~from:(file_or_dir_2 : t ) + (file_or_dir_1 : t) + = + let relevant_dir1 = + match file_or_dir_1 with + | Dir x -> x + | File file1 -> Filename.dirname file1 in + let relevant_dir2 = + match file_or_dir_2 with + | Dir x -> x + | File file2 -> Filename.dirname file2 in + let dir1 = split_by_sep_per_os relevant_dir1 in + let dir2 = split_by_sep_per_os relevant_dir2 in + let rec go (dir1 : string list) (dir2 : string list) = + match dir1, dir2 with + | "." :: xs, ys -> go xs ys + | xs , "." :: ys -> go xs ys + | x::xs , y :: ys when x = y + -> go xs ys + | _, _ -> + Ext_list.map_append dir2 dir1 (fun _ -> Literals.node_parent) + in + match go dir1 dir2 with + | (x :: _ ) as ys when x = Literals.node_parent -> + String.concat Literals.node_sep ys + | ys -> + String.concat Literals.node_sep + @@ Literals.node_current :: ys + + +let node_concat ~dir base = + dir ^ Literals.node_sep ^ base + +let node_rebase_file ~from ~to_ file = + + node_concat + ~dir:( + if from = to_ then Literals.node_current + else node_relative_path ~from:(Dir from) (Dir to_)) + file + + +(*** + {[ + Filename.concat "." "";; + "./" + ]} +*) +let combine path1 path2 = + if Filename.is_relative path2 then + if Ext_string.is_empty path2 then + path1 + else + if path1 = Filename.current_dir_name then + path2 + else + if path2 = Filename.current_dir_name + then path1 + else + Filename.concat path1 path2 + else + path2 + + +let chop_extension ?(loc="") name = + try Filename.chop_extension name + with Invalid_argument _ -> + Ext_pervasives.invalid_argf + "Filename.chop_extension ( %s : %s )" loc name + +let chop_extension_if_any fname = + try Filename.chop_extension fname with Invalid_argument _ -> fname + +let rec chop_all_extensions_if_any fname = + match Filename.chop_extension fname with + | x -> chop_all_extensions_if_any x + | exception _ -> fname + +let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos + + +let (//) x y = + if x = Filename.current_dir_name then y + else if y = Filename.current_dir_name then x + else Filename.concat x y + +(** + {[ + split_aux "//ghosg//ghsogh/";; + - : string * string list = ("/", ["ghosg"; "ghsogh"]) + ]} + Note that + {[ + Filename.dirname "/a/" = "/" + Filename.dirname "/a/b/" = Filename.dirname "/a/b" = "/a" + ]} + Special case: + {[ + basename "//" = "/" + basename "///" = "/" + ]} + {[ + basename "" = "." + basename "" = "." + dirname "" = "." + dirname "" = "." + ]} +*) +let split_aux p = + let rec go p acc = + let dir = Filename.dirname p in + if dir = p then dir, acc + else + let new_path = Filename.basename p in + if Ext_string.equal new_path Filename.dir_sep then + go dir acc + (* We could do more path simplification here + leave to [rel_normalized_absolute_path] + *) + else + go dir (new_path :: acc) + + in go p [] + + + + + +(** + TODO: optimization + if [from] and [to] resolve to the same path, a zero-length string is returned + + This function is useed in [es6-global] and + [amdjs-global] format and tailored for `rollup` +*) +let rel_normalized_absolute_path ~from to_ = + let root1, paths1 = split_aux from in + let root2, paths2 = split_aux to_ in + if root1 <> root2 then root2 + else + let rec go xss yss = + match xss, yss with + | x::xs, y::ys -> + if Ext_string.equal x y then go xs ys + else if x = Filename.current_dir_name then go xs yss + else if y = Filename.current_dir_name then go xss ys + else + let start = + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + Ext_list.fold_left yss start (fun acc v -> acc // v) + | [], [] -> Ext_string.empty + | [], y::ys -> Ext_list.fold_left ys y (fun acc x -> acc // x) + | x::xs, [] -> + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + let v = go paths1 paths2 in + + if Ext_string.is_empty v then Literals.node_current + else + if + v = "." + || v = ".." + || Ext_string.starts_with v "./" + || Ext_string.starts_with v "../" + then v + else "./" ^ v + +(*TODO: could be hgighly optimized later + {[ + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/a/b/../c../d/e/f";; + + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/gsho/./../..";; + + normalize_absolute_path "/a/b/c/d";; + + normalize_absolute_path "/a/b/c/d/";; + + normalize_absolute_path "/a/";; + + normalize_absolute_path "/a";; + ]} +*) +(** See tests in {!Ounit_path_tests} *) +let normalize_absolute_path x = + let drop_if_exist xs = + match xs with + | [] -> [] + | _ :: xs -> xs in + let rec normalize_list acc paths = + match paths with + | [] -> acc + | x :: xs -> + if Ext_string.equal x Ext_string.current_dir_lit then + normalize_list acc xs + else if Ext_string.equal x Ext_string.parent_dir_lit then + normalize_list (drop_if_exist acc ) xs + else + normalize_list (x::acc) xs + in + let root, paths = split_aux x in + let rev_paths = normalize_list [] paths in + let rec go acc rev_paths = + match rev_paths with + | [] -> Filename.concat root acc + | last::rest -> go (Filename.concat last acc ) rest in + match rev_paths with + | [] -> root + | last :: rest -> go last rest + + + + +let absolute_path cwd s = + let process s = + let s = + if Filename.is_relative s then + Lazy.force cwd // s + else s in + (* Now simplify . and .. components *) + let rec aux s = + let base,dir = Filename.basename s, Filename.dirname s in + if dir = s then dir + else if base = Filename.current_dir_name then aux dir + else if base = Filename.parent_dir_name then Filename.dirname (aux dir) + else aux dir // base + in aux s in + process s + + +let absolute cwd s = + match s with + | File x -> File (absolute_path cwd x ) + | Dir x -> Dir (absolute_path cwd x) + +let concat dirname filename = + if filename = Filename.current_dir_name then dirname + else if dirname = Filename.current_dir_name then filename + else Filename.concat dirname filename + + +let check_suffix_case = + Ext_string.ends_with +end +module Ext_modulename : sig +#1 "ext_modulename.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file : string -> string + + +val module_name_of_file_if_any : string -> string + +(** [modulename, upper] + if [upper = true] then it means it is indeed uppercase +*) +val module_name_of_file_if_any_with_upper : string -> string * bool + + +(** Given an JS bundle name, generate a meaningful + bounded module name +*) +val js_id_name_of_hint_name : string -> string +end = struct +#1 "ext_modulename.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 module_name_of_file file = + Ext_string.capitalize_ascii + (Filename.chop_extension @@ Filename.basename file) + +let module_name_of_file_if_any file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + Ext_string.capitalize_ascii v + +let module_name_of_file_if_any_with_upper file = + let v = Ext_path.chop_extension_if_any @@ Filename.basename file in + let res = Ext_string.capitalize_ascii v in + res, res == v + + + + +let good_hint_name module_name offset = + let len = String.length module_name in + len > offset && + (function | 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false) + (String.unsafe_get module_name offset) && + Ext_string.for_all_from module_name (offset + 1) + (function + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + -> true + | _ -> false) + +let rec collect_start buf s off len = + if off >= len then () + else + let next = succ off in + match String.unsafe_get s off with + | 'a' .. 'z' as c -> + Buffer.add_char buf (Ext_char.uppercase_ascii c) + ; + collect_next buf s next len + | 'A' .. 'Z' as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | _ -> collect_start buf s next len +and collect_next buf s off len = + if off >= len then () + else + let next = off + 1 in + match String.unsafe_get s off with + | 'a' .. 'z' + | 'A' .. 'Z' + | '0' .. '9' + | '_' + as c -> + Buffer.add_char buf c ; + collect_next buf s next len + | '.' + | '-' -> + collect_start buf s next len + | _ -> + collect_next buf s next len + +(** This is for a js exeternal module, we can change it when printing + for example + {[ + var React$1 = require('react'); + React$1.render(..) + ]} + Given a name, if duplicated, they should have the same id +*) +let js_id_name_of_hint_name module_name = + let i = Ext_string.rindex_neg module_name '/' in + if i >= 0 then + let offset = succ i in + if good_hint_name module_name offset then + Ext_string.capitalize_ascii + (Ext_string.tail_from module_name offset) + else + let str_len = String.length module_name in + let buf = Buffer.create str_len in + collect_start buf module_name offset str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then + Ext_string.capitalize_ascii module_name + else res + else + if good_hint_name module_name 0 then + Ext_string.capitalize_ascii module_name + else + let str_len = (String.length module_name) in + let buf = Buffer.create str_len in + collect_start buf module_name 0 str_len ; + let res = Buffer.contents buf in + if Ext_string.is_empty res then module_name + else res + +end +module Ext_ref : sig +#1 "ext_ref.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. *) + +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) + +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b + +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b + +end = struct +#1 "ext_ref.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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res + +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e + +end +module Js_config : sig +#1 "js_config.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 get_packages_info : + unit -> Js_packages_info.t *) + + +(** set/get header *) +val no_version_header : bool ref + + +(** return [package_name] and [path] + when in script mode: +*) + +(* val get_current_package_name_and_path : + Js_packages_info.module_system -> + Js_packages_info.info_query *) + + +(* val set_package_name : string -> unit +val get_package_name : unit -> string option *) + +(** cross module inline option *) +val cross_module_inline : bool ref +val set_cross_module_inline : bool -> unit +val get_cross_module_inline : unit -> bool + +(** diagnose option *) +val diagnose : bool ref +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit + + +(** options for builtin ppx *) +val no_builtin_ppx_ml : bool ref +val no_builtin_ppx_mli : bool ref + + + +val no_warn_unimplemented_external : bool ref + +(** check-div-by-zero option *) +val check_div_by_zero : bool ref +val get_check_div_by_zero : unit -> bool + + + + + +(** Debugging utilies *) +val set_current_file : string -> unit +val get_current_file : unit -> string +val get_module_name : unit -> string + +val iset_debug_file : string -> unit +val set_debug_file : string -> unit +val get_debug_file : unit -> string + +val is_same_file : unit -> bool + +val tool_name : string + + +val sort_imports : bool ref +val dump_js : bool ref +val syntax_only : bool ref +val binary_ast : bool ref + + +val bs_suffix : bool ref +val debug : bool ref + +val cmi_only : bool ref +val force_cmi : bool ref +val force_cmj : bool ref +end = struct +#1 "js_config.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 add_npm_package_path s = + match !packages_info with + | Empty -> + Ext_pervasives.bad_argf "please set package name first using -bs-package-name "; + | NonBrowser(name, envs) -> + let env, path = + match Ext_string.split ~keep_empty:false s ':' with + | [ package_name; path] -> + (match Js_packages_info.module_system_of_string package_name with + | Some x -> x + | None -> + Ext_pervasives.bad_argf "invalid module system %s" package_name), path + | [path] -> + NodeJS, path + | _ -> + Ext_pervasives.bad_argf "invalid npm package path: %s" s + in + packages_info := NonBrowser (name, ((env,path) :: envs)) *) +(** Browser is not set via command line only for internal use *) + + +let no_version_header = ref false + +let cross_module_inline = ref false + +let get_cross_module_inline () = !cross_module_inline +let set_cross_module_inline b = + cross_module_inline := b + + +let diagnose = ref false +let get_diagnose () = !diagnose +let set_diagnose b = diagnose := b + +let (//) = Filename.concat + +(* let get_packages_info () = !packages_info *) + +let no_builtin_ppx_ml = ref false +let no_builtin_ppx_mli = ref false + + +(** TODO: will flip the option when it is ready *) +let no_warn_unimplemented_external = ref false +let current_file = ref "" +let debug_file = ref "" + +let set_current_file f = current_file := f +let get_current_file () = !current_file +let get_module_name () = + Filename.chop_extension + (Filename.basename (Ext_string.uncapitalize_ascii !current_file)) + +let iset_debug_file _ = () +let set_debug_file f = debug_file := f +let get_debug_file () = !debug_file + + +let is_same_file () = + !debug_file <> "" && !debug_file = !current_file + +let tool_name = "BuckleScript" + +let check_div_by_zero = ref true +let get_check_div_by_zero () = !check_div_by_zero + + + + +let sort_imports = ref true +let dump_js = ref false + + + +let syntax_only = ref false +let binary_ast = ref false + +let bs_suffix = ref false + +let debug = ref false + +let cmi_only = ref false +let force_cmi = ref false +let force_cmj = ref false +end +module Ml_binary : sig +#1 "ml_binary.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. *) + + + +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind + + +val read_ast : 'a kind -> in_channel -> 'a + +val write_ast : + 'a kind -> string -> 'a -> out_channel -> unit +end = struct +#1 "ml_binary.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. *) + + +type _ kind = + | Ml : Parsetree.structure kind + | Mli : Parsetree.signature kind + +(** [read_ast kind ic] assume [ic] channel is + in the right position *) +let read_ast (type t ) (kind : t kind) ic : t = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + let buffer = really_input_string ic (String.length magic) in + assert(buffer = magic); (* already checked by apply_rewriter *) + Location.input_name := input_value ic; + input_value ic + +let write_ast (type t) (kind : t kind) + (fname : string) + (pt : t) oc = + let magic = + match kind with + | Ml -> Config.ast_impl_magic_number + | Mli -> Config.ast_intf_magic_number in + output_string oc magic ; + output_value oc fname; + output_value oc pt +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" + + (* not suporting nested if here..*) +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];; + +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + + +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@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 + + (** return the key found in the hashtbl. + Use case: when you find the key existed in hashtbl, + you want to use the one stored in the hashtbl. + (they are semantically equivlanent, but may have other information different) + *) + val find_key_opt: 'a t -> key -> key option + + val find_default: 'a t -> key -> 'a -> 'a + + val replace: 'a t -> key -> 'a -> unit + val mem: 'a t -> key -> bool + val iter: 'a t -> (key -> 'a -> unit) -> 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 h f = + 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 = + Ext_array.fold_left h.data 0 (fun m b -> max m (bucket_length 0 b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = bucket_length 0 b in + histo.(l) <- histo.(l) + 1) + ; + {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_key_opt eq key (lst : _ bucketlist) : _ option = + match lst with + | Empty -> None + | Cons(k1,d1,rest1) -> + if eq key k1 then Some k1 else + match rest1 with + | Empty -> None + | Cons(k2,d2,rest2) -> + if eq key k2 then Some k2 else + match rest2 with + | Empty -> None + | Cons(k3,d3,rest3) -> + if eq key k3 then Some k3 else + small_bucket_key_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 "ext/hashtbl.cppo.ml" +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 h_data = h.data in + Array.unsafe_set h_data i (Cons(key, info, (Array.unsafe_get h_data i))); + 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 + let h_data = h.data in + if find_bucket (Array.unsafe_get h_data i) then + begin + Array.unsafe_set h_data i (Cons(key,default (), Array.unsafe_get 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 rec remove_bucket key (h : _ t) (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 key h next) + +let remove (h : _ t ) key = + let i = key_index h key in + let h_data = h.data in + let old_h_szie = h.size in + let new_bucket = remove_bucket key h (Array.unsafe_get h_data i) in + if old_h_szie <> h.size then + Array.unsafe_set h_data i new_bucket + +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 Array.unsafe_get 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_key_opt (h : _ t) key = + Hashtbl_gen.small_bucket_key_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 (Array.unsafe_get 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 h_data = h.data in + let l = Array.unsafe_get h_data i in + try + Array.unsafe_set h_data i (replace_bucket l) + with Not_found -> + begin + Array.unsafe_set 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; + end + +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 (Array.unsafe_get h.data (key_index h key)) + + +let of_list2 ks vs = + let len = List.length ks in + let map = create len in + List.iter2 (fun k v -> add map k v) ks vs ; + map + + +end +module Map_gen += struct +#1 "map_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. *) +(* *) +(***********************************************************************) +(** adapted from stdlib *) + +type ('key,'a) t = + | Empty + | Node of ('key,'a) t * 'key * 'a * ('key,'a) t * int + +type ('key,'a) enumeration = + | End + | More of 'key * 'a * ('key,'a) t * ('key, 'a) enumeration + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec bindings_aux accu = function + | Empty -> accu + | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l + +let bindings s = + bindings_aux [] s + + +let rec fill_array_aux (s : _ t) i arr : int = + match s with + | Empty -> i + | Node (l,k,v,r,_) -> + let inext = fill_array_aux l i arr in + Array.unsafe_set arr inext (k,v); + fill_array_aux r (inext + 1) arr + +let to_sorted_array (s : ('key,'a) t) : ('key * 'a ) array = + match s with + | Empty -> [||] + | Node(l,k,v,r,_) -> + let len = + cardinal_aux (cardinal_aux 1 r) l in + let arr = + Array.make len (k,v) in + ignore (fill_array_aux s 0 arr : int); + arr +let rec keys_aux accu = function + Empty -> accu + | Node(l, v, _, r, _) -> keys_aux (v :: keys_aux accu r) l + +let keys s = keys_aux [] s + + + +let rec cons_enum m e = + match m with + Empty -> e + | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e)) + + +let height = function + | Empty -> 0 + | Node(_,_,_,_,h) -> h + +let create l x d r = + let hl = height l and hr = height r in + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let singleton x d = Node(Empty, x, d, Empty, 1) + +let bal l x d r = + let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> invalid_arg "Map.bal" + | Node(ll, lv, ld, lr, _) -> + if height ll >= height lr then + create ll lv ld (create lr x d r) + else begin + match lr with + Empty -> invalid_arg "Map.bal" + | Node(lrl, lrv, lrd, lrr, _)-> + create (create ll lv ld lrl) lrv lrd (create lrr x d r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> invalid_arg "Map.bal" + | Node(rl, rv, rd, rr, _) -> + if height rr >= height rl then + create (create l x d rl) rv rd rr + else begin + match rl with + Empty -> invalid_arg "Map.bal" + | Node(rll, rlv, rld, rlr, _) -> + create (create l x d rll) rlv rld (create rlr rv rd rr) + end + end else + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec min_binding_exn = function + Empty -> raise Not_found + | Node(Empty, x, d, r, _) -> (x, d) + | Node(l, x, d, r, _) -> min_binding_exn l + +let choose = min_binding_exn + +let rec max_binding_exn = function + Empty -> raise Not_found + | Node(l, x, d, Empty, _) -> (x, d) + | Node(l, x, d, r, _) -> max_binding_exn r + +let rec remove_min_binding = function + Empty -> invalid_arg "Map.remove_min_elt" + | Node(Empty, x, d, r, _) -> r + | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r + +let merge t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + bal t1 x d (remove_min_binding t2) + + +let rec iter x f = match x with + Empty -> () + | Node(l, v, d, r, _) -> + iter l f; f v d; iter r f + +let rec map x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = map l f in + let d' = f d in + let r' = map r f in + Node(l', v, d', r', h) + +let rec mapi x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = mapi l f in + let d' = f v d in + let r' = mapi r f in + Node(l', v, d', r', h) + +let rec fold m accu f = + match m with + Empty -> accu + | Node(l, v, d, r, _) -> + fold r (f v d (fold l accu f)) f + +let rec for_all x p = match x with + Empty -> true + | Node(l, v, d, r, _) -> p v d && for_all l p && for_all r p + +let rec exists x p = match x with + Empty -> false + | Node(l, v, d, r, _) -> p v d || exists l p || exists r p + +(* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal (add_min_binding k v l) x d r + +let rec add_max_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal l x d (add_max_binding k v r) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v d r = + match (l, r) with + (Empty, _) -> add_min_binding v d r + | (_, Empty) -> add_max_binding v d l + | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) -> + if lh > rh + 2 then bal ll lv ld (join lr v d r) else + if rh > lh + 2 then bal (join l v d rl) rv rd rr else + create l v d r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + join t1 x d (remove_min_binding t2) + +let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + +let rec filter x p = match x with + Empty -> Empty + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pvd = p v d in + let r' = filter r p in + if pvd then join l' v d r' else concat l' r' + +let rec partition x p = match x with + Empty -> (Empty, Empty) + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pvd = p v d in + let (rt, rf) = partition r p in + if pvd + then (join lt v d rt, concat lf rf) + else (concat lt rt, join lf v d rf) + +let compare compare_key cmp_val m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + let c = compare_key v1 v2 in + if c <> 0 then c else + let c = cmp_val d1 d2 in + if c <> 0 then c else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in compare_aux (cons_enum m1 End) (cons_enum m2 End) + +let equal compare_key cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + compare_key v1 v2 = 0 && cmp d1 d2 && + equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in equal_aux (cons_enum m1 End) (cons_enum m2 End) + + + + +module type S = + sig + type key + type +'a t + val empty: 'a t + val compare_key: key -> key -> int + val is_empty: 'a t -> bool + val mem: 'a t -> key -> bool + val to_sorted_array : + 'a t -> (key * 'a ) array + val add: 'a t -> key -> 'a -> 'a t + (** [add x y m] + If [x] was already bound in [m], its previous binding disappears. *) + val adjust: 'a t -> key -> ('a option-> 'a) -> 'a t + (** [adjust acc k replace ] if not exist [add (replace None ], otherwise + [add k v (replace (Some old))] + *) + val singleton: key -> 'a -> 'a t + + val remove: 'a t -> key -> 'a t + (** [remove x m] returns a map containing the same bindings as + [m], except for [x] which is unbound in the returned map. *) + + val merge: + 'a t -> 'b t -> + (key -> 'a option -> 'b option -> 'c option) -> 'c t + (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + and of [m2]. The presence of each such binding, and the corresponding + value, is determined with the function [f]. + @since 3.12.0 + *) + + val disjoint_merge : 'a t -> 'a t -> 'a t + (* merge two maps, will raise if they have the same key *) + val compare: 'a t -> 'a t -> ('a -> 'a -> int) -> int + (** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. *) + + val equal: 'a t -> 'a t -> ('a -> 'a -> bool) -> bool + + val iter: 'a t -> (key -> 'a -> unit) -> unit + (** [iter f m] applies [f] to all bindings in map [m]. + The bindings are passed to [f] in increasing order. *) + + val fold: 'a t -> 'b -> (key -> 'a -> 'b -> 'b) -> 'b + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1 ... kN] are the keys of all bindings in [m] + (in increasing order) *) + + val for_all: 'a t -> (key -> 'a -> bool) -> bool + (** [for_all p m] checks if all the bindings of the map. + order unspecified + *) + + val exists: 'a t -> (key -> 'a -> bool) -> bool + (** [exists p m] checks if at least one binding of the map + satisfy the predicate [p]. + order unspecified + *) + + val filter: 'a t -> (key -> 'a -> bool) -> 'a t + (** [filter p m] returns the map with all the bindings in [m] + that satisfy predicate [p]. + order unspecified + *) + + val partition: 'a t -> (key -> 'a -> bool) -> 'a t * 'a t + (** [partition p m] returns a pair of maps [(m1, m2)], where + [m1] contains all the bindings of [s] that satisfy the + predicate [p], and [m2] is the map with all the bindings of + [s] that do not satisfy [p]. + *) + + val cardinal: 'a t -> int + (** Return the number of bindings of a map. *) + + val bindings: 'a t -> (key * 'a) list + (** Return the list of all bindings of the given map. + The returned list is sorted in increasing order with respect + to the ordering *) + val keys : 'a t -> key list + (* Increasing order *) + + val min_binding_exn: 'a t -> (key * 'a) + (** raise [Not_found] if the map is empty. *) + + val max_binding_exn: 'a t -> (key * 'a) + (** Same as {!Map.S.min_binding} *) + + val choose: 'a t -> (key * 'a) + (** Return one binding of the given map, or raise [Not_found] if + the map is empty. Which binding is chosen is unspecified, + but equal bindings will be chosen for equal maps. + *) + + val split: 'a t -> key -> 'a t * 'a option * 'a t + (** [split x m] returns a triple [(l, data, r)], where + [l] is the map with all the bindings of [m] whose key + is strictly less than [x]; + [r] is the map with all the bindings of [m] whose key + is strictly greater than [x]; + [data] is [None] if [m] contains no binding for [x], + or [Some v] if [m] binds [v] to [x]. + @since 3.12.0 + *) + + val find_exn: 'a t -> key -> 'a + (** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. *) + val find_opt: 'a t -> key ->'a option + val find_default: 'a t -> key -> 'a -> 'a + val map: 'a t -> ('a -> 'b) -> 'b t + (** [map f m] returns a map with same domain as [m], where the + associated value [a] of all bindings of [m] has been + replaced by the result of the application of [f] to [a]. + The bindings are passed to [f] in increasing order + with respect to the ordering over the type of the keys. *) + + val mapi: 'a t -> (key -> 'a -> 'b) -> 'b t + (** Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. *) + + val of_list : (key * 'a) list -> 'a t + val of_array : (key * 'a ) array -> 'a t + val add_list : (key * 'b) list -> 'b t -> 'b t + + end + +end +module String_map : sig +#1 "string_map.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 Map_gen.S with type key = string + +end = struct +#1 "string_map.ml" + +# 2 "ext/map.cppo.ml" +(* we don't create [map_poly], since some operations require raise an exception which carries [key] *) + + + +# 10 "ext/map.cppo.ml" + type key = string + let compare_key = Ext_string.compare + +# 22 "ext/map.cppo.ml" +type 'a t = (key,'a) Map_gen.t +exception Duplicate_key of key + +let empty = Map_gen.empty +let is_empty = Map_gen.is_empty +let iter = Map_gen.iter +let fold = Map_gen.fold +let for_all = Map_gen.for_all +let exists = Map_gen.exists +let singleton = Map_gen.singleton +let cardinal = Map_gen.cardinal +let bindings = Map_gen.bindings +let to_sorted_array = Map_gen.to_sorted_array +let keys = Map_gen.keys +let choose = Map_gen.choose +let partition = Map_gen.partition +let filter = Map_gen.filter +let map = Map_gen.map +let mapi = Map_gen.mapi +let bal = Map_gen.bal +let height = Map_gen.height +let max_binding_exn = Map_gen.max_binding_exn +let min_binding_exn = Map_gen.min_binding_exn + + +let rec add (tree : _ Map_gen.t as 'a) x data : 'a = match tree with + | Empty -> + Node(Empty, x, data, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, data, r, h) + else if c < 0 then + bal (add l x data ) v d r + else + bal l v d (add r x data ) + + +let rec adjust (tree : _ Map_gen.t as 'a) x replace : 'a = + match tree with + | Empty -> + Node(Empty, x, replace None, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, replace (Some d) , r, h) + else if c < 0 then + bal (adjust l x replace ) v d r + else + bal l v d (adjust r x replace ) + + +let rec find_exn (tree : _ Map_gen.t ) x = match tree with + | Empty -> + raise Not_found + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_exn (if c < 0 then l else r) x + +let rec find_opt (tree : _ Map_gen.t ) x = match tree with + | Empty -> None + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then Some d + else find_opt (if c < 0 then l else r) x + +let rec find_default (tree : _ Map_gen.t ) x default = match tree with + | Empty -> default + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_default (if c < 0 then l else r) x default + +let rec mem (tree : _ Map_gen.t ) x= match tree with + | Empty -> + false + | Node(l, v, d, r, _) -> + let c = compare_key x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : _ Map_gen.t as 'a) x : 'a = match tree with + | Empty -> + Empty + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Map_gen.merge l r + else if c < 0 then + bal (remove l x) v d r + else + bal l v d (remove r x ) + + +let rec split (tree : _ Map_gen.t as 'a) x : 'a * _ option * 'a = match tree with + | Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Map_gen.join rl v d r) + else + let (lr, pres, rr) = split r x in (Map_gen.join l v d lr, pres, rr) + +let rec merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) f : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split s2 v1 in + Map_gen.concat_or_join (merge l1 l2 f) v1 (f v1 (Some d1) d2) (merge r1 r2 f) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split s1 v2 in + Map_gen.concat_or_join (merge l1 l2 f) v2 (f v2 d1 (Some d2)) (merge r1 r2 f) + | _ -> + assert false + +let rec disjoint_merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + begin match split s2 v1 with + | l2, None, r2 -> + Map_gen.join (disjoint_merge l1 l2) v1 d1 (disjoint_merge r1 r2) + | _, Some _, _ -> + raise (Duplicate_key v1) + end + | (_, Node (l2, v2, d2, r2, h2)) -> + begin match split s1 v2 with + | (l1, None, r1) -> + Map_gen.join (disjoint_merge l1 l2) v2 d2 (disjoint_merge r1 r2) + | (_, Some _, _) -> + raise (Duplicate_key v2) + end + | _ -> + assert false + + + +let compare m1 m2 cmp = Map_gen.compare compare_key cmp m1 m2 + +let equal m1 m2 cmp = Map_gen.equal compare_key cmp m1 m2 + +let add_list (xs : _ list ) init = + Ext_list.fold_left xs init (fun acc (k,v) -> add acc k v ) + +let of_list xs = add_list xs empty + +let of_array xs = + Ext_array.fold_left xs empty (fun acc (k,v) -> add acc k v ) + +end +module Ast_extract : sig +#1 "ast_extract.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. *) + + + + + + + + + +module String_set = Depend.StringSet + +val read_parse_and_extract : 'a Ml_binary.kind -> 'a -> String_set.t + +type ('a,'b) t + +val sort_files_by_dependencies : + domain:String_set.t -> String_set.t String_map.t -> string Queue.t + + +val sort : + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + ('a, 'b) t String_map.t -> string Queue.t + + + +(** + [build fmt files parse_implementation parse_interface] + Given a list of files return an ast table +*) +val collect_ast_map : + Format.formatter -> + string list -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a, 'b) t String_map.t + +type dir_spec = + { dir : string ; + mutable excludes : string list + } + +(** If the genereated queue is empty, it means + 1. The main module does not exist (does not exist due to typo) + 2. It does exist but not in search path + The order matters from head to tail +*) +val collect_from_main : + ?extra_dirs:dir_spec list -> + ?excludes : string list -> + ?alias_map: string String_hashtbl.t -> + Format.formatter -> + (Format.formatter -> string -> 'a) -> + (Format.formatter -> string -> 'b) -> + ('a -> Parsetree.structure) -> + ('b -> Parsetree.signature) -> + string -> ('a, 'b) t String_map.t * string Queue.t + +val build_queue : + Format.formatter -> + string Queue.t -> + ('b, 'c) t String_map.t -> + (Format.formatter -> string -> string -> 'b -> unit) -> + (Format.formatter -> string -> string -> 'c -> unit) -> unit + +val handle_queue : + Format.formatter -> + string Queue.t -> + ('a, 'b) t String_map.t -> + (string -> string -> 'a -> unit) -> + (string -> string -> 'b -> unit) -> + (string -> string -> string -> 'b -> 'a -> unit) -> unit + + +val build_lazy_queue : + Format.formatter -> + string Queue.t -> + (Parsetree.structure lazy_t, Parsetree.signature lazy_t) t String_map.t -> + (Format.formatter -> string -> string -> Parsetree.structure -> unit) -> + (Format.formatter -> string -> string -> Parsetree.signature -> unit) -> unit + + + +end = struct +#1 "ast_extract.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. *) + +type module_name = private string + +module String_set = Depend.StringSet + +(* FIXME: [Clflags.open_modules] seems not to be properly used *) + +module SMap = Depend.StringMap +let bound_vars = SMap.empty + + +type 'a kind = 'a Ml_binary.kind + + +let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = + Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> + List.iter + (fun modname -> + + ignore @@ + + Depend.open_module bound_vars (Longident.Lident modname)) + (!Clflags.open_modules); + (match k with + | Ml_binary.Ml -> Depend.add_implementation bound_vars ast + | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); + !Depend.free_structure_names + end + +type ('a,'b) ast_info = + | Ml of + string * (* sourcefile *) + 'a * + string (* opref *) + | Mli of string * (* sourcefile *) + 'b * + string (* opref *) + | Ml_mli of + string * (* sourcefile *) + 'a * + string * (* opref1 *) + string * (* sourcefile *) + 'b * + string (* opref2*) + +type ('a,'b) t = + { module_name : string ; ast_info : ('a,'b) ast_info } + + +(* only visit nodes that are currently in the domain *) +(* https://en.wikipedia.org/wiki/Topological_sorting *) +(* dfs *) +let sort_files_by_dependencies ~(domain : String_set.t) (dependency_graph : String_set.t String_map.t) : + string Queue.t = + let next current = + String_map.find_exn dependency_graph current in + let worklist = ref domain in + let result = Queue.create () in + let rec visit (visiting : String_set.t) path (current : string) = + let next_path = current :: path in + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends next_path) + else if String_set.mem current !worklist then + begin + let next_set = String_set.add current visiting in + next current |> + String_set.iter + (fun node -> + if String_map.mem dependency_graph node then + visit next_set next_path node) + ; + worklist := String_set.remove current !worklist; + Queue.push current result ; + end in + while not (String_set.is_empty !worklist) do + visit String_set.empty [] (String_set.choose !worklist) + done; + if Js_config.get_diagnose () then + Format.fprintf Format.err_formatter + "Order: @[%a@]@." + (Ext_format.pp_print_queue + ~pp_sep:Format.pp_print_space + Format.pp_print_string) + result ; + result +;; + + + +let sort project_ml project_mli (ast_table : _ t String_map.t) = + let domain = + String_map.fold ast_table String_set.empty + (fun k _ acc -> String_set.add k acc) + in + let h = + String_map.map ast_table + (fun + ({ast_info}) + -> + match ast_info with + | Ml (_, ast, _) + -> + read_parse_and_extract Ml (project_ml ast) + | Mli (_, ast, _) + -> + read_parse_and_extract Mli (project_mli ast) + | Ml_mli (_, impl, _, _, intf, _) + -> + String_set.union + (read_parse_and_extract Ml (project_ml impl)) + (read_parse_and_extract Mli (project_mli intf)) + ) in + sort_files_by_dependencies ~domain h + +(** same as {!Ocaml_parse.check_suffix} but does not care with [-c -o] option*) +let check_suffix name = + if Ext_path.check_suffix_case name ".ml" + || Ext_path.check_suffix_case name ".mlt" then + `Ml, + Ext_path.chop_extension_if_any name + else if Ext_path.check_suffix_case name !Config.interface_suffix then + `Mli, Ext_path.chop_extension_if_any name + else + raise(Arg.Bad("don't know what to do with " ^ name)) + + +let collect_ast_map ppf files parse_implementation parse_interface = + Ext_list.fold_left files String_map.empty + (fun acc source_file -> + match check_suffix source_file with + | `Ml, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = + (Ml (source_file, parse_implementation + ppf source_file, opref)); + module_name ; + } + | {ast_info = (Ml (source_file2, _, _) + | Ml_mli(source_file2, _, _,_,_,_))} -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Mli (source_file2, intf, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli (source_file, + parse_implementation ppf source_file, + opref, + source_file2, + intf, + opref2 + ); + module_name} + end + | `Mli, opref -> + let module_name = Ext_modulename.module_name_of_file source_file in + begin match String_map.find_exn acc module_name with + | exception Not_found -> + String_map.add acc module_name + {ast_info = (Mli (source_file, parse_interface + ppf source_file, opref)); + module_name } + | {ast_info = + (Mli (source_file2, _, _) | + Ml_mli(_,_,_,source_file2,_,_)) } -> + Bs_exception.error + (Bs_duplicated_module (source_file, source_file2)) + | {ast_info = Ml (source_file2, impl, opref2)} + -> + String_map.add acc module_name + {ast_info = + Ml_mli + (source_file2, + impl, + opref2, + source_file, + parse_interface ppf source_file, + opref + ); + module_name} + end + ) +;; +type dir_spec = + { dir : string ; + mutable excludes : string list + } + +let collect_from_main + ?(extra_dirs=[]) + ?(excludes=[]) + ?alias_map + (ppf : Format.formatter) + parse_implementation + parse_interface + project_impl + project_intf + main_module = + let files = + Ext_list.fold_left extra_dirs [] (fun acc dir_spec -> + let dirname, excludes = + match dir_spec with + | { dir = dirname; excludes = dir_excludes} -> + (* dirname, excludes *) + (* | `Dir_with_excludes (dirname, dir_excludes) -> *) + dirname, + (Ext_list.flat_map_append + dir_excludes excludes + (fun x -> [x ^ ".ml" ; x ^ ".mli" ]) + ) + in + Ext_array.fold_left (Sys.readdir dirname) acc (fun acc source_file -> + if (Ext_string.ends_with source_file ".ml" || + Ext_string.ends_with source_file ".mli" ) + && (* not_excluded source_file *) (not (List.mem source_file excludes)) + then + (Filename.concat dirname source_file) :: acc else acc + ) ) + in + let ast_table = collect_ast_map ppf files parse_implementation parse_interface in + let visited = String_hashtbl.create 31 in + let result = Queue.create () in + let next module_name : String_set.t = + let module_set = + match String_map.find_exn ast_table module_name with + | exception _ -> String_set.empty + | {ast_info = Ml (_, impl, _)} -> + read_parse_and_extract Ml (project_impl impl) + | {ast_info = Mli (_, intf,_)} -> + read_parse_and_extract Mli (project_intf intf) + | {ast_info = Ml_mli(_, impl, _, _, intf, _)} + -> + String_set.union + (read_parse_and_extract Ml (project_impl impl)) + (read_parse_and_extract Mli (project_intf intf)) + in + match alias_map with + | None -> module_set + | Some map -> + String_set.fold (fun x acc -> String_set.add (String_hashtbl.find_default map x x) acc ) module_set String_set.empty + in + let rec visit visiting path current = + if String_set.mem current visiting then + Bs_exception.error (Bs_cyclic_depends (current::path)) + else + if not (String_hashtbl.mem visited current) + && String_map.mem ast_table current then + begin + String_set.iter + (visit + (String_set.add current visiting) + (current::path)) + (next current) ; + Queue.push current result; + String_hashtbl.add visited current (); + end in + visit (String_set.empty) [] main_module ; + ast_table, result + + +let build_queue ppf queue + (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue + |> Queue.iter + (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,ast, opref)} + -> + after_parsing_impl ppf source_file + opref ast + | {ast_info = Mli (source_file,ast,opref) ; } + -> + after_parsing_sig ppf source_file + opref ast + | {ast_info = Ml_mli(source_file1,impl,opref1,source_file2,intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +let handle_queue + ppf + queue ast_table + decorate_module_only + decorate_interface_only + decorate_module = + queue + |> Queue.iter + (fun base -> + match (String_map.find_exn ast_table base ).ast_info with + | exception Not_found -> assert false + | Ml (ml_name, ml_content, _) + -> + decorate_module_only base ml_name ml_content + | Mli (mli_name , mli_content, _) -> + decorate_interface_only base mli_name mli_content + | Ml_mli (ml_name, ml_content, _, mli_name, mli_content, _) + -> + decorate_module base mli_name ml_name mli_content ml_content + + ) + + + +let build_lazy_queue ppf queue (ast_table : _ t String_map.t) + after_parsing_impl + after_parsing_sig + = + queue |> Queue.iter (fun modname -> + match String_map.find_exn ast_table modname with + | {ast_info = Ml(source_file,lazy ast, opref)} + -> + after_parsing_impl ppf source_file opref ast + | {ast_info = Mli (source_file,lazy ast,opref) ; } + -> + after_parsing_sig ppf source_file opref ast + | {ast_info = Ml_mli(source_file1,lazy impl,opref1,source_file2,lazy intf,opref2)} + -> + after_parsing_sig ppf source_file1 opref1 intf ; + after_parsing_impl ppf source_file2 opref2 impl + | exception Not_found -> assert false + ) + + +end +module Ext_io : sig +#1 "ext_io.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 load_file : string -> string + +val rev_lines_of_file : string -> string list + +val write_file : string -> string -> unit + +end = struct +#1 "ext_io.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. *) + + +(** on 32 bit , there are 16M limitation *) +let load_file f = + Ext_pervasives.finally (open_in_bin f) close_in begin fun ic -> + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + Bytes.unsafe_to_string s + end + + +let rev_lines_of_file file = + Ext_pervasives.finally (open_in_bin file) close_in begin fun chan -> + let rec loop acc = + match input_line chan with + | line -> loop (line :: acc) + | exception End_of_file -> close_in chan ; acc in + loop [] + end + +let write_file f content = + Ext_pervasives.finally (open_out_bin f) close_out begin fun oc -> + output_string oc content + end + +end +module Docstrings : sig +#1 "docstrings.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Leo White *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Documentation comments *) + +(** (Re)Initialise all docstring state *) +val init : unit -> unit + +(** Emit warnings for unattached and ambiguous docstrings *) +val warn_bad_docstrings : unit -> unit + +(** {2 Docstrings} *) + +(** Documentation comments *) +type docstring + +(** Create a docstring *) +val docstring : string -> Location.t -> docstring + +(** Register a docstring *) +val register : docstring -> unit + +(** Get the text of a docstring *) +val docstring_body : docstring -> string + +(** Get the location of a docstring *) +val docstring_loc : docstring -> Location.t + +(** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + +(** Docstrings immediately preceding a token *) +val set_pre_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately following a token *) +val set_post_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings not immediately adjacent to a token *) +val set_floating_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately following the token which precedes this one *) +val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately preceding the token which follows this one *) +val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + +(** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + +type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + +val empty_docs : docs + +val docs_attr : docstring -> Parsetree.attribute + +(** Convert item documentation to attributes and add them to an + attribute list *) +val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) +val symbol_docs : unit -> docs +val symbol_docs_lazy : unit -> docs Lazy.t + +(** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) +val rhs_docs : int -> int -> docs +val rhs_docs_lazy : int -> int -> docs Lazy.t + +(** Mark the item documentation for the current symbol (for ambiguity + warnings). *) +val mark_symbol_docs : unit -> unit + +(** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) +val mark_rhs_docs : int -> int -> unit + +(** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + +type info = docstring option + +val empty_info : info + +val info_attr : docstring -> Parsetree.attribute + +(** Convert field info to attributes and add them to an + attribute list *) +val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the field info for the current symbol. *) +val symbol_info : unit -> info + +(** Fetch the field info following the symbol at a given position. *) +val rhs_info : int -> info + +(** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + +type text = docstring list + +val empty_text : text +val empty_text_lazy : text Lazy.t + +val text_attr : docstring -> Parsetree.attribute + +(** Convert text to attributes and add them to an attribute list *) +val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the text preceding the current symbol. *) +val symbol_text : unit -> text +val symbol_text_lazy : unit -> text Lazy.t + +(** Fetch the text preceding the symbol at the given position. *) +val rhs_text : int -> text +val rhs_text_lazy : int -> text Lazy.t + +(** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + +(** Fetch additional text preceding the current symbol *) +val symbol_pre_extra_text : unit -> text + +(** Fetch additional text following the current symbol *) +val symbol_post_extra_text : unit -> text + +(** Fetch additional text preceding the symbol at the given position *) +val rhs_pre_extra_text : int -> text + +(** Fetch additional text following the symbol at the given position *) +val rhs_post_extra_text : int -> text + +end = struct +#1 "docstrings.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Leo White *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Location + +(* Docstrings *) + +(* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) +type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + +(* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) +type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + +type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + +(* List of docstrings *) + +let docstrings : docstring list ref = ref [] + +(* Warn for unused and ambiguous docstrings *) + +let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) +end + +(* Docstring constructors and destructors *) + +let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + +let register ds = + docstrings := ds :: !docstrings + +let docstring_body ds = ds.ds_body + +let docstring_loc ds = ds.ds_loc + +(* Docstrings attached to items *) + +type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + +let empty_docs = { docs_pre = None; docs_post = None } + +let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + +let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + +let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + +(* Docstrings attached to constructors or fields *) + +type info = docstring option + +let empty_info = None + +let info_attr = docs_attr + +let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + +(* Docstrings not attached to a specific item *) + +type text = docstring list + +let empty_text = [] +let empty_text_lazy = lazy [] + +let text_loc = {txt = "ocaml.text"; loc = Location.none} + +let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + +let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +(* Find the first non-info docstring in a list, attach it and return it *) +let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + +(* Find all the non-info docstrings in a list, attach them and return them *) +let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + +(* "Associate" all the docstrings in a list *) +let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + +(* Map from positions to pre docstrings *) + +let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + +let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + +let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + +(* Map from positions to post docstrings *) + +let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + +let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + +let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + +let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + +(* Map from positions to floating docstrings *) + +let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + +let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + +(* Maps from positions to extra docstrings *) + +let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + +let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + +let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + +let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + +(* Docstrings from parser actions *) + +let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + +let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + +let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + +let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + +let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + +let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + +let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + +let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + +let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + +let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + +let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + +let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + +let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + +let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + +let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + +let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + + +(* (Re)Initialise all comment state *) + +let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table + +end +module Syntaxerr : sig +#1 "syntaxerr.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Auxiliary type for reporting syntax errors *) + +open Format + +type error = + Unclosed of Location.t * string * Location.t * string + | Expecting of Location.t * string + | Not_expecting of Location.t * string + | Applicative_path of Location.t + | Variable_in_scope of Location.t * string + | Other of Location.t + | Ill_formed_ast of Location.t * string + | Invalid_package_type of Location.t * string + +exception Error of error +exception Escape_error + +val report_error: formatter -> error -> unit + (** @deprecated Use {!Location.error_of_exn}, {!Location.report_error}. *) + +val location_of_error: error -> Location.t +val ill_formed_ast: Location.t -> string -> 'a + +end = struct +#1 "syntaxerr.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Auxiliary type for reporting syntax errors *) + +type error = + Unclosed of Location.t * string * Location.t * string + | Expecting of Location.t * string + | Not_expecting of Location.t * string + | Applicative_path of Location.t + | Variable_in_scope of Location.t * string + | Other of Location.t + | Ill_formed_ast of Location.t * string + | Invalid_package_type of Location.t * string + +exception Error of error +exception Escape_error + +let prepare_error = function + | Unclosed(opening_loc, opening, closing_loc, closing) -> + Location.errorf ~loc:closing_loc + ~sub:[ + Location.errorf ~loc:opening_loc + "This '%s' might be unmatched" opening + ] + ~if_highlight: + (Printf.sprintf "Syntax error: '%s' expected, \ + the highlighted '%s' might be unmatched" + closing opening) + "Syntax error: '%s' expected" closing + + | Expecting (loc, nonterm) -> + Location.errorf ~loc "Syntax error: %s expected." nonterm + | Not_expecting (loc, nonterm) -> + Location.errorf ~loc "Syntax error: %s not expected." nonterm + | Applicative_path loc -> + Location.errorf ~loc + "Syntax error: applicative paths of the form F(X).t \ + are not supported when the option -no-app-func is set." + | Variable_in_scope (loc, var) -> + Location.errorf ~loc + "In this scoped type, variable '%s \ + is reserved for the local type %s." + var var + | Other loc -> + Location.errorf ~loc "Syntax error" + | Ill_formed_ast (loc, s) -> + Location.errorf ~loc "broken invariant in parsetree: %s" s + | Invalid_package_type (loc, s) -> + Location.errorf ~loc "invalid package type: %s" s + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (prepare_error err) + | _ -> None + ) + + +let report_error ppf err = + Location.report_error ppf (prepare_error err) + +let location_of_error = function + | Unclosed(l,_,_,_) + | Applicative_path l + | Variable_in_scope(l,_) + | Other l + | Not_expecting (l, _) + | Ill_formed_ast (l, _) + | Invalid_package_type (l, _) + | Expecting (l, _) -> l + + +let ill_formed_ast loc s = + raise (Error (Ill_formed_ast (loc, s))) + +end +module Ast_helper : sig +#1 "ast_helper.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Helpers to produce Parsetree fragments *) + +open Asttypes +open Docstrings +open Parsetree + +type lid = Longident.t loc +type str = string loc +type loc = Location.t +type attrs = attribute list + +(** {1 Default locations} *) + +val default_loc: loc ref + (** Default value for all optional location arguments. *) + +val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + +(** {1 Constants} *) + +module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant +end + +(** {1 Core language} *) + +(** Type expressions *) +module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + +(** Patterns *) +module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + +(** Expressions *) +module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + +(** Value declarations *) +module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + +(** Type declarations *) +module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + +(** Type extensions *) +module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + +(** {1 Module language} *) + +(** Module type expressions *) +module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + +(** Module expressions *) +module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + +(** Signature items *) +module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + +(** Structure items *) +module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + +(** Module declarations *) +module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + +(** Module type declarations *) +module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + +(** Module bindings *) +module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + +(** Opens *) +module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + +(** Includes *) +module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + +(** Value bindings *) +module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + +(** {1 Class language} *) + +(** Class type expressions *) +module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type + -> class_type + end + +(** Class type fields *) +module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + +(** Class expressions *) +module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr + -> class_expr + end + +(** Class fields *) +module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + +(** Classes *) +module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + +(** Class signatures *) +module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + +(** Class structures *) +module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct +#1 "ast_helper.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Helpers to produce Parsetree fragments *) + +open Asttypes +open Parsetree +open Docstrings + +type lid = Longident.t loc +type str = string loc +type loc = Location.t +type attrs = attribute list + +let default_loc = ref Location.none + +let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + +module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) +end + +module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field = + function + | Rtag(label,attrs,flag,lst) -> + Rtag(label,attrs,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + and loop_object_field = + function + | Otag(label, attrs, t) -> + Otag(label, attrs, loop t) + | Oinherit t -> + Oinherit (loop t) + in + loop t + +end + +module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) +end + +module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } +end + +module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) +end + +module Mod = struct +let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) +end + +module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt +end + +module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt +end + +module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) +end + +module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) +end + +module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + +end + +module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + +end + +module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } +end + +module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } +end + +module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } +end + +module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } +end + +module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } +end + +module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + +end + +module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } +end + +module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } +end + +module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + +end + +(** Type extensions *) +module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + +end + +module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } +end + +module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } +end + +end +module Parser : sig +#1 "parser.mli" +type token = + | AMPERAMPER + | AMPERSAND + | AND + | AS + | ASSERT + | BACKQUOTE + | BANG + | BAR + | BARBAR + | BARRBRACKET + | BEGIN + | CHAR of (char) + | CLASS + | COLON + | COLONCOLON + | COLONEQUAL + | COLONGREATER + | COMMA + | CONSTRAINT + | DO + | DONE + | DOT + | DOTDOT + | DOWNTO + | ELSE + | END + | EOF + | EQUAL + | EXCEPTION + | EXTERNAL + | FALSE + | FLOAT of (string * char option) + | FOR + | FUN + | FUNCTION + | FUNCTOR + | GREATER + | GREATERRBRACE + | GREATERRBRACKET + | IF + | IN + | INCLUDE + | INFIXOP0 of (string) + | INFIXOP1 of (string) + | INFIXOP2 of (string) + | INFIXOP3 of (string) + | INFIXOP4 of (string) + | DOTOP of (string) + | INHERIT + | INITIALIZER + | INT of (string * char option) + | LABEL of (string) + | LAZY + | LBRACE + | LBRACELESS + | LBRACKET + | LBRACKETBAR + | LBRACKETLESS + | LBRACKETGREATER + | LBRACKETPERCENT + | LBRACKETPERCENTPERCENT + | LESS + | LESSMINUS + | LET + | LIDENT of (string) + | LPAREN + | LBRACKETAT + | LBRACKETATAT + | LBRACKETATATAT + | MATCH + | METHOD + | MINUS + | MINUSDOT + | MINUSGREATER + | MODULE + | MUTABLE + | NEW + | NONREC + | OBJECT + | OF + | OPEN + | OPTLABEL of (string) + | OR + | PERCENT + | PLUS + | PLUSDOT + | PLUSEQ + | PREFIXOP of (string) + | PRIVATE + | QUESTION + | QUOTE + | RBRACE + | RBRACKET + | REC + | RPAREN + | SEMI + | SEMISEMI + | HASH + | HASHOP of (string) + | SIG + | STAR + | STRING of (string * string option) + | STRUCT + | THEN + | TILDE + | TO + | TRUE + | TRY + | TYPE + | UIDENT of (string) + | UNDERSCORE + | VAL + | VIRTUAL + | WHEN + | WHILE + | WITH + | COMMENT of (string * Location.t) + | DOCSTRING of (Docstrings.docstring) + | EOL + +val implementation : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.structure +val interface : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.signature +val toplevel_phrase : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.toplevel_phrase +val use_file : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.toplevel_phrase list +val parse_core_type : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.core_type +val parse_expression : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.expression +val parse_pattern : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Parsetree.pattern + +end = struct +#1 "parser.ml" +type token = + | AMPERAMPER + | AMPERSAND + | AND + | AS + | ASSERT + | BACKQUOTE + | BANG + | BAR + | BARBAR + | BARRBRACKET + | BEGIN + | CHAR of (char) + | CLASS + | COLON + | COLONCOLON + | COLONEQUAL + | COLONGREATER + | COMMA + | CONSTRAINT + | DO + | DONE + | DOT + | DOTDOT + | DOWNTO + | ELSE + | END + | EOF + | EQUAL + | EXCEPTION + | EXTERNAL + | FALSE + | FLOAT of (string * char option) + | FOR + | FUN + | FUNCTION + | FUNCTOR + | GREATER + | GREATERRBRACE + | GREATERRBRACKET + | IF + | IN + | INCLUDE + | INFIXOP0 of (string) + | INFIXOP1 of (string) + | INFIXOP2 of (string) + | INFIXOP3 of (string) + | INFIXOP4 of (string) + | DOTOP of (string) + | INHERIT + | INITIALIZER + | INT of (string * char option) + | LABEL of (string) + | LAZY + | LBRACE + | LBRACELESS + | LBRACKET + | LBRACKETBAR + | LBRACKETLESS + | LBRACKETGREATER + | LBRACKETPERCENT + | LBRACKETPERCENTPERCENT + | LESS + | LESSMINUS + | LET + | LIDENT of (string) + | LPAREN + | LBRACKETAT + | LBRACKETATAT + | LBRACKETATATAT + | MATCH + | METHOD + | MINUS + | MINUSDOT + | MINUSGREATER + | MODULE + | MUTABLE + | NEW + | NONREC + | OBJECT + | OF + | OPEN + | OPTLABEL of (string) + | OR + | PERCENT + | PLUS + | PLUSDOT + | PLUSEQ + | PREFIXOP of (string) + | PRIVATE + | QUESTION + | QUOTE + | RBRACE + | RBRACKET + | REC + | RPAREN + | SEMI + | SEMISEMI + | HASH + | HASHOP of (string) + | SIG + | STAR + | STRING of (string * string option) + | STRUCT + | THEN + | TILDE + | TO + | TRUE + | TRY + | TYPE + | UIDENT of (string) + | UNDERSCORE + | VAL + | VIRTUAL + | WHEN + | WHILE + | WITH + | COMMENT of (string * Location.t) + | DOCSTRING of (Docstrings.docstring) + | EOL + +open Parsing;; +let _ = parse_error;; +# 19 "parsing/parser.mly" +open Location +open Asttypes +open Longident +open Parsetree +open Ast_helper +open Docstrings + +let mktyp d = Typ.mk ~loc:(symbol_rloc()) d +let mkpat d = Pat.mk ~loc:(symbol_rloc()) d +let mkexp d = Exp.mk ~loc:(symbol_rloc()) d +let mkmty ?attrs d = Mty.mk ~loc:(symbol_rloc()) ?attrs d +let mksig d = Sig.mk ~loc:(symbol_rloc()) d +let mkmod ?attrs d = Mod.mk ~loc:(symbol_rloc()) ?attrs d +let mkstr d = Str.mk ~loc:(symbol_rloc()) d +let mkclass ?attrs d = Cl.mk ~loc:(symbol_rloc()) ?attrs d +let mkcty ?attrs d = Cty.mk ~loc:(symbol_rloc()) ?attrs d +let mkctf ?attrs ?docs d = + Ctf.mk ~loc:(symbol_rloc()) ?attrs ?docs d +let mkcf ?attrs ?docs d = + Cf.mk ~loc:(symbol_rloc()) ?attrs ?docs d + +let mkrhs rhs pos = mkloc rhs (rhs_loc pos) + +let reloc_pat x = { x with ppat_loc = symbol_rloc () };; +let reloc_exp x = { x with pexp_loc = symbol_rloc () };; + +let mkoperator name pos = + let loc = rhs_loc pos in + Exp.mk ~loc (Pexp_ident(mkloc (Lident name) loc)) + +let mkpatvar name pos = + Pat.mk ~loc:(rhs_loc pos) (Ppat_var (mkrhs name pos)) + +(* + Ghost expressions and patterns: + expressions and patterns that do not appear explicitly in the + source file they have the loc_ghost flag set to true. + Then the profiler will not try to instrument them and the + -annot option will not try to display their type. + + Every grammar rule that generates an element with a location must + make at most one non-ghost element, the topmost one. + + How to tell whether your location must be ghost: + A location corresponds to a range of characters in the source file. + If the location contains a piece of code that is syntactically + valid (according to the documentation), and corresponds to the + AST node, then the location must be real; in all other cases, + it must be ghost. +*) +let ghexp d = Exp.mk ~loc:(symbol_gloc ()) d +let ghpat d = Pat.mk ~loc:(symbol_gloc ()) d +let ghtyp d = Typ.mk ~loc:(symbol_gloc ()) d +let ghloc d = { txt = d; loc = symbol_gloc () } +let ghstr d = Str.mk ~loc:(symbol_gloc()) d +let ghsig d = Sig.mk ~loc:(symbol_gloc()) d + +let mkinfix arg1 name arg2 = + mkexp(Pexp_apply(mkoperator name 2, [Nolabel, arg1; Nolabel, arg2])) + +let neg_string f = + if String.length f > 0 && f.[0] = '-' + then String.sub f 1 (String.length f - 1) + else "-" ^ f + +let mkuminus name arg = + match name, arg.pexp_desc with + | "-", Pexp_constant(Pconst_integer (n,m)) -> + mkexp(Pexp_constant(Pconst_integer(neg_string n,m))) + | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) -> + mkexp(Pexp_constant(Pconst_float(neg_string f, m))) + | _ -> + mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg])) + +let mkuplus name arg = + let desc = arg.pexp_desc in + match name, desc with + | "+", Pexp_constant(Pconst_integer _) + | ("+" | "+."), Pexp_constant(Pconst_float _) -> mkexp desc + | _ -> + mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg])) + +let mkexp_cons consloc args loc = + Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args)) + +let mkpat_cons consloc args loc = + Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args)) + +let rec mktailexp nilloc = function + [] -> + let loc = { nilloc with loc_ghost = true } in + let nil = { txt = Lident "[]"; loc = loc } in + Exp.mk ~loc (Pexp_construct (nil, None)) + | e1 :: el -> + let exp_el = mktailexp nilloc el in + let loc = {loc_start = e1.pexp_loc.loc_start; + loc_end = exp_el.pexp_loc.loc_end; + loc_ghost = true} + in + let arg = Exp.mk ~loc (Pexp_tuple [e1; exp_el]) in + mkexp_cons {loc with loc_ghost = true} arg loc + +let rec mktailpat nilloc = function + [] -> + let loc = { nilloc with loc_ghost = true } in + let nil = { txt = Lident "[]"; loc = loc } in + Pat.mk ~loc (Ppat_construct (nil, None)) + | p1 :: pl -> + let pat_pl = mktailpat nilloc pl in + let loc = {loc_start = p1.ppat_loc.loc_start; + loc_end = pat_pl.ppat_loc.loc_end; + loc_ghost = true} + in + let arg = Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in + mkpat_cons {loc with loc_ghost = true} arg loc + +let mkstrexp e attrs = + { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc } + +let mkexp_constraint e (t1, t2) = + match t1, t2 with + | Some t, None -> ghexp(Pexp_constraint(e, t)) + | _, Some t -> ghexp(Pexp_coerce(e, t1, t)) + | None, None -> assert false + +let mkexp_opt_constraint e = function + | None -> e + | Some constraint_ -> mkexp_constraint e constraint_ + +let mkpat_opt_constraint p = function + | None -> p + | Some typ -> mkpat (Ppat_constraint(p, typ)) + +let array_function str name = + ghloc (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))) + +let syntax_error () = + raise Syntaxerr.Escape_error + +let unclosed opening_name opening_num closing_name closing_num = + raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name, + rhs_loc closing_num, closing_name))) + +let expecting pos nonterm = + raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm))) + +let not_expecting pos nonterm = + raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm))) + +let bigarray_function str name = + ghloc (Ldot(Ldot(Lident "Bigarray", str), name)) + +let bigarray_untuplify = function + { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist + | exp -> [exp] + +let bigarray_get arr arg = + let get = if !Clflags.fast then "unsafe_get" else "get" in + match bigarray_untuplify arg with + [c1] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)), + [Nolabel, arr; Nolabel, c1])) + | [c1;c2] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)), + [Nolabel, arr; Nolabel, c1; Nolabel, c2])) + | [c1;c2;c3] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)), + [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3])) + | coords -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")), + [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)])) + +let bigarray_set arr arg newval = + let set = if !Clflags.fast then "unsafe_set" else "set" in + match bigarray_untuplify arg with + [c1] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)), + [Nolabel, arr; Nolabel, c1; Nolabel, newval])) + | [c1;c2] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)), + [Nolabel, arr; Nolabel, c1; + Nolabel, c2; Nolabel, newval])) + | [c1;c2;c3] -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)), + [Nolabel, arr; Nolabel, c1; + Nolabel, c2; Nolabel, c3; Nolabel, newval])) + | coords -> + mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")), + [Nolabel, arr; + Nolabel, ghexp(Pexp_array coords); + Nolabel, newval])) + +let lapply p1 p2 = + if !Clflags.applicative_functors + then Lapply(p1, p2) + else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc()))) + +let exp_of_label lbl pos = + mkexp (Pexp_ident(mkrhs (Lident(Longident.last lbl)) pos)) + +let pat_of_label lbl pos = + mkpat (Ppat_var (mkrhs (Longident.last lbl) pos)) + +let mk_newtypes newtypes exp = + List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp))) + newtypes exp + +let wrap_type_annotation newtypes core_type body = + let exp = mkexp(Pexp_constraint(body,core_type)) in + let exp = mk_newtypes newtypes exp in + (exp, ghtyp(Ptyp_poly(newtypes, Typ.varify_constructors newtypes core_type))) + +let wrap_exp_attrs body (ext, attrs) = + (* todo: keep exact location for the entire attribute *) + let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in + match ext with + | None -> body + | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []])) + +let mkexp_attrs d attrs = + wrap_exp_attrs (mkexp d) attrs + +let wrap_typ_attrs typ (ext, attrs) = + (* todo: keep exact location for the entire attribute *) + let typ = {typ with ptyp_attributes = attrs @ typ.ptyp_attributes} in + match ext with + | None -> typ + | Some id -> ghtyp(Ptyp_extension (id, PTyp typ)) + +let mktyp_attrs d attrs = + wrap_typ_attrs (mktyp d) attrs + +let wrap_pat_attrs pat (ext, attrs) = + (* todo: keep exact location for the entire attribute *) + let pat = {pat with ppat_attributes = attrs @ pat.ppat_attributes} in + match ext with + | None -> pat + | Some id -> ghpat(Ppat_extension (id, PPat (pat, None))) + +let mkpat_attrs d attrs = + wrap_pat_attrs (mkpat d) attrs + +let wrap_class_attrs body attrs = + {body with pcl_attributes = attrs @ body.pcl_attributes} +let wrap_class_type_attrs body attrs = + {body with pcty_attributes = attrs @ body.pcty_attributes} +let wrap_mod_attrs body attrs = + {body with pmod_attributes = attrs @ body.pmod_attributes} +let wrap_mty_attrs body attrs = + {body with pmty_attributes = attrs @ body.pmty_attributes} + +let wrap_str_ext body ext = + match ext with + | None -> body + | Some id -> ghstr(Pstr_extension ((id, PStr [body]), [])) + +let mkstr_ext d ext = + wrap_str_ext (mkstr d) ext + +let wrap_sig_ext body ext = + match ext with + | None -> body + | Some id -> ghsig(Psig_extension ((id, PSig [body]), [])) + +let mksig_ext d ext = + wrap_sig_ext (mksig d) ext + +let text_str pos = Str.text (rhs_text pos) +let text_sig pos = Sig.text (rhs_text pos) +let text_cstr pos = Cf.text (rhs_text pos) +let text_csig pos = Ctf.text (rhs_text pos) +let text_def pos = [Ptop_def (Str.text (rhs_text pos))] + +let extra_text text pos items = + let pre_extras = rhs_pre_extra_text pos in + let post_extras = rhs_post_extra_text pos in + text pre_extras @ items @ text post_extras + +let extra_str pos items = extra_text Str.text pos items +let extra_sig pos items = extra_text Sig.text pos items +let extra_cstr pos items = extra_text Cf.text pos items +let extra_csig pos items = extra_text Ctf.text pos items +let extra_def pos items = + extra_text (fun txt -> [Ptop_def (Str.text txt)]) pos items + +let extra_rhs_core_type ct ~pos = + let docs = rhs_info pos in + { ct with ptyp_attributes = add_info_attrs docs ct.ptyp_attributes } + +type let_binding = + { lb_pattern: pattern; + lb_expression: expression; + lb_attributes: attributes; + lb_docs: docs Lazy.t; + lb_text: text Lazy.t; + lb_loc: Location.t; } + +type let_bindings = + { lbs_bindings: let_binding list; + lbs_rec: rec_flag; + lbs_extension: string Asttypes.loc option; + lbs_loc: Location.t } + +let mklb first (p, e) attrs = + { lb_pattern = p; + lb_expression = e; + lb_attributes = attrs; + lb_docs = symbol_docs_lazy (); + lb_text = if first then empty_text_lazy + else symbol_text_lazy (); + lb_loc = symbol_rloc (); } + +let mklbs ext rf lb = + { lbs_bindings = [lb]; + lbs_rec = rf; + lbs_extension = ext ; + lbs_loc = symbol_rloc (); } + +let addlb lbs lb = + { lbs with lbs_bindings = lb :: lbs.lbs_bindings } + +let val_of_let_bindings lbs = + let bindings = + List.map + (fun lb -> + Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes + ~docs:(Lazy.force lb.lb_docs) + ~text:(Lazy.force lb.lb_text) + lb.lb_pattern lb.lb_expression) + lbs.lbs_bindings + in + let str = mkstr(Pstr_value(lbs.lbs_rec, List.rev bindings)) in + match lbs.lbs_extension with + | None -> str + | Some id -> ghstr (Pstr_extension((id, PStr [str]), [])) + +let expr_of_let_bindings lbs body = + let bindings = + List.map + (fun lb -> + Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes + lb.lb_pattern lb.lb_expression) + lbs.lbs_bindings + in + mkexp_attrs (Pexp_let(lbs.lbs_rec, List.rev bindings, body)) + (lbs.lbs_extension, []) + +let class_of_let_bindings lbs body = + let bindings = + List.map + (fun lb -> + Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes + lb.lb_pattern lb.lb_expression) + lbs.lbs_bindings + in + if lbs.lbs_extension <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension"))); + mkclass(Pcl_let (lbs.lbs_rec, List.rev bindings, body)) + + +(* Alternatively, we could keep the generic module type in the Parsetree + and extract the package type during type-checking. In that case, + the assertions below should be turned into explicit checks. *) +let package_type_of_module_type pmty = + let err loc s = + raise (Syntaxerr.Error (Syntaxerr.Invalid_package_type (loc, s))) + in + let map_cstr = function + | Pwith_type (lid, ptyp) -> + let loc = ptyp.ptype_loc in + if ptyp.ptype_params <> [] then + err loc "parametrized types are not supported"; + if ptyp.ptype_cstrs <> [] then + err loc "constrained types are not supported"; + if ptyp.ptype_private <> Public then + err loc "private types are not supported"; + + (* restrictions below are checked by the 'with_constraint' rule *) + assert (ptyp.ptype_kind = Ptype_abstract); + assert (ptyp.ptype_attributes = []); + let ty = + match ptyp.ptype_manifest with + | Some ty -> ty + | None -> assert false + in + (lid, ty) + | _ -> + err pmty.pmty_loc "only 'with type t =' constraints are supported" + in + match pmty with + | {pmty_desc = Pmty_ident lid} -> (lid, []) + | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} -> + (lid, List.map map_cstr cstrs) + | _ -> + err pmty.pmty_loc + "only module type identifier and 'with type' constraints are supported" + + +# 524 "parsing/parser.ml" +let yytransl_const = [| + 257 (* AMPERAMPER *); + 258 (* AMPERSAND *); + 259 (* AND *); + 260 (* AS *); + 261 (* ASSERT *); + 262 (* BACKQUOTE *); + 263 (* BANG *); + 264 (* BAR *); + 265 (* BARBAR *); + 266 (* BARRBRACKET *); + 267 (* BEGIN *); + 269 (* CLASS *); + 270 (* COLON *); + 271 (* COLONCOLON *); + 272 (* COLONEQUAL *); + 273 (* COLONGREATER *); + 274 (* COMMA *); + 275 (* CONSTRAINT *); + 276 (* DO *); + 277 (* DONE *); + 278 (* DOT *); + 279 (* DOTDOT *); + 280 (* DOWNTO *); + 281 (* ELSE *); + 282 (* END *); + 0 (* EOF *); + 283 (* EQUAL *); + 284 (* EXCEPTION *); + 285 (* EXTERNAL *); + 286 (* FALSE *); + 288 (* FOR *); + 289 (* FUN *); + 290 (* FUNCTION *); + 291 (* FUNCTOR *); + 292 (* GREATER *); + 293 (* GREATERRBRACE *); + 294 (* GREATERRBRACKET *); + 295 (* IF *); + 296 (* IN *); + 297 (* INCLUDE *); + 304 (* INHERIT *); + 305 (* INITIALIZER *); + 308 (* LAZY *); + 309 (* LBRACE *); + 310 (* LBRACELESS *); + 311 (* LBRACKET *); + 312 (* LBRACKETBAR *); + 313 (* LBRACKETLESS *); + 314 (* LBRACKETGREATER *); + 315 (* LBRACKETPERCENT *); + 316 (* LBRACKETPERCENTPERCENT *); + 317 (* LESS *); + 318 (* LESSMINUS *); + 319 (* LET *); + 321 (* LPAREN *); + 322 (* LBRACKETAT *); + 323 (* LBRACKETATAT *); + 324 (* LBRACKETATATAT *); + 325 (* MATCH *); + 326 (* METHOD *); + 327 (* MINUS *); + 328 (* MINUSDOT *); + 329 (* MINUSGREATER *); + 330 (* MODULE *); + 331 (* MUTABLE *); + 332 (* NEW *); + 333 (* NONREC *); + 334 (* OBJECT *); + 335 (* OF *); + 336 (* OPEN *); + 338 (* OR *); + 339 (* PERCENT *); + 340 (* PLUS *); + 341 (* PLUSDOT *); + 342 (* PLUSEQ *); + 344 (* PRIVATE *); + 345 (* QUESTION *); + 346 (* QUOTE *); + 347 (* RBRACE *); + 348 (* RBRACKET *); + 349 (* REC *); + 350 (* RPAREN *); + 351 (* SEMI *); + 352 (* SEMISEMI *); + 353 (* HASH *); + 355 (* SIG *); + 356 (* STAR *); + 358 (* STRUCT *); + 359 (* THEN *); + 360 (* TILDE *); + 361 (* TO *); + 362 (* TRUE *); + 363 (* TRY *); + 364 (* TYPE *); + 366 (* UNDERSCORE *); + 367 (* VAL *); + 368 (* VIRTUAL *); + 369 (* WHEN *); + 370 (* WHILE *); + 371 (* WITH *); + 374 (* EOL *); + 0|] + +let yytransl_block = [| + 268 (* CHAR *); + 287 (* FLOAT *); + 298 (* INFIXOP0 *); + 299 (* INFIXOP1 *); + 300 (* INFIXOP2 *); + 301 (* INFIXOP3 *); + 302 (* INFIXOP4 *); + 303 (* DOTOP *); + 306 (* INT *); + 307 (* LABEL *); + 320 (* LIDENT *); + 337 (* OPTLABEL *); + 343 (* PREFIXOP *); + 354 (* HASHOP *); + 357 (* STRING *); + 365 (* UIDENT *); + 372 (* COMMENT *); + 373 (* DOCSTRING *); + 0|] + +let yylhs = "\255\255\ +\001\000\002\000\003\000\003\000\003\000\010\000\010\000\014\000\ +\014\000\004\000\016\000\016\000\017\000\017\000\017\000\017\000\ +\017\000\017\000\017\000\005\000\006\000\007\000\020\000\020\000\ +\021\000\021\000\023\000\023\000\024\000\024\000\024\000\024\000\ +\024\000\024\000\024\000\024\000\024\000\027\000\027\000\027\000\ +\027\000\027\000\027\000\027\000\027\000\027\000\027\000\027\000\ +\008\000\008\000\032\000\032\000\032\000\015\000\015\000\015\000\ +\015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ +\015\000\015\000\015\000\015\000\045\000\049\000\049\000\049\000\ +\039\000\040\000\040\000\050\000\051\000\022\000\022\000\022\000\ +\022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ +\009\000\009\000\009\000\054\000\054\000\054\000\054\000\054\000\ +\054\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\ +\054\000\054\000\042\000\060\000\063\000\063\000\063\000\057\000\ +\058\000\059\000\059\000\064\000\065\000\066\000\066\000\041\000\ +\043\000\043\000\068\000\069\000\072\000\072\000\072\000\071\000\ +\071\000\077\000\077\000\073\000\073\000\073\000\073\000\073\000\ +\073\000\073\000\078\000\078\000\078\000\078\000\078\000\078\000\ +\078\000\078\000\082\000\083\000\083\000\083\000\084\000\084\000\ +\085\000\085\000\085\000\085\000\085\000\085\000\085\000\086\000\ +\086\000\087\000\087\000\087\000\087\000\088\000\088\000\088\000\ +\088\000\088\000\074\000\074\000\074\000\074\000\074\000\097\000\ +\097\000\097\000\097\000\097\000\097\000\097\000\100\000\101\000\ +\101\000\102\000\102\000\103\000\103\000\103\000\103\000\103\000\ +\103\000\104\000\104\000\104\000\106\000\089\000\061\000\061\000\ +\107\000\108\000\044\000\044\000\109\000\110\000\012\000\012\000\ +\012\000\012\000\075\000\075\000\075\000\075\000\075\000\075\000\ +\075\000\075\000\116\000\116\000\113\000\113\000\112\000\112\000\ +\114\000\115\000\115\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ +\030\000\030\000\030\000\030\000\030\000\030\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ +\118\000\118\000\118\000\118\000\118\000\118\000\079\000\079\000\ +\136\000\136\000\137\000\137\000\137\000\137\000\138\000\096\000\ +\096\000\139\000\139\000\139\000\139\000\139\000\139\000\033\000\ +\033\000\144\000\145\000\147\000\147\000\095\000\095\000\095\000\ +\121\000\121\000\148\000\148\000\148\000\122\000\122\000\122\000\ +\122\000\123\000\123\000\132\000\132\000\150\000\150\000\150\000\ +\151\000\151\000\135\000\135\000\153\000\153\000\133\000\133\000\ +\092\000\092\000\092\000\092\000\092\000\152\000\152\000\019\000\ +\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ +\019\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ +\142\000\142\000\155\000\155\000\155\000\155\000\117\000\117\000\ +\143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ +\143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ +\143\000\143\000\143\000\143\000\143\000\143\000\159\000\159\000\ +\159\000\159\000\159\000\159\000\159\000\154\000\154\000\154\000\ +\156\000\156\000\156\000\161\000\161\000\160\000\160\000\160\000\ +\160\000\162\000\162\000\163\000\163\000\035\000\164\000\164\000\ +\034\000\036\000\036\000\165\000\166\000\170\000\170\000\169\000\ +\169\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\ +\169\000\169\000\168\000\168\000\168\000\173\000\174\000\174\000\ +\176\000\176\000\177\000\175\000\175\000\175\000\178\000\076\000\ +\076\000\171\000\171\000\171\000\179\000\180\000\038\000\038\000\ +\056\000\119\000\182\000\182\000\182\000\182\000\183\000\183\000\ +\172\000\172\000\172\000\185\000\186\000\037\000\055\000\188\000\ +\188\000\188\000\188\000\188\000\188\000\189\000\189\000\189\000\ +\190\000\191\000\192\000\193\000\053\000\053\000\194\000\194\000\ +\194\000\194\000\195\000\195\000\141\000\141\000\093\000\093\000\ +\187\000\187\000\018\000\018\000\196\000\196\000\198\000\198\000\ +\198\000\198\000\198\000\149\000\149\000\199\000\199\000\199\000\ +\199\000\199\000\199\000\199\000\199\000\199\000\199\000\199\000\ +\199\000\199\000\199\000\199\000\199\000\199\000\199\000\199\000\ +\031\000\202\000\202\000\203\000\203\000\201\000\201\000\205\000\ +\205\000\206\000\206\000\204\000\204\000\098\000\098\000\080\000\ +\080\000\184\000\184\000\200\000\200\000\200\000\200\000\200\000\ +\200\000\200\000\209\000\207\000\208\000\090\000\131\000\131\000\ +\131\000\131\000\157\000\157\000\157\000\157\000\157\000\067\000\ +\067\000\140\000\140\000\140\000\140\000\140\000\210\000\210\000\ +\210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ +\210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ +\210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ +\210\000\210\000\210\000\181\000\181\000\181\000\181\000\181\000\ +\181\000\130\000\130\000\124\000\124\000\124\000\124\000\124\000\ +\124\000\124\000\129\000\129\000\158\000\158\000\025\000\025\000\ +\197\000\197\000\197\000\052\000\052\000\099\000\099\000\081\000\ +\081\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ +\125\000\146\000\146\000\167\000\167\000\126\000\126\000\094\000\ +\094\000\091\000\091\000\070\000\070\000\105\000\105\000\105\000\ +\105\000\105\000\062\000\062\000\120\000\120\000\134\000\134\000\ +\127\000\127\000\128\000\128\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\211\000\ +\211\000\211\000\211\000\211\000\211\000\211\000\211\000\111\000\ +\111\000\028\000\213\000\047\000\013\000\013\000\026\000\026\000\ +\048\000\048\000\048\000\029\000\046\000\212\000\212\000\212\000\ +\212\000\212\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000" + +let yylen = "\002\000\ +\002\000\002\000\002\000\002\000\001\000\002\000\001\000\000\000\ +\002\000\001\000\001\000\003\000\001\000\002\000\004\000\003\000\ +\003\000\002\000\002\000\002\000\002\000\002\000\002\000\005\000\ +\001\000\001\000\002\000\001\000\001\000\004\000\004\000\005\000\ +\002\000\003\000\001\000\002\000\001\000\005\000\005\000\003\000\ +\003\000\005\000\007\000\009\000\007\000\006\000\006\000\005\000\ +\003\000\001\000\000\000\002\000\002\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\002\000\001\000\004\000\002\000\004\000\002\000\ +\005\000\001\000\002\000\006\000\005\000\001\000\004\000\004\000\ +\005\000\003\000\003\000\005\000\003\000\003\000\001\000\002\000\ +\000\000\002\000\002\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\002\000\001\000\005\000\004\000\002\000\006\000\003\000\005\000\ +\006\000\001\000\002\000\007\000\006\000\000\000\002\000\006\000\ +\001\000\002\000\007\000\007\000\002\000\004\000\002\000\000\000\ +\003\000\003\000\002\000\001\000\003\000\002\000\003\000\007\000\ +\002\000\001\000\004\000\001\000\004\000\004\000\005\000\005\000\ +\003\000\003\000\002\000\003\000\005\000\000\000\000\000\002\000\ +\006\000\003\000\003\000\004\000\004\000\002\000\001\000\002\000\ +\000\000\007\000\007\000\006\000\007\000\007\000\007\000\005\000\ +\008\000\011\000\001\000\006\000\004\000\005\000\003\000\004\000\ +\001\000\004\000\004\000\002\000\001\000\007\000\002\000\003\000\ +\000\000\000\000\002\000\004\000\004\000\007\000\004\000\002\000\ +\001\000\005\000\005\000\003\000\003\000\003\000\001\000\002\000\ +\008\000\008\000\001\000\002\000\009\000\008\000\001\000\002\000\ +\003\000\005\000\005\000\002\000\005\000\002\000\004\000\002\000\ +\002\000\001\000\001\000\001\000\000\000\002\000\001\000\003\000\ +\001\000\001\000\003\000\001\000\002\000\003\000\007\000\006\000\ +\007\000\004\000\004\000\007\000\006\000\006\000\005\000\001\000\ +\002\000\002\000\007\000\005\000\006\000\010\000\003\000\003\000\ +\003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ +\003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ +\003\000\003\000\003\000\002\000\002\000\005\000\007\000\007\000\ +\007\000\007\000\007\000\007\000\009\000\009\000\009\000\003\000\ +\003\000\003\000\004\000\004\000\002\000\001\000\001\000\001\000\ +\001\000\001\000\003\000\003\000\004\000\003\000\004\000\004\000\ +\003\000\005\000\004\000\005\000\005\000\005\000\005\000\005\000\ +\005\000\005\000\005\000\005\000\005\000\005\000\007\000\007\000\ +\007\000\007\000\007\000\007\000\005\000\005\000\003\000\003\000\ +\005\000\005\000\004\000\004\000\002\000\006\000\004\000\006\000\ +\004\000\004\000\006\000\004\000\006\000\002\000\002\000\003\000\ +\003\000\003\000\002\000\005\000\004\000\005\000\003\000\003\000\ +\005\000\007\000\006\000\009\000\008\000\001\000\001\000\002\000\ +\001\000\001\000\002\000\002\000\002\000\002\000\001\000\001\000\ +\002\000\002\000\004\000\007\000\008\000\003\000\005\000\001\000\ +\002\000\005\000\004\000\001\000\003\000\002\000\002\000\005\000\ +\001\000\003\000\003\000\005\000\003\000\002\000\004\000\002\000\ +\005\000\003\000\003\000\003\000\001\000\001\000\003\000\002\000\ +\004\000\002\000\002\000\003\000\003\000\001\000\001\000\003\000\ +\002\000\004\000\002\000\002\000\002\000\001\000\000\000\003\000\ +\003\000\001\000\003\000\003\000\003\000\003\000\003\000\002\000\ +\001\000\003\000\003\000\001\000\003\000\003\000\003\000\003\000\ +\002\000\001\000\001\000\002\000\002\000\003\000\001\000\001\000\ +\001\000\001\000\003\000\001\000\001\000\002\000\001\000\003\000\ +\004\000\004\000\005\000\005\000\004\000\003\000\003\000\005\000\ +\005\000\004\000\005\000\007\000\007\000\001\000\003\000\003\000\ +\004\000\004\000\004\000\002\000\004\000\003\000\003\000\003\000\ +\003\000\003\000\003\000\001\000\003\000\001\000\002\000\004\000\ +\003\000\004\000\002\000\002\000\000\000\006\000\001\000\002\000\ +\008\000\001\000\002\000\008\000\007\000\003\000\000\000\000\000\ +\002\000\003\000\002\000\003\000\002\000\003\000\005\000\005\000\ +\005\000\007\000\000\000\001\000\003\000\002\000\001\000\003\000\ +\002\000\001\000\002\000\000\000\001\000\001\000\002\000\001\000\ +\003\000\001\000\001\000\002\000\003\000\004\000\001\000\007\000\ +\006\000\003\000\000\000\002\000\004\000\002\000\001\000\003\000\ +\001\000\001\000\002\000\005\000\007\000\009\000\009\000\001\000\ +\001\000\001\000\001\000\002\000\002\000\001\000\001\000\002\000\ +\003\000\004\000\004\000\005\000\001\000\003\000\006\000\005\000\ +\004\000\004\000\001\000\002\000\002\000\003\000\001\000\003\000\ +\001\000\003\000\001\000\002\000\001\000\004\000\001\000\006\000\ +\004\000\005\000\003\000\001\000\003\000\002\000\001\000\001\000\ +\002\000\004\000\003\000\002\000\002\000\003\000\005\000\003\000\ +\004\000\005\000\004\000\002\000\004\000\006\000\005\000\001\000\ +\001\000\001\000\003\000\001\000\001\000\005\000\002\000\001\000\ +\000\000\001\000\003\000\001\000\002\000\001\000\003\000\001\000\ +\003\000\001\000\003\000\002\000\002\000\001\000\001\000\001\000\ +\001\000\001\000\004\000\006\000\002\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\002\000\002\000\002\000\002\000\001\000\ +\001\000\001\000\003\000\003\000\002\000\003\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\003\000\004\000\003\000\004\000\ +\003\000\004\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\002\000\002\000\003\000\001\000\ +\001\000\001\000\003\000\001\000\005\000\002\000\002\000\003\000\ +\001\000\001\000\001\000\003\000\001\000\003\000\001\000\003\000\ +\001\000\003\000\004\000\001\000\003\000\001\000\003\000\001\000\ +\003\000\002\000\003\000\003\000\003\000\003\000\003\000\003\000\ +\002\000\000\000\001\000\000\000\001\000\001\000\001\000\000\000\ +\001\000\000\000\001\000\000\000\001\000\000\000\001\000\001\000\ +\002\000\002\000\000\000\001\000\000\000\001\000\000\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ +\003\000\004\000\004\000\004\000\000\000\002\000\000\000\002\000\ +\000\000\002\000\003\000\004\000\004\000\001\000\002\000\002\000\ +\002\000\004\000\002\000\002\000\002\000\002\000\002\000\002\000\ +\002\000" + +let yydefred = "\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\112\002\000\000\000\000\000\000\ +\169\002\114\002\000\000\000\000\000\000\000\000\000\000\111\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\217\002\218\002\000\000\000\000\ +\000\000\000\000\219\002\220\002\000\000\000\000\113\002\170\002\ +\000\000\000\000\175\002\030\001\000\000\000\000\035\003\000\000\ +\000\000\000\000\000\000\094\001\000\000\050\000\000\000\055\000\ +\056\000\000\000\058\000\059\000\060\000\000\000\062\000\063\000\ +\000\000\000\000\066\000\000\000\068\000\074\000\007\002\121\000\ +\000\000\203\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\031\001\032\001\162\002\112\001\226\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\036\003\000\000\093\000\092\000\000\000\ +\100\000\101\000\000\000\000\000\106\000\000\000\095\000\096\000\ +\097\000\098\000\000\000\102\000\000\000\114\000\199\000\005\000\ +\000\000\037\003\000\000\000\000\000\000\007\000\000\000\013\000\ +\000\000\038\003\000\000\000\000\000\000\010\000\011\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\177\002\063\002\039\003\000\000\080\002\055\002\000\000\ +\064\002\051\002\000\000\000\000\000\000\040\003\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\122\002\000\000\000\000\ +\000\000\000\000\177\001\041\003\000\000\000\000\198\001\171\001\ +\000\000\000\000\115\002\175\001\176\001\000\000\161\001\000\000\ +\183\001\000\000\000\000\000\000\000\000\121\002\120\002\193\002\ +\079\001\033\001\034\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\133\001\000\000\083\001\110\002\000\000\ +\000\000\000\000\166\002\000\000\000\000\069\001\000\000\223\002\ +\224\002\225\002\226\002\227\002\228\002\229\002\230\002\231\002\ +\232\002\233\002\234\002\235\002\236\002\237\002\238\002\239\002\ +\240\002\241\002\242\002\243\002\244\002\245\002\246\002\247\002\ +\221\002\248\002\249\002\250\002\251\002\252\002\253\002\254\002\ +\255\002\000\003\001\003\002\003\003\003\004\003\005\003\006\003\ +\007\003\008\003\009\003\010\003\222\002\011\003\012\003\013\003\ +\014\003\015\003\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\125\002\152\002\151\002\000\000\150\002\000\000\153\002\ +\146\002\148\002\128\002\129\002\130\002\131\002\132\002\000\000\ +\147\002\000\000\000\000\000\000\149\002\155\002\000\000\000\000\ +\154\002\000\000\167\002\139\002\145\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\212\002\000\000\078\001\ +\052\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\ +\000\000\000\000\053\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\029\001\000\000\000\000\113\001\ +\000\000\227\001\000\000\075\000\000\000\122\000\000\000\204\000\ +\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\095\001\098\001\000\000\000\000\ +\000\000\012\001\013\001\000\000\000\000\000\000\000\000\090\000\ +\000\000\002\000\105\000\091\000\000\000\115\000\000\000\200\000\ +\000\000\003\000\004\000\006\000\009\000\014\000\000\000\000\000\ +\000\000\019\000\000\000\018\000\000\000\173\002\000\000\085\002\ +\000\000\000\000\214\002\000\000\076\002\000\000\106\002\068\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\103\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\062\002\184\002\000\000\ +\069\002\020\000\052\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\065\002\021\000\000\000\000\000\171\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\204\001\000\000\140\002\000\000\ +\144\002\000\000\000\000\142\002\127\002\000\000\117\002\116\002\ +\119\002\118\002\182\001\000\000\000\000\000\000\000\000\022\000\ +\160\001\000\000\172\001\173\001\000\000\000\000\000\000\000\000\ +\026\003\000\000\000\000\000\000\000\000\038\001\000\000\000\000\ +\205\002\000\000\160\002\000\000\000\000\161\002\156\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\218\000\180\001\181\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\035\000\037\000\000\000\000\000\000\000\ +\000\000\000\000\150\001\000\000\064\001\063\001\000\000\000\000\ +\082\001\081\001\000\000\139\001\000\000\000\000\000\000\000\000\ +\000\000\030\003\000\000\000\000\000\000\000\000\000\000\000\000\ +\195\002\000\000\168\002\000\000\000\000\000\000\126\002\000\000\ +\036\001\035\001\000\000\124\002\123\002\000\000\000\000\000\000\ +\000\000\000\000\080\001\000\000\000\000\151\000\000\000\000\000\ +\197\002\000\000\000\000\000\000\000\000\049\000\022\003\000\000\ +\000\000\000\000\000\000\000\000\176\002\163\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\209\000\000\000\000\000\230\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\103\001\ +\101\001\087\001\000\000\100\001\096\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\087\000\078\000\ +\180\002\000\000\000\000\000\000\000\000\000\000\000\000\191\002\ +\188\002\187\002\192\002\000\000\189\002\017\000\000\000\016\000\ +\012\000\084\002\000\000\082\002\000\000\087\002\072\002\000\000\ +\000\000\000\000\000\000\109\002\067\002\100\002\101\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\098\002\000\000\ +\174\002\178\002\000\000\000\000\000\000\070\002\159\001\174\001\ +\000\000\000\000\000\000\200\001\199\001\000\000\000\000\000\000\ +\000\000\000\000\191\001\000\000\190\001\153\001\152\001\158\001\ +\000\000\156\001\000\000\208\001\000\000\000\000\000\000\184\001\ +\000\000\179\001\000\000\027\003\024\003\000\000\000\000\000\000\ +\000\000\041\001\000\000\000\000\000\000\039\001\037\001\000\000\ +\000\000\000\000\157\002\000\000\158\002\000\000\000\000\000\000\ +\000\000\143\002\000\000\141\002\000\000\000\000\217\000\000\000\ +\219\000\000\000\220\000\214\000\225\000\000\000\212\000\000\000\ +\216\000\000\000\000\000\000\000\000\000\235\000\000\000\000\000\ +\121\001\000\000\000\000\000\000\000\000\000\000\000\000\069\000\ +\033\000\036\000\000\000\000\000\132\001\148\001\000\000\149\001\ +\000\000\000\000\135\001\000\000\140\001\000\000\074\001\073\001\ +\068\001\067\001\031\003\000\000\000\000\028\003\017\003\029\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\170\001\000\000\000\000\000\000\000\000\000\000\040\001\020\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\028\001\027\001\000\000\000\000\000\000\000\000\254\001\ +\253\001\000\000\244\001\000\000\000\000\000\000\000\000\000\000\ +\085\001\000\000\076\001\000\000\071\001\000\000\000\000\000\000\ +\043\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\108\000\088\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\015\000\000\000\073\002\088\002\ +\000\000\000\000\000\000\077\002\075\002\000\000\000\000\000\000\ +\049\002\000\000\000\000\000\000\000\000\000\000\066\002\000\000\ +\000\000\185\002\000\000\000\000\179\002\054\002\172\002\000\000\ +\000\000\000\000\217\001\000\000\202\001\201\001\205\001\203\001\ +\000\000\194\001\000\000\185\001\189\001\186\001\000\000\018\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\002\000\000\159\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\012\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\126\001\128\001\000\000\000\000\000\000\000\000\ +\028\000\000\000\000\000\041\000\000\000\040\000\000\000\034\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\114\001\ +\000\000\000\000\000\000\000\000\000\000\106\001\000\000\000\000\ +\000\000\000\000\000\000\169\001\000\000\000\000\138\002\136\002\ +\134\002\000\000\089\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\023\000\025\000\026\000\000\000\072\000\073\000\000\000\ +\148\000\000\000\000\000\000\000\000\000\000\000\000\000\159\000\ +\152\000\107\000\239\000\000\000\247\001\000\000\000\000\000\000\ +\000\000\250\001\246\001\000\000\000\000\019\003\066\001\065\001\ +\086\001\084\001\000\000\000\000\165\002\000\000\044\001\042\001\ +\210\000\115\001\000\000\000\000\000\000\000\000\000\000\062\001\ +\048\001\000\000\046\001\000\000\000\000\000\000\000\000\000\000\ +\054\001\000\000\050\001\000\000\052\001\000\000\000\000\000\000\ +\086\000\085\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\037\002\000\000\181\002\000\000\000\000\000\000\000\000\000\000\ +\112\000\000\000\000\000\000\000\083\002\090\002\000\000\074\002\ +\092\002\000\000\000\000\000\000\000\000\000\000\000\000\079\002\ +\071\002\000\000\099\002\000\000\216\002\216\001\000\000\195\001\ +\193\001\192\001\188\001\187\001\061\001\047\001\045\001\000\000\ +\000\000\000\000\053\001\049\001\051\001\000\000\000\000\129\000\ +\000\000\251\001\000\000\000\000\000\000\000\000\203\002\000\000\ +\000\000\017\002\000\000\000\000\000\000\000\000\009\002\000\000\ +\199\002\198\002\000\000\105\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\215\000\000\000\000\000\125\001\123\001\000\000\ +\122\001\000\000\000\000\027\000\000\000\000\000\031\000\030\000\ +\000\000\034\003\232\000\010\002\000\000\000\000\000\000\000\000\ +\118\001\000\000\000\000\116\001\119\001\000\000\163\001\162\001\ +\168\001\000\000\166\001\000\000\211\001\000\000\110\001\000\000\ +\000\000\091\001\000\000\000\000\000\000\120\000\076\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\158\000\000\000\000\000\245\001\000\000\231\001\000\000\ +\249\001\222\001\245\000\077\001\075\001\072\001\070\001\000\000\ +\231\001\077\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\080\000\079\000\000\000\000\000\000\000\000\000\113\000\111\000\ +\000\000\000\000\000\000\000\000\000\000\086\002\078\002\093\002\ +\050\002\046\002\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\001\002\255\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\177\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\ +\140\000\123\000\127\000\000\000\016\002\019\002\013\002\000\000\ +\008\002\000\000\000\000\000\000\236\000\000\000\222\000\213\000\ +\211\000\000\000\127\001\000\000\000\000\000\000\000\000\048\000\ +\000\000\000\000\042\000\039\000\038\000\231\000\233\000\000\000\ +\000\000\000\000\000\000\107\001\000\000\090\001\000\000\000\000\ +\149\000\000\000\000\000\000\000\000\000\000\000\155\000\000\000\ +\154\000\248\001\000\000\237\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\002\002\003\002\000\000\000\000\201\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\060\001\000\000\056\001\000\000\058\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\038\002\ +\116\000\000\000\000\000\117\000\000\000\091\002\108\002\197\001\ +\196\001\059\001\055\001\057\001\000\000\182\002\181\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\180\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\137\000\000\000\000\000\224\001\225\001\000\000\ +\129\001\124\001\046\000\000\000\047\000\000\000\000\000\000\000\ +\000\000\117\001\111\001\024\000\000\000\156\000\000\000\157\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\001\ +\000\000\000\000\000\000\000\000\004\002\000\000\000\000\228\001\ +\000\000\000\000\000\000\024\002\025\002\026\002\027\002\093\001\ +\000\000\229\001\124\000\000\000\000\000\000\000\000\000\201\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\030\002\031\002\000\000\205\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\186\000\000\000\000\000\000\000\175\000\ +\000\000\000\000\133\000\000\000\000\000\146\000\000\000\145\000\ +\000\000\000\000\000\000\000\000\000\000\043\000\045\000\000\000\ +\000\000\120\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\005\002\000\000\ +\230\001\000\000\000\000\000\000\022\002\028\002\029\002\092\001\ +\206\000\000\000\000\000\000\000\040\002\044\002\231\001\110\000\ +\000\000\023\002\032\002\202\000\183\002\176\000\000\000\000\000\ +\000\000\179\000\178\000\000\000\173\000\000\000\000\000\131\000\ +\139\000\000\000\000\000\142\000\141\000\000\000\246\000\000\000\ +\000\000\108\001\160\000\153\000\000\000\000\000\000\000\168\000\ +\000\000\000\000\000\000\000\000\006\002\241\001\000\000\000\000\ +\239\001\000\000\000\000\000\000\000\000\033\002\000\000\000\000\ +\174\000\184\000\000\000\000\000\000\000\000\000\000\000\193\000\ +\187\000\000\000\000\000\000\000\144\000\143\000\000\000\044\000\ +\109\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\164\000\000\000\000\000\000\000\000\000\034\002\035\002\ +\000\000\000\000\000\000\000\000\000\000\192\000\172\000\000\000\ +\021\002\166\000\167\000\000\000\000\000\000\000\000\000\000\000\ +\165\000\242\001\036\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\169\000\ +\000\000\191\000\188\000\209\002\210\002\000\000\000\000\000\000\ +\000\000\189\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\170\000\190\000\000\000\000\000" + +let yydgoto = "\008\000\ +\055\000\100\000\122\000\130\000\148\000\158\000\172\000\034\002\ +\101\000\123\000\131\000\057\000\072\001\126\000\058\000\134\000\ +\135\000\178\001\214\001\055\003\245\003\131\003\202\003\005\003\ +\059\000\233\001\012\002\101\001\060\000\061\000\132\003\062\000\ +\160\000\064\000\065\000\066\000\067\000\068\000\069\000\070\000\ +\071\000\072\000\073\000\074\000\075\000\076\000\077\000\025\001\ +\056\003\078\000\108\001\136\002\056\004\110\000\111\000\079\000\ +\113\000\114\000\115\000\116\000\117\000\063\001\112\003\118\000\ +\142\001\238\003\137\002\080\000\110\001\242\001\226\002\109\004\ +\007\005\251\004\253\002\169\003\211\005\008\005\123\001\179\001\ +\009\005\061\002\062\002\060\003\001\004\229\005\185\004\183\004\ +\051\005\081\000\112\004\155\004\070\006\066\005\156\004\187\003\ +\252\004\151\000\254\004\203\005\204\005\012\006\057\006\109\006\ +\105\006\241\005\119\000\144\001\082\000\112\001\019\001\190\003\ +\128\004\191\003\189\003\244\002\176\000\083\000\033\003\164\001\ +\000\003\254\002\084\000\085\000\086\000\123\004\087\000\088\000\ +\210\000\089\000\090\000\211\000\221\000\028\002\217\000\125\001\ +\126\001\121\002\037\003\091\000\071\006\039\003\181\000\092\000\ +\104\001\042\002\157\004\001\003\152\000\212\000\213\000\020\002\ +\218\000\182\000\183\000\042\003\184\000\153\000\185\000\201\001\ +\204\001\202\001\187\002\019\005\093\000\106\001\066\002\066\003\ +\191\004\071\005\067\005\113\004\067\003\006\004\068\003\011\004\ +\171\003\106\004\068\005\069\005\070\005\233\002\176\003\177\003\ +\114\004\115\004\128\003\171\005\193\005\172\005\173\005\174\005\ +\175\005\057\004\189\005\154\000\155\000\156\000\157\000\172\001\ +\154\002\155\002\156\002\074\004\121\003\071\004\173\001\174\001\ +\175\001\055\001\020\001\035\002\073\001" + +let yysindex = "\141\009\ +\228\067\075\007\170\051\083\051\204\051\233\070\196\074\000\000\ +\155\005\110\002\080\074\155\005\000\000\184\003\155\005\155\005\ +\000\000\000\000\155\005\155\005\155\005\155\005\155\005\000\000\ +\155\005\225\076\083\004\058\068\146\068\170\063\170\063\014\004\ +\000\000\024\061\170\063\155\005\000\000\000\000\087\005\155\005\ +\155\005\134\255\000\000\000\000\080\074\228\067\000\000\000\000\ +\155\005\155\005\000\000\000\000\155\005\155\005\000\000\160\000\ +\229\255\096\018\048\000\000\000\151\080\000\000\108\004\000\000\ +\000\000\195\000\000\000\000\000\000\000\075\001\000\000\000\000\ +\110\001\176\001\000\000\229\255\000\000\000\000\000\000\000\000\ +\171\000\000\000\105\076\218\001\080\074\080\074\233\070\233\070\ +\000\000\000\000\000\000\000\000\000\000\184\003\155\005\155\005\ +\087\005\075\007\155\005\000\000\049\003\000\000\000\000\195\000\ +\000\000\000\000\176\001\229\255\000\000\075\007\000\000\000\000\ +\000\000\000\000\128\002\000\000\177\002\000\000\000\000\000\000\ +\110\002\000\000\137\002\160\002\229\255\000\000\143\005\000\000\ +\035\052\000\000\171\007\229\255\171\007\000\000\000\000\151\044\ +\000\004\085\255\082\013\202\003\041\048\204\051\206\003\110\002\ +\058\003\000\000\000\000\000\000\070\000\000\000\000\000\222\003\ +\000\000\000\000\030\002\126\001\097\003\000\000\071\005\108\004\ +\155\005\155\005\208\003\199\073\006\074\000\000\136\065\090\003\ +\235\005\069\004\000\000\000\000\175\000\106\004\000\000\000\000\ +\196\074\196\074\000\000\000\000\000\000\162\004\000\000\154\004\ +\000\000\170\063\170\063\116\004\080\074\000\000\000\000\000\000\ +\000\000\000\000\000\000\231\068\155\005\147\004\023\002\116\003\ +\196\074\244\072\000\004\233\070\143\002\080\074\000\000\002\005\ +\070\001\197\003\149\255\000\000\241\004\000\000\000\000\092\005\ +\146\004\046\005\000\000\110\081\057\005\000\000\057\005\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\141\067\192\005\141\067\155\005\155\005\134\255\ +\162\005\000\000\000\000\000\000\080\074\000\000\154\005\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\203\006\ +\000\000\000\000\000\000\131\001\000\000\000\000\000\000\000\000\ +\000\000\080\074\000\000\000\000\000\000\156\000\166\255\141\067\ +\233\070\155\005\184\005\058\003\001\006\000\000\155\005\000\000\ +\000\000\233\070\211\005\116\003\233\070\000\000\170\063\096\018\ +\229\255\155\005\000\000\075\006\209\005\233\070\233\070\233\070\ +\233\070\233\070\233\070\233\070\233\070\233\070\233\070\233\070\ +\233\070\233\070\233\070\233\070\233\070\233\070\233\070\233\070\ +\233\070\233\070\060\069\233\070\000\000\116\004\233\070\000\000\ +\116\004\000\000\116\004\000\000\116\004\000\000\116\004\000\000\ +\000\000\233\070\169\004\225\006\080\074\080\074\027\006\068\006\ +\080\074\027\006\165\076\043\002\000\000\000\000\233\070\043\002\ +\043\002\000\000\000\000\147\004\023\002\075\004\236\005\000\000\ +\211\005\000\000\000\000\000\000\116\004\000\000\116\004\000\000\ +\195\003\000\000\000\000\000\000\000\000\000\000\171\007\229\255\ +\171\007\000\000\171\007\000\000\136\012\000\000\130\005\000\000\ +\042\006\138\006\000\000\136\012\000\000\136\012\000\000\000\000\ +\000\000\134\006\060\006\133\006\170\040\170\040\000\000\204\051\ +\155\005\116\004\009\001\104\006\167\006\000\000\000\000\164\006\ +\000\000\000\000\000\000\216\041\077\004\081\006\098\006\204\051\ +\058\003\000\000\000\000\196\074\009\076\000\000\173\006\179\006\ +\206\255\107\006\070\005\109\006\000\000\109\006\000\000\090\003\ +\000\000\131\001\235\005\000\000\000\000\102\002\000\000\000\000\ +\000\000\000\000\000\000\033\002\031\066\092\066\153\066\000\000\ +\000\000\176\003\000\000\000\000\196\074\242\001\141\067\116\004\ +\000\000\116\004\043\002\058\005\231\006\000\000\041\003\147\004\ +\000\000\153\006\000\000\119\006\140\000\000\000\000\000\078\002\ +\188\077\208\006\178\003\009\076\059\064\125\002\245\005\050\006\ +\048\072\000\000\000\000\000\000\196\074\110\006\116\004\254\003\ +\116\004\026\007\205\006\000\000\000\000\043\002\255\007\208\003\ +\202\009\124\017\000\000\202\006\000\000\000\000\208\003\233\070\ +\000\000\000\000\068\006\000\000\233\070\104\255\211\004\013\082\ +\196\074\000\000\149\006\170\063\155\006\023\002\142\006\155\005\ +\000\000\116\075\000\000\157\006\161\006\175\006\000\000\143\002\ +\000\000\000\000\182\006\000\000\000\000\163\006\166\006\110\002\ +\158\006\084\003\000\000\196\074\120\003\000\000\186\006\189\006\ +\000\000\092\006\252\006\006\007\141\067\000\000\000\000\225\076\ +\038\005\145\069\233\069\135\061\000\000\000\000\235\081\235\081\ +\203\081\110\013\110\081\203\081\184\012\184\012\184\012\184\012\ +\053\004\255\006\255\006\184\012\053\004\053\004\203\081\255\006\ +\053\004\053\004\053\004\170\063\000\000\255\006\116\075\000\000\ +\092\006\207\006\147\004\147\004\110\081\233\070\233\070\233\070\ +\252\001\249\006\233\070\233\070\233\070\043\002\043\002\000\000\ +\000\000\000\000\065\004\000\000\000\000\203\081\153\006\151\255\ +\116\004\075\004\213\006\116\004\000\000\163\002\000\000\000\000\ +\000\000\175\002\216\006\041\004\092\006\221\006\147\004\000\000\ +\000\000\000\000\000\000\055\007\000\000\000\000\171\007\000\000\ +\000\000\000\000\253\255\000\000\078\007\000\000\000\000\136\012\ +\127\001\112\000\120\054\000\000\000\000\000\000\000\000\008\007\ +\075\004\204\051\015\005\204\051\204\051\135\004\000\000\239\006\ +\000\000\000\000\220\001\110\002\022\007\000\000\000\000\000\000\ +\194\004\204\051\070\007\000\000\000\000\203\004\196\074\174\000\ +\024\006\247\006\000\000\254\046\000\000\000\000\000\000\000\000\ +\141\002\000\000\091\007\000\000\035\002\067\074\226\065\000\000\ +\035\002\000\000\015\007\000\000\000\000\233\070\233\070\233\070\ +\160\005\000\000\233\070\233\070\233\070\000\000\000\000\153\006\ +\237\005\044\007\000\000\018\007\000\000\013\041\179\002\013\041\ +\116\004\000\000\114\007\000\000\204\051\233\070\000\000\051\007\ +\000\000\196\074\000\000\000\000\000\000\053\007\000\000\053\007\ +\000\000\216\041\170\064\233\070\048\072\000\000\182\255\111\007\ +\000\000\233\070\056\007\116\004\033\001\228\067\247\002\000\000\ +\000\000\000\000\017\007\000\000\000\000\000\000\108\255\000\000\ +\116\004\233\070\000\000\110\081\000\000\110\081\000\000\000\000\ +\000\000\000\000\000\000\116\004\247\000\000\000\000\000\000\000\ +\087\007\151\255\084\003\186\006\229\255\216\071\239\004\115\007\ +\000\000\110\007\068\007\069\007\071\007\139\001\000\000\000\000\ +\000\004\109\007\084\003\075\004\143\002\150\005\084\003\229\255\ +\210\002\000\000\000\000\167\001\183\002\018\000\237\005\000\000\ +\000\000\209\004\000\000\136\002\204\051\233\070\047\007\242\255\ +\000\000\251\004\000\000\057\005\000\000\057\005\046\007\131\001\ +\000\000\184\255\233\070\229\255\077\007\084\003\153\006\153\006\ +\212\080\151\001\192\000\194\255\245\006\233\070\011\078\043\078\ +\121\078\080\007\056\007\119\255\063\007\075\007\075\004\060\255\ +\000\000\000\000\028\005\131\007\075\004\186\006\205\005\229\255\ +\209\004\134\007\153\006\017\003\000\000\136\012\000\000\000\000\ +\204\051\218\000\144\007\000\000\000\000\110\002\111\001\116\004\ +\000\000\204\051\255\002\058\007\116\004\058\003\000\000\022\007\ +\081\007\000\000\216\041\048\007\000\000\000\000\000\000\116\004\ +\196\074\065\007\000\000\070\005\000\000\000\000\000\000\000\000\ +\087\001\000\000\129\255\000\000\000\000\000\000\053\003\000\000\ +\017\081\048\001\246\255\020\007\153\078\231\078\007\079\102\007\ +\129\001\082\007\000\000\129\072\000\000\092\007\000\000\095\007\ +\239\006\083\007\144\001\151\007\116\004\000\000\229\255\245\001\ +\102\000\051\007\084\007\108\006\150\007\150\007\165\007\093\007\ +\108\007\051\007\000\000\000\000\063\070\233\070\196\074\049\081\ +\000\000\201\003\233\070\000\000\075\004\000\000\150\003\000\000\ +\204\051\110\081\233\070\233\070\116\004\142\007\228\004\000\000\ +\162\015\233\070\025\065\021\072\164\007\000\000\152\002\214\066\ +\019\067\080\067\233\070\000\000\204\051\196\074\000\000\000\000\ +\000\000\122\000\000\000\196\074\075\004\229\255\229\255\107\001\ +\053\006\000\000\000\000\000\000\180\007\000\000\000\000\204\051\ +\000\000\116\004\134\255\116\004\134\255\134\255\229\255\000\000\ +\000\000\000\000\000\000\196\074\000\000\207\001\168\007\112\007\ +\110\002\000\000\000\000\151\006\175\007\000\000\000\000\000\000\ +\000\000\000\000\060\001\168\006\000\000\143\002\000\000\000\000\ +\000\000\000\000\168\007\229\255\137\007\139\007\147\007\000\000\ +\000\000\148\007\000\000\154\007\233\070\233\070\233\070\110\081\ +\000\000\157\007\000\000\158\007\000\000\159\007\199\007\033\006\ +\000\000\000\000\116\004\159\004\255\002\186\006\092\006\219\007\ +\000\000\000\000\000\000\075\004\255\002\183\002\098\002\211\007\ +\000\000\140\007\075\004\163\007\000\000\000\000\072\001\000\000\ +\000\000\172\255\000\000\204\051\110\002\138\007\022\007\000\000\ +\000\000\204\051\000\000\070\005\000\000\000\000\075\004\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\233\070\ +\233\070\233\070\000\000\000\000\000\000\202\007\237\005\000\000\ +\110\002\000\000\136\050\096\005\229\255\129\072\000\000\068\006\ +\141\007\000\000\092\007\216\041\009\002\229\255\000\000\135\007\ +\000\000\000\000\233\070\000\000\048\072\204\051\233\070\146\007\ +\149\007\204\051\000\000\233\070\152\007\000\000\000\000\162\007\ +\000\000\233\070\143\002\000\000\100\077\137\255\000\000\000\000\ +\116\004\000\000\000\000\000\000\233\070\233\070\051\007\142\001\ +\000\000\051\007\214\007\000\000\000\000\233\070\000\000\000\000\ +\000\000\141\002\000\000\091\007\000\000\035\002\000\000\121\002\ +\035\002\000\000\156\007\111\007\255\002\000\000\000\000\143\002\ +\075\004\248\003\204\051\116\004\233\070\116\004\229\255\116\004\ +\229\255\000\000\111\007\237\005\000\000\031\077\000\000\160\007\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\209\002\ +\000\000\000\000\129\072\215\007\233\070\233\070\233\070\094\079\ +\126\079\204\079\233\070\233\070\233\070\136\050\075\004\143\002\ +\000\000\000\000\148\006\208\003\060\255\163\002\000\000\000\000\ +\075\004\160\007\163\002\224\007\204\051\000\000\000\000\000\000\ +\000\000\000\000\116\004\022\007\059\000\236\079\058\080\090\080\ +\163\005\000\000\000\000\054\012\173\007\230\007\116\004\216\041\ +\190\007\000\000\231\007\116\004\186\007\000\000\190\002\116\004\ +\204\051\217\005\096\005\116\004\000\000\249\004\116\004\165\076\ +\000\000\000\000\000\000\246\007\000\000\000\000\000\000\247\007\ +\000\000\135\007\229\255\241\007\000\000\116\004\000\000\000\000\ +\000\000\116\004\000\000\048\072\233\070\110\081\053\006\000\000\ +\243\000\237\002\000\000\000\000\000\000\000\000\000\000\242\007\ +\204\051\172\007\233\070\000\000\233\070\000\000\053\006\100\005\ +\000\000\250\002\229\255\096\005\229\255\195\001\000\000\234\004\ +\000\000\000\000\023\002\000\000\127\049\148\014\097\047\000\000\ +\096\003\217\007\007\008\000\000\000\000\151\255\063\002\000\000\ +\150\255\078\003\063\002\229\255\163\005\110\081\110\081\110\081\ +\000\000\216\007\000\000\218\007\000\000\221\007\110\081\110\081\ +\110\081\229\255\255\002\053\006\081\006\081\006\043\005\000\000\ +\000\000\079\006\174\255\000\000\136\050\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\204\051\000\000\000\000\151\006\ +\229\002\190\001\222\003\134\255\216\041\208\007\203\007\014\008\ +\096\005\000\000\136\050\045\005\049\073\202\001\134\255\166\000\ +\001\006\096\005\000\000\165\076\120\054\000\000\000\000\233\070\ +\000\000\000\000\000\000\249\255\000\000\193\007\204\051\215\003\ +\021\072\000\000\000\000\000\000\204\051\000\000\025\001\000\000\ +\177\007\160\007\068\006\181\007\092\007\068\006\151\255\000\000\ +\116\004\007\008\160\007\092\007\000\000\116\004\204\051\000\000\ +\023\002\082\002\194\001\000\000\000\000\000\000\000\000\000\000\ +\201\007\000\000\000\000\151\006\233\070\233\070\233\070\000\000\ +\168\003\168\003\204\051\228\007\204\051\098\002\023\002\151\255\ +\248\001\000\000\000\000\229\255\000\000\053\005\068\005\116\004\ +\223\007\204\051\200\004\000\000\136\050\216\041\116\004\000\000\ +\000\000\217\072\000\000\058\003\116\004\000\000\136\050\000\000\ +\026\005\116\004\116\004\022\008\075\004\000\000\000\000\008\004\ +\233\070\000\000\116\004\238\007\229\255\068\006\068\006\156\072\ +\068\006\068\006\103\006\116\004\101\003\212\007\000\000\052\004\ +\000\000\246\002\179\002\116\004\000\000\000\000\000\000\000\000\ +\000\000\110\081\110\081\110\081\000\000\000\000\000\000\000\000\ +\151\255\000\000\000\000\000\000\000\000\000\000\186\006\136\050\ +\103\004\000\000\000\000\158\001\000\000\234\007\096\005\000\000\ +\000\000\186\006\159\000\000\000\000\000\222\007\000\000\227\007\ +\233\070\000\000\000\000\000\000\048\008\052\008\140\048\000\000\ +\054\008\056\008\233\070\050\008\000\000\000\000\092\007\007\008\ +\000\000\204\051\179\002\116\004\116\004\000\000\060\008\036\005\ +\000\000\000\000\116\004\116\004\116\004\116\004\229\255\000\000\ +\000\000\136\050\116\004\088\005\000\000\000\000\116\004\000\000\ +\000\000\120\054\120\054\051\007\116\004\053\008\238\001\204\051\ +\204\051\000\000\233\070\240\007\116\004\116\004\000\000\000\000\ +\163\005\204\051\163\005\220\003\033\003\000\000\000\000\096\005\ +\000\000\000\000\000\000\062\008\233\070\204\051\116\004\116\004\ +\000\000\000\000\000\000\116\004\229\255\151\006\225\007\250\007\ +\068\006\147\004\092\007\073\008\229\255\116\004\204\051\000\000\ +\116\004\000\000\000\000\000\000\000\000\074\008\068\006\068\006\ +\204\051\000\000\057\004\120\054\077\008\079\008\116\004\233\070\ +\229\255\204\051\204\051\000\000\000\000\116\004\116\004" + +let yyrindex = "\000\000\ +\094\009\095\009\000\008\000\000\000\000\000\000\000\000\000\000\ +\232\076\000\000\000\000\148\070\000\000\022\003\029\003\171\006\ +\000\000\000\000\001\075\076\073\135\074\062\071\230\002\000\000\ +\232\076\000\000\000\000\000\000\000\000\000\000\000\000\028\075\ +\012\019\000\000\000\000\062\071\000\000\000\000\246\005\069\005\ +\015\002\042\004\000\000\000\000\000\000\099\000\000\000\000\000\ +\062\071\149\008\000\000\000\000\171\006\062\071\000\000\000\000\ +\176\040\099\000\128\019\000\000\016\046\000\000\149\013\000\000\ +\000\000\114\015\000\000\000\000\000\000\113\059\000\000\000\000\ +\122\059\171\059\000\000\215\059\000\000\000\000\000\000\000\000\ +\000\000\000\000\058\027\174\027\081\026\197\026\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\022\003\029\003\131\004\ +\246\005\116\000\149\008\000\000\000\000\000\000\000\000\222\041\ +\000\000\000\000\065\042\012\043\000\000\116\000\000\000\000\000\ +\000\000\000\000\111\043\000\000\058\044\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\002\008\000\000\000\008\000\000\ +\000\000\000\000\000\000\247\008\000\000\000\000\000\000\000\000\ +\134\014\134\014\000\000\079\010\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\247\010\ +\000\000\000\000\000\000\060\049\114\018\000\000\000\000\000\000\ +\001\075\036\076\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\150\052\000\000\000\000\ +\253\002\225\005\000\000\000\000\000\000\139\006\000\000\002\053\ +\000\000\000\000\000\000\165\060\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\022\003\239\255\000\000\000\000\ +\000\000\000\000\089\075\000\000\000\000\000\000\067\002\124\002\ +\000\000\227\255\000\000\000\000\037\000\000\000\000\000\170\255\ +\000\000\142\005\000\000\117\255\095\001\000\000\199\006\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\008\008\052\060\008\008\029\003\251\007\042\004\ +\177\075\000\000\000\000\000\000\167\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\076\062\162\062\230\002\000\000\000\000\248\062\078\063\ +\000\000\185\000\000\000\000\000\000\000\000\000\000\000\008\008\ +\000\000\069\005\000\000\000\000\002\004\000\000\251\007\000\000\ +\000\000\000\000\079\005\000\000\000\000\000\000\000\000\099\000\ +\222\055\028\075\000\000\149\013\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\220\035\000\000\000\000\204\075\000\000\000\000\ +\212\004\000\000\252\007\000\000\108\003\000\000\108\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\237\017\244\024\000\000\000\000\000\000\034\028\ +\151\028\000\000\000\000\239\255\000\000\000\000\000\000\000\000\ +\079\005\000\000\000\000\000\000\252\007\000\000\108\003\000\000\ +\059\014\000\000\000\000\000\000\000\000\000\000\000\000\247\008\ +\000\000\000\000\000\000\000\000\000\000\000\000\153\001\000\000\ +\095\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\207\255\000\000\076\008\000\000\078\008\084\008\000\000\000\000\ +\131\004\096\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\ +\000\000\146\000\068\000\095\001\000\000\199\006\000\000\235\000\ +\000\000\251\007\238\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\008\008\165\060\ +\000\000\229\050\011\029\000\000\000\000\000\000\000\000\239\255\ +\000\000\045\008\000\000\000\000\000\000\000\000\000\000\221\057\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\057\008\000\000\ +\246\061\215\059\064\004\000\000\000\000\127\029\000\000\000\000\ +\000\000\000\000\000\000\146\255\000\000\000\000\228\000\000\000\ +\000\000\000\000\148\005\000\000\090\001\000\000\000\000\018\008\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\251\007\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\175\004\000\000\000\000\008\008\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\138\038\242\038\ +\090\039\034\016\245\040\194\039\080\036\197\036\057\037\173\037\ +\034\033\244\029\104\030\034\038\150\033\011\034\042\040\220\030\ +\127\034\243\034\104\035\000\000\000\000\081\031\000\000\000\000\ +\085\001\000\000\239\255\239\255\088\041\000\000\000\000\000\000\ +\000\000\244\019\000\000\000\000\000\000\104\025\221\025\000\000\ +\000\000\000\000\128\024\000\000\000\000\146\040\045\008\117\011\ +\057\008\000\000\000\000\124\012\096\007\012\043\000\000\000\000\ +\000\000\000\000\000\000\000\000\175\004\000\000\239\255\000\000\ +\000\000\000\000\000\000\061\014\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\173\061\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\230\046\000\000\000\000\000\000\000\000\073\047\ +\000\000\000\000\000\000\000\000\172\047\000\000\000\000\000\000\ +\000\000\000\000\156\255\000\000\000\000\245\000\090\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\016\001\000\000\067\006\000\000\202\000\000\000\000\000\000\000\ +\118\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\045\008\ +\023\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\139\058\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\031\ +\000\000\000\000\000\000\147\071\000\000\204\005\000\000\000\000\ +\000\000\000\000\000\000\086\002\000\000\000\000\217\255\000\000\ +\067\000\000\000\000\000\006\000\000\000\144\000\000\000\000\000\ +\000\000\000\000\000\000\155\006\029\008\000\000\000\000\000\000\ +\000\000\170\005\000\000\000\000\230\057\028\007\000\000\188\006\ +\000\000\019\004\003\001\018\001\062\001\000\000\000\000\000\000\ +\089\075\204\058\000\000\000\000\000\000\000\000\000\000\215\059\ +\000\000\000\000\000\000\216\005\215\059\089\075\159\005\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\095\001\000\000\199\006\000\000\230\002\ +\000\000\000\000\000\000\230\057\000\000\000\000\045\008\045\008\ +\000\000\142\081\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\219\005\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\043\ +\000\000\000\000\045\008\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\230\001\ +\000\000\000\000\008\001\000\000\147\001\000\000\000\000\017\048\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\182\000\ +\000\000\002\001\000\000\217\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\069\008\187\054\000\000\ +\106\055\000\000\000\000\189\007\139\058\000\000\215\059\000\000\ +\000\000\009\000\000\000\250\255\040\008\040\008\254\255\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\120\046\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\172\000\000\000\000\000\083\008\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\215\059\253\058\000\000\ +\138\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\148\077\018\005\147\071\079\002\134\003\168\004\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\182\009\000\000\ +\000\000\000\000\000\000\215\059\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\082\056\253\058\000\000\000\000\105\020\000\000\ +\000\000\221\020\000\000\081\021\000\000\000\000\000\000\192\041\ +\000\000\198\021\000\000\058\022\000\000\174\022\000\000\000\000\ +\000\000\000\000\252\004\000\000\197\006\000\000\175\004\246\006\ +\000\000\089\008\000\000\000\000\252\052\012\043\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\153\001\000\000\ +\000\000\000\000\238\063\000\000\000\000\099\008\116\048\000\000\ +\000\000\000\000\000\000\230\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\023\008\000\000\ +\000\000\000\000\000\000\000\000\253\058\000\000\000\000\000\000\ +\000\000\000\000\085\005\000\000\000\000\215\059\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\152\006\000\000\170\003\000\000\032\006\000\000\000\000\ +\117\006\000\000\000\000\057\032\007\059\000\000\000\000\000\000\ +\000\000\000\000\000\000\248\005\000\000\038\004\168\004\117\004\ +\168\004\000\000\174\032\159\005\000\000\087\008\000\000\208\255\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\019\041\000\000\000\000\ +\000\000\208\255\019\041\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\144\016\215\048\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\037\015\059\008\000\000\ +\000\000\236\054\000\000\189\011\000\000\000\000\000\000\137\073\ +\000\000\028\075\000\000\047\003\000\000\000\000\027\058\110\053\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\069\059\215\059\000\000\000\000\058\000\000\000\000\000\ +\000\000\017\002\000\000\000\000\000\000\035\042\001\017\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\131\056\000\000\ +\000\000\000\000\168\004\000\000\168\004\072\008\000\000\069\008\ +\000\000\000\000\000\000\000\000\000\000\000\000\100\008\245\011\ +\184\056\000\000\237\056\000\000\000\000\147\016\253\058\000\000\ +\000\000\000\000\253\058\253\058\000\000\134\042\238\042\081\043\ +\000\000\035\023\000\000\151\023\000\000\011\024\180\043\028\044\ +\127\044\019\041\079\017\116\050\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\253\058\ +\000\000\000\000\119\002\146\003\000\000\194\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\146\003\000\000\ +\002\004\000\000\000\000\182\053\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\020\006\000\000\ +\094\008\072\008\000\000\101\008\069\008\000\000\147\016\000\000\ +\056\057\109\057\162\003\069\008\000\000\024\056\000\000\000\000\ +\000\000\234\012\215\059\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\253\058\000\000\000\000\000\000\000\000\ +\136\049\194\049\000\000\010\078\000\000\000\000\000\000\118\057\ +\012\043\000\000\000\000\019\041\000\000\000\000\000\000\252\007\ +\000\000\000\000\000\000\000\000\000\000\000\000\080\058\000\000\ +\030\055\000\000\000\000\000\000\252\007\000\000\000\000\000\000\ +\000\000\240\053\219\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\172\006\000\000\168\004\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\056\000\000\000\000\000\000\000\000\ +\000\000\234\012\000\000\129\058\000\000\000\000\000\000\000\000\ +\000\000\226\044\074\045\173\045\000\000\000\000\000\000\000\000\ +\118\057\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\253\005\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\046\008\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\069\008\168\057\ +\000\000\000\000\000\000\129\058\129\058\000\000\252\049\000\000\ +\000\000\000\000\148\077\223\005\038\004\117\004\005\004\000\000\ +\000\000\000\000\042\054\000\000\000\000\000\000\111\005\000\000\ +\000\000\000\000\000\000\000\000\193\004\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\058\050\129\058\000\000\000\000\ +\000\000\000\000\000\000\104\008\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\077\009\186\010\ +\000\000\000\000\000\000\164\055\005\004\005\004\107\008\109\008\ +\000\000\110\008\069\008\000\000\005\004\100\054\000\000\000\000\ +\164\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\095\004\000\000\ +\005\004\000\000\000\000\000\000\000\000\050\009\222\010" + +let yygindex = "\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\033\000\ +\215\255\000\000\089\000\072\000\013\006\049\009\060\000\000\000\ +\214\255\126\000\233\001\099\253\000\000\217\254\078\006\071\255\ +\127\008\195\013\029\254\247\255\098\004\194\013\074\252\051\000\ +\093\000\023\000\026\000\034\000\000\000\000\000\000\000\000\000\ +\045\000\047\000\000\000\049\000\000\000\002\000\013\000\088\007\ +\093\001\000\000\000\000\000\000\000\000\000\000\000\000\052\000\ +\000\000\000\000\000\000\000\000\000\000\014\255\005\252\000\000\ +\000\000\000\000\027\000\000\000\000\000\142\254\251\253\032\252\ +\115\251\156\251\083\255\000\000\226\003\000\000\176\004\175\251\ +\113\255\059\004\000\000\000\000\000\000\000\000\000\000\000\000\ +\107\003\015\000\026\251\047\255\103\253\199\251\017\253\135\252\ +\095\251\043\254\247\003\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\046\000\200\006\ +\003\006\006\006\000\000\000\000\078\255\022\000\000\000\168\255\ +\184\001\059\253\000\254\108\010\156\012\000\000\000\000\000\000\ +\110\255\049\008\009\013\119\007\031\000\094\255\207\000\159\254\ +\000\000\080\008\100\007\216\011\115\253\000\000\078\254\000\000\ +\000\000\000\000\050\004\009\006\163\255\164\004\000\000\000\000\ +\000\000\000\000\073\000\000\000\235\007\157\255\254\007\021\007\ +\045\009\000\000\000\000\198\004\000\000\000\000\085\008\213\253\ +\190\005\138\251\021\251\213\251\011\253\000\000\097\253\000\000\ +\122\005\000\000\000\000\046\251\066\255\001\253\251\006\041\008\ +\000\000\000\000\099\004\000\000\000\000\137\004\078\252\000\000\ +\066\004\017\005\000\000\146\253\235\012\133\255\000\000\071\006\ +\128\255\220\254\141\255\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\082\255\000\000" + +let yytablesize = 21372 +let yytable = "\188\000\ +\019\002\185\001\188\000\108\000\188\000\188\000\188\000\161\001\ +\248\001\188\000\188\000\188\000\188\000\188\000\109\000\188\000\ +\200\001\127\002\180\001\010\002\162\001\127\003\188\000\002\002\ +\102\000\125\002\188\000\103\000\001\002\188\000\188\000\188\000\ +\193\000\056\000\213\003\104\000\192\000\040\002\009\003\188\000\ +\188\000\216\000\160\001\188\000\188\000\171\001\105\000\209\000\ +\106\000\166\001\107\000\171\004\129\003\112\000\222\003\196\003\ +\136\001\194\001\030\002\223\000\031\002\085\003\127\000\133\000\ +\124\004\170\003\064\001\224\004\140\001\186\001\219\001\014\005\ +\133\004\005\004\125\000\132\000\021\001\159\000\065\001\112\005\ +\056\001\158\005\075\005\162\005\188\000\188\000\188\000\188\000\ +\154\001\188\000\156\001\124\000\163\001\063\000\134\002\063\000\ +\063\000\113\003\051\000\108\000\051\002\201\003\037\002\023\003\ +\124\001\054\001\128\001\129\001\075\001\090\003\109\000\108\000\ +\165\005\090\005\005\002\089\000\143\001\128\005\049\004\040\003\ +\102\000\098\003\109\000\103\000\209\003\224\002\143\001\161\002\ +\089\004\162\002\149\000\104\000\102\000\054\004\073\005\103\000\ +\036\005\054\002\063\000\187\001\062\001\011\005\105\000\104\000\ +\106\000\138\001\107\000\145\001\021\002\112\000\076\001\188\000\ +\188\000\170\001\105\000\219\001\106\000\169\005\107\000\070\001\ +\237\004\112\000\114\005\225\001\230\002\052\002\151\005\055\004\ +\099\005\142\001\182\001\180\005\059\002\186\000\224\001\126\005\ +\165\001\010\000\234\001\243\001\040\003\191\005\234\005\023\004\ +\186\000\220\001\127\000\188\000\153\001\221\001\133\000\103\003\ +\133\000\035\004\186\000\024\003\222\001\201\003\128\002\223\001\ +\152\001\207\001\186\000\243\001\244\001\188\002\142\001\165\005\ +\143\001\103\003\235\001\143\001\050\004\090\003\245\001\200\002\ +\145\001\151\001\168\003\076\001\110\002\063\000\090\004\076\001\ +\114\002\076\001\151\001\014\002\244\001\232\002\037\005\231\001\ +\232\001\104\003\076\005\207\005\138\001\200\002\245\001\022\002\ +\138\001\015\004\173\002\145\001\218\005\035\004\219\001\186\000\ +\087\003\088\003\219\001\104\003\155\005\151\001\197\003\246\001\ +\196\005\040\006\247\001\053\002\118\003\141\001\200\002\231\004\ +\142\001\221\005\070\004\239\001\188\000\188\000\173\002\157\001\ +\200\002\003\004\184\002\006\002\226\000\024\004\208\005\246\001\ +\223\000\163\001\247\001\114\005\115\003\040\005\104\001\036\004\ +\042\005\009\003\188\000\221\001\134\001\204\002\198\003\071\001\ +\189\002\192\002\141\001\193\002\140\004\173\002\204\002\173\002\ +\188\000\182\002\193\000\145\001\168\002\188\000\145\001\145\001\ +\211\002\200\002\104\005\173\002\200\002\151\001\221\001\160\001\ +\188\000\151\001\147\001\212\001\181\002\077\001\160\001\064\001\ +\160\001\239\002\009\003\152\004\016\004\212\001\002\002\171\001\ +\171\001\029\004\030\004\095\004\227\000\165\005\222\005\226\000\ +\119\003\218\002\100\003\223\000\234\001\147\001\175\002\234\001\ +\231\005\234\001\051\000\234\001\141\001\234\001\104\001\034\003\ +\013\006\237\005\140\005\142\005\150\002\068\004\152\002\063\000\ +\153\002\063\000\019\006\089\000\069\002\206\001\046\003\118\003\ +\238\005\170\004\070\002\122\003\051\000\121\004\221\001\134\001\ +\055\002\059\006\221\001\234\001\120\006\234\001\122\002\186\000\ +\047\006\064\002\118\002\119\002\068\002\089\000\123\002\144\001\ +\124\001\214\001\140\004\177\005\063\000\234\001\071\003\227\000\ +\105\005\144\001\228\002\049\002\129\002\147\001\061\006\212\001\ +\147\001\147\001\212\001\049\006\076\001\214\005\140\002\188\000\ +\187\001\017\002\101\002\137\001\018\002\149\003\104\002\100\006\ +\195\005\102\006\220\001\215\005\030\000\220\001\221\001\021\005\ +\127\002\190\000\130\002\170\001\170\001\222\001\051\000\033\004\ +\223\001\225\001\000\006\131\002\146\001\105\001\058\005\170\003\ +\188\000\207\001\110\006\125\003\225\001\207\001\122\004\089\000\ +\220\001\207\001\133\000\207\001\133\000\087\006\133\000\207\001\ +\213\001\225\001\225\001\207\001\132\002\233\004\234\001\146\001\ +\234\001\118\003\213\001\136\001\207\001\218\001\133\002\186\000\ +\114\001\229\002\143\002\144\001\214\001\141\002\144\001\173\000\ +\186\000\225\001\139\005\076\001\215\001\076\001\027\003\076\001\ +\246\005\050\002\220\001\076\006\062\006\234\001\221\001\234\001\ +\010\003\215\002\137\002\216\005\140\002\222\001\137\001\081\002\ +\223\001\150\003\137\001\220\004\240\003\009\003\003\006\157\001\ +\220\001\135\002\207\001\157\001\220\001\129\002\127\002\157\001\ +\081\002\157\001\170\002\034\004\228\005\157\001\188\000\146\001\ +\204\003\108\000\146\001\146\001\207\001\207\001\024\006\207\001\ +\207\001\216\000\157\001\200\001\109\000\030\000\205\003\033\004\ +\136\003\137\003\190\000\130\002\213\001\072\004\102\000\213\001\ +\186\000\103\000\207\001\196\004\131\002\133\002\136\001\053\004\ +\218\001\104\000\160\001\063\000\218\001\061\004\166\005\135\003\ +\143\002\229\004\002\002\141\002\105\000\107\001\106\000\215\001\ +\107\000\031\003\050\003\112\000\221\003\132\002\137\005\216\000\ +\157\001\216\002\186\000\236\001\215\002\209\000\215\002\133\002\ +\137\002\007\003\186\000\216\002\087\004\081\002\171\002\211\003\ +\076\003\078\003\157\001\157\001\117\003\157\001\157\001\135\002\ +\109\001\096\002\041\003\002\002\237\001\206\001\102\005\234\001\ +\220\003\206\001\234\001\241\003\106\003\206\001\206\003\206\001\ +\157\001\191\001\047\002\206\001\076\004\176\004\118\003\206\001\ +\175\003\186\000\175\002\094\004\203\001\203\001\015\003\017\003\ +\206\001\083\003\103\004\082\003\243\001\253\004\032\004\197\004\ +\234\003\227\001\228\001\133\002\193\003\028\003\031\001\236\005\ +\023\003\063\000\123\003\041\005\097\002\142\004\120\001\121\001\ +\127\001\019\004\244\005\020\004\186\000\225\001\252\001\041\003\ +\051\006\251\001\111\001\103\003\088\004\216\002\091\003\092\003\ +\016\002\250\003\215\002\096\002\023\003\096\002\206\001\225\001\ +\244\005\225\001\252\001\225\001\186\000\173\004\192\001\225\001\ +\077\004\169\005\092\006\007\003\186\000\052\006\142\003\170\002\ +\206\001\206\001\133\000\206\001\206\001\187\000\251\003\252\003\ +\236\003\031\000\124\003\170\002\104\004\104\003\008\004\234\001\ +\188\004\035\000\031\000\053\006\009\003\004\004\206\001\077\004\ +\235\003\021\003\035\000\127\001\253\003\051\001\097\002\086\004\ +\097\002\140\003\044\006\076\001\023\003\225\001\081\004\127\003\ +\032\006\002\002\234\001\010\003\180\001\013\000\110\004\191\005\ +\253\004\044\006\069\004\094\006\071\001\187\001\079\004\187\001\ +\180\004\023\003\182\004\184\004\054\006\066\004\025\003\120\004\ +\018\000\185\002\187\001\225\001\222\004\254\003\129\003\074\003\ +\160\001\199\005\153\005\227\004\190\001\228\003\162\003\163\003\ +\198\002\025\003\119\005\024\000\010\003\212\005\207\003\133\003\ +\025\003\002\002\093\003\224\000\189\004\083\004\220\003\225\001\ +\138\001\222\001\154\005\189\001\243\001\185\003\186\000\144\003\ +\168\000\141\003\071\001\009\003\052\004\255\003\025\003\025\003\ +\236\001\155\003\171\002\195\003\023\003\169\000\188\000\077\004\ +\000\004\016\005\025\003\009\003\253\005\244\001\255\005\025\003\ +\171\002\167\005\025\003\171\002\025\003\172\002\047\000\245\001\ +\122\002\237\001\106\003\230\002\200\004\171\002\190\001\230\002\ +\166\000\249\001\063\000\172\002\186\000\195\002\172\002\108\000\ +\231\002\220\001\184\003\122\002\243\005\221\001\224\000\109\003\ +\172\002\122\002\109\000\196\002\222\001\077\002\234\001\223\001\ +\009\003\106\003\094\002\187\001\102\000\025\003\085\002\103\000\ +\246\001\071\001\141\001\247\001\122\002\059\004\187\001\104\000\ +\094\002\048\005\225\001\120\001\121\001\013\004\211\002\253\004\ +\211\002\187\001\105\000\045\005\106\000\225\001\107\000\159\004\ +\075\004\112\000\025\004\222\001\232\002\171\002\223\001\201\005\ +\232\002\171\002\111\003\122\002\122\002\253\004\211\002\186\000\ +\090\006\091\006\164\002\234\001\183\002\190\000\187\001\091\005\ +\172\002\007\002\225\001\143\001\172\002\122\002\122\002\122\002\ +\094\002\098\005\186\000\002\002\241\002\242\002\211\002\094\002\ +\110\004\185\000\012\004\197\002\107\003\201\002\203\002\205\002\ +\122\002\030\000\002\002\234\001\011\003\209\002\186\000\008\002\ +\017\000\031\005\094\002\124\005\185\000\220\001\236\004\166\000\ +\249\001\221\001\191\000\185\000\164\002\164\002\074\005\248\003\ +\222\001\009\004\129\006\223\001\186\000\071\001\106\003\010\003\ +\146\001\178\003\243\002\103\003\141\005\255\002\164\002\190\001\ +\234\001\185\000\234\001\179\003\009\002\010\004\047\005\253\004\ +\014\006\071\001\198\005\051\000\180\001\185\000\190\001\147\001\ +\180\001\253\004\187\001\230\002\180\001\185\000\180\001\185\000\ +\025\003\029\003\180\001\180\001\135\004\136\004\180\001\129\002\ +\043\006\007\003\186\000\186\000\149\005\104\003\015\005\180\001\ +\002\002\007\002\146\004\147\004\048\000\110\004\092\005\051\000\ +\025\003\153\004\125\002\193\004\057\003\190\001\025\003\030\000\ +\222\002\234\001\167\004\106\003\190\000\130\002\023\003\249\003\ +\185\000\030\000\253\004\106\003\091\004\023\003\131\002\008\002\ +\220\001\023\003\025\003\186\000\221\001\234\001\180\001\029\000\ +\186\000\023\003\223\002\222\001\232\002\180\001\223\001\103\003\ +\023\003\095\005\225\001\025\003\025\003\176\005\145\004\132\002\ +\166\000\249\001\025\003\025\003\208\003\025\003\015\003\180\001\ +\180\001\133\002\180\001\180\001\009\002\025\003\023\003\023\003\ +\215\000\052\003\168\004\051\000\253\004\004\003\150\000\234\004\ +\175\000\002\002\023\003\106\006\059\005\180\001\053\003\023\003\ +\129\002\104\003\023\003\161\001\023\003\178\004\186\000\058\003\ +\215\001\183\001\163\005\038\006\159\005\077\002\012\005\214\003\ +\162\001\200\005\243\001\243\004\106\003\025\003\025\003\187\001\ +\030\000\025\003\170\005\216\001\213\005\190\000\130\002\239\003\ +\107\006\059\003\092\004\246\003\054\003\143\004\115\005\131\002\ +\225\001\039\006\225\001\244\001\225\001\023\003\187\001\225\001\ +\158\001\186\000\023\003\106\003\192\005\245\001\051\000\148\003\ +\187\001\200\002\234\001\023\003\234\001\165\001\234\001\144\004\ +\132\002\165\001\028\004\166\000\249\001\220\001\203\001\159\003\ +\200\002\221\001\133\002\165\001\161\001\140\003\010\003\200\002\ +\222\001\193\001\020\005\223\001\165\001\211\002\023\005\211\002\ +\006\005\162\001\002\002\027\005\238\002\146\000\246\001\210\005\ +\211\002\247\001\017\002\211\002\106\003\018\002\200\002\176\001\ +\200\002\106\003\188\003\023\003\038\005\039\005\002\002\160\001\ +\144\002\234\001\200\002\220\003\163\000\044\005\206\002\165\000\ +\190\001\150\000\242\005\165\001\150\000\234\001\150\000\150\000\ +\207\002\225\005\122\005\186\000\145\002\211\002\234\001\119\006\ +\188\000\186\000\234\001\022\005\053\005\131\005\211\002\026\005\ +\001\006\150\000\166\000\249\001\021\003\175\000\175\000\163\001\ +\175\000\054\003\187\000\200\002\187\001\181\001\200\002\198\001\ +\187\001\139\004\175\000\175\000\150\000\010\003\164\001\021\003\ +\186\000\036\006\164\001\150\000\077\002\124\001\021\003\002\002\ +\007\002\164\001\025\006\197\000\210\005\010\003\106\003\146\002\ +\187\001\022\001\175\000\175\000\147\002\164\001\013\002\051\000\ +\050\005\150\000\150\000\103\006\021\003\002\002\109\003\187\001\ +\030\000\186\000\220\003\065\005\051\000\150\000\008\002\029\000\ +\021\003\188\001\029\000\110\003\017\006\150\000\195\001\150\000\ +\021\003\186\000\021\003\104\006\029\000\029\000\042\006\186\000\ +\029\000\106\003\010\003\128\006\164\001\049\005\236\001\023\001\ +\106\003\029\000\029\000\029\000\029\000\024\001\196\000\006\005\ +\187\000\089\001\090\001\009\002\138\005\023\003\122\005\029\000\ +\029\000\111\003\051\000\211\002\004\003\129\002\102\001\237\001\ +\150\000\196\000\146\005\021\003\147\005\186\000\131\005\214\000\ +\196\000\084\004\186\000\029\000\211\002\023\003\029\000\226\001\ +\029\000\029\000\029\000\029\000\158\001\030\000\187\001\095\001\ +\029\000\029\000\190\000\130\002\177\002\131\005\196\000\029\000\ +\006\005\025\002\215\000\103\001\131\002\023\003\211\002\187\001\ +\100\001\124\001\196\000\029\000\234\001\029\000\217\004\029\000\ +\029\000\196\000\196\000\172\004\196\000\025\003\144\005\021\003\ +\186\000\232\005\122\005\029\000\235\005\132\002\029\000\255\002\ +\230\001\146\000\029\000\229\001\023\003\186\000\026\002\133\002\ +\218\004\178\002\021\003\187\004\161\005\025\003\234\001\023\003\ +\047\002\021\003\025\003\025\003\050\006\131\005\138\003\010\006\ +\162\004\164\004\166\004\234\001\025\003\196\000\169\004\220\005\ +\131\005\234\001\025\003\047\002\255\002\006\005\187\001\021\003\ +\021\003\187\001\047\002\047\002\026\003\110\002\006\005\111\002\ +\181\001\011\006\234\001\021\003\023\003\025\003\187\001\135\002\ +\198\001\112\002\234\001\021\003\255\002\021\003\243\001\025\003\ +\047\002\047\002\223\003\077\002\029\006\030\006\224\003\033\006\ +\034\006\011\003\017\004\102\001\047\002\225\003\150\000\187\001\ +\226\003\143\003\241\001\047\002\047\002\150\000\047\002\150\000\ +\252\001\227\003\198\001\150\004\224\005\055\006\150\000\150\000\ +\007\004\150\000\227\005\023\003\023\003\051\000\021\003\015\002\ +\056\006\020\006\023\003\243\001\252\001\150\000\023\003\018\004\ +\130\005\150\000\234\001\234\001\240\005\175\000\175\000\023\003\ +\026\006\234\001\234\001\234\001\234\001\023\003\077\002\047\002\ +\186\000\131\005\211\002\021\006\156\005\234\001\023\003\051\000\ +\146\003\011\003\187\005\187\001\023\003\146\000\175\000\175\000\ +\175\000\023\003\155\001\187\001\234\001\188\005\175\000\009\006\ +\211\002\220\001\073\003\081\006\211\002\221\001\158\001\023\002\ +\211\002\211\002\211\002\211\002\222\001\187\001\187\001\223\001\ +\113\001\157\005\122\005\190\000\122\005\175\000\175\000\211\002\ +\065\006\023\003\175\000\108\006\131\005\215\000\175\000\187\001\ +\023\003\013\002\074\006\006\005\209\005\011\003\214\002\134\003\ +\215\002\187\001\150\000\150\000\005\006\187\001\024\002\118\006\ +\139\001\198\001\216\002\146\000\187\001\187\001\211\002\088\006\ +\000\005\150\000\175\000\110\005\025\003\125\006\126\006\186\000\ +\058\004\148\001\154\001\175\000\027\002\215\002\196\002\196\002\ +\155\001\013\002\097\006\216\002\202\002\196\002\001\005\029\002\ +\186\000\178\002\030\000\014\000\069\006\175\000\002\005\183\001\ +\003\005\178\002\196\002\048\002\112\006\186\000\051\000\077\006\ +\196\002\187\000\015\000\016\000\103\003\004\005\023\003\018\002\ +\146\000\025\003\215\002\013\003\006\005\185\002\048\002\023\000\ +\216\002\023\003\019\003\196\002\196\002\048\002\048\002\069\006\ +\069\006\148\005\058\001\186\000\082\000\095\006\096\006\132\006\ +\175\000\023\003\031\000\051\000\051\000\074\001\164\003\050\005\ +\157\002\011\002\035\000\048\002\048\002\036\002\104\003\147\000\ +\039\000\109\005\089\000\113\006\186\000\030\000\042\000\048\002\ +\181\001\245\004\110\005\135\002\181\001\051\000\048\002\048\002\ +\181\001\048\002\181\001\011\002\123\006\187\000\181\001\181\001\ +\247\004\147\000\181\001\242\003\089\000\083\000\127\006\043\002\ +\252\001\069\006\050\000\181\001\183\000\053\000\041\002\134\006\ +\135\006\150\000\243\003\244\003\150\000\072\002\073\002\074\002\ +\075\002\217\001\135\002\150\000\252\001\150\000\150\000\146\000\ +\166\000\076\002\048\002\161\000\057\002\023\003\183\000\151\003\ +\023\003\023\003\186\000\150\000\218\001\023\003\023\003\065\002\ +\175\000\152\003\181\001\210\001\058\002\150\000\161\000\210\001\ +\127\005\181\001\063\004\187\000\023\003\161\000\023\003\175\000\ +\175\000\210\001\023\003\064\003\245\002\246\002\023\003\023\003\ +\023\003\064\004\210\001\181\001\181\001\077\002\181\001\181\001\ +\065\003\060\002\155\001\161\000\161\000\023\003\155\001\150\000\ +\139\002\150\000\155\001\023\003\155\001\102\001\150\000\161\000\ +\155\001\181\001\025\003\175\000\155\001\071\002\161\000\161\000\ +\140\002\161\000\120\002\150\000\175\000\155\001\175\000\120\002\ +\189\000\054\003\025\003\196\000\023\003\198\000\199\000\200\000\ +\013\002\215\004\201\000\202\000\203\000\204\000\205\000\220\001\ +\206\000\245\002\248\002\221\001\017\002\007\003\186\000\018\002\ +\209\001\126\004\222\001\057\001\209\001\223\001\059\001\060\001\ +\061\001\035\006\161\000\215\000\155\001\159\002\209\001\175\000\ +\066\001\067\001\154\001\155\001\068\001\069\001\154\001\209\001\ +\186\000\160\002\154\001\163\002\154\001\135\002\013\002\103\003\ +\154\001\154\001\164\002\167\001\063\003\155\001\155\001\167\001\ +\155\001\155\001\064\003\093\005\151\002\154\001\150\000\198\004\ +\165\002\011\003\128\000\198\000\190\005\186\000\094\005\065\003\ +\172\002\199\004\167\001\155\001\173\002\132\001\133\001\134\001\ +\135\001\174\002\137\001\180\002\164\002\146\000\198\000\176\001\ +\186\002\104\003\185\002\176\001\082\000\198\000\215\002\082\000\ +\135\002\190\002\176\001\191\002\154\001\176\001\135\002\225\002\ +\215\002\082\000\227\002\154\001\002\003\082\000\176\001\150\000\ +\186\000\071\001\150\000\198\000\198\000\237\002\082\000\082\000\ +\082\000\082\000\011\003\150\000\018\003\154\001\154\001\198\000\ +\154\001\154\001\025\003\025\003\150\000\082\000\198\000\198\000\ +\030\003\198\000\175\000\166\002\167\002\083\000\032\003\043\003\ +\196\001\197\001\035\003\154\001\044\003\176\001\048\003\044\002\ +\082\000\045\002\083\000\082\000\247\002\249\002\083\000\082\000\ +\082\000\069\003\051\003\046\002\045\003\175\000\082\000\083\000\ +\083\000\083\000\083\000\047\003\082\000\115\002\008\003\116\002\ +\049\003\070\003\198\000\219\002\240\001\220\002\083\000\175\001\ +\082\000\117\002\082\000\175\001\082\000\082\000\051\000\221\002\ +\175\000\037\004\175\001\038\004\090\001\175\001\135\002\062\003\ +\082\000\083\000\150\000\082\000\083\000\039\004\094\003\083\000\ +\083\000\083\000\150\000\086\003\175\000\175\000\083\000\083\000\ +\101\003\175\000\175\000\175\000\108\003\083\000\150\000\175\000\ +\096\004\114\003\097\004\135\002\116\003\175\000\135\002\120\003\ +\130\003\083\000\139\003\083\000\098\004\083\000\083\000\094\000\ +\120\002\150\000\007\003\186\000\071\001\175\001\192\001\120\002\ +\145\003\083\000\120\002\153\003\083\000\175\000\095\000\016\000\ +\083\000\222\001\160\003\172\003\120\002\038\002\039\002\173\003\ +\120\002\047\002\186\003\096\000\245\002\177\002\199\003\013\002\ +\054\003\120\002\120\002\120\002\120\002\077\002\212\003\230\003\ +\229\003\231\003\232\003\048\002\233\003\174\000\031\000\237\003\ +\120\002\070\000\014\004\021\004\027\004\051\004\035\000\047\004\ +\060\004\056\002\105\003\067\004\097\000\010\000\063\002\080\004\ +\208\000\082\004\042\000\120\002\178\002\135\002\120\002\085\004\ +\177\002\120\002\120\002\120\002\135\002\102\004\111\004\116\004\ +\120\002\120\002\098\000\105\004\117\004\150\000\219\000\120\002\ +\127\004\125\004\130\004\150\000\132\004\149\004\099\000\014\000\ +\135\002\053\000\131\004\120\002\164\002\120\002\158\004\120\002\ +\120\002\177\004\190\004\195\004\164\002\192\004\015\000\016\000\ +\203\004\164\002\204\004\120\002\250\004\005\005\120\002\175\000\ +\205\004\206\004\120\002\023\000\214\004\150\000\164\002\207\004\ +\164\002\164\002\211\004\212\004\213\004\221\004\175\000\150\000\ +\225\004\226\004\228\004\150\000\241\004\164\002\031\000\013\005\ +\235\004\074\001\029\005\018\005\013\002\101\005\035\000\024\005\ +\043\005\077\005\025\005\117\005\039\000\028\005\021\003\072\005\ +\164\002\046\005\042\000\164\002\116\005\120\005\164\002\164\002\ +\164\002\121\005\123\005\133\005\136\005\079\003\164\002\143\005\ +\169\002\145\005\129\000\121\000\164\002\164\005\059\005\184\001\ +\202\005\013\002\135\002\205\005\150\000\181\005\050\000\182\005\ +\164\002\053\000\183\005\206\005\164\002\164\002\223\005\150\000\ +\230\005\199\001\174\000\174\000\233\005\174\000\248\005\008\006\ +\164\002\194\002\023\006\164\002\175\000\027\006\041\006\174\000\ +\174\000\216\003\058\006\072\002\073\002\074\002\075\002\250\004\ +\135\002\013\002\023\003\254\005\063\006\066\006\012\003\076\002\ +\064\006\067\006\135\002\072\006\247\003\073\006\150\000\174\000\ +\174\000\002\004\098\006\011\002\075\006\023\003\167\005\093\006\ +\116\006\117\006\111\005\111\006\023\003\150\000\121\006\124\006\ +\120\002\150\000\130\006\120\002\131\006\051\000\089\000\008\000\ +\026\004\021\003\150\000\051\000\005\005\120\002\084\002\025\003\ +\023\003\120\002\023\003\077\002\128\000\089\000\178\002\105\002\ +\252\001\102\002\120\002\120\002\120\002\120\002\023\003\104\002\ +\033\003\023\003\023\003\023\003\065\004\175\000\023\003\036\003\ +\023\003\120\002\135\002\135\002\202\002\221\000\107\002\200\002\ +\020\002\070\000\150\000\200\002\070\000\001\000\002\000\003\000\ +\004\000\005\000\006\000\007\000\120\002\005\005\070\000\120\002\ +\201\002\178\002\120\002\120\002\120\002\201\002\150\000\150\000\ +\150\000\120\002\120\002\070\000\203\002\070\000\070\000\206\002\ +\120\002\023\003\207\002\135\002\208\002\204\002\111\005\149\001\ +\048\004\070\000\070\000\016\006\120\002\232\001\120\002\132\005\ +\120\002\120\002\184\001\217\005\101\006\006\006\072\003\192\003\ +\129\004\149\002\226\005\119\004\120\002\070\000\250\004\120\002\ +\070\000\124\002\084\003\120\002\070\000\070\000\150\000\137\004\ +\210\002\206\001\147\003\070\000\025\003\025\003\150\000\134\005\ +\201\004\070\000\005\005\025\003\250\004\141\002\175\000\208\002\ +\242\004\025\003\182\003\005\005\176\002\070\000\150\000\219\005\ +\025\003\070\000\070\000\194\005\247\005\096\005\025\003\000\000\ +\150\000\113\002\175\000\000\000\000\000\070\000\150\000\000\000\ +\070\000\000\000\174\004\175\004\000\000\000\000\000\000\000\000\ +\000\000\025\003\025\003\021\003\000\000\000\000\000\000\000\000\ +\150\000\000\000\000\000\186\004\000\000\000\000\000\000\148\002\ +\000\000\000\000\021\003\021\003\000\000\000\000\000\000\000\000\ +\194\004\000\000\000\000\000\000\150\000\000\000\150\000\021\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\202\004\000\000\000\000\150\000\000\000\000\000\250\004\150\000\ +\000\000\195\000\021\003\175\000\000\000\021\003\000\000\000\000\ +\250\004\000\000\021\003\000\000\000\000\000\000\135\002\184\001\ +\021\003\000\000\174\000\174\000\195\000\000\000\021\003\000\000\ +\000\000\175\000\223\004\195\000\162\000\000\000\173\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\021\003\021\003\ +\000\000\000\000\000\000\174\000\174\000\174\000\000\000\162\000\ +\000\000\195\000\021\003\174\000\000\000\021\003\162\000\000\000\ +\000\000\250\004\217\002\000\000\000\000\195\000\000\000\000\000\ +\005\005\000\000\177\000\000\000\195\000\195\000\194\000\195\000\ +\000\000\010\005\174\000\174\000\162\000\162\000\000\000\174\000\ +\150\000\000\000\017\005\174\000\000\000\194\000\011\002\000\000\ +\162\000\000\000\000\000\150\000\000\000\000\000\199\001\162\000\ +\162\000\000\000\162\000\000\000\000\000\199\001\000\000\000\000\ +\194\000\000\000\000\000\250\004\000\000\000\000\000\000\174\000\ +\195\000\000\000\000\000\150\000\150\000\000\000\000\000\022\004\ +\174\000\150\000\150\000\000\000\000\000\000\000\011\002\000\000\ +\000\000\000\000\111\005\150\000\111\005\232\001\000\000\000\000\ +\232\001\005\005\174\000\162\000\000\000\061\003\194\000\150\000\ +\194\000\194\000\232\001\055\005\000\000\057\005\208\000\000\000\ +\232\001\014\003\000\000\000\000\000\000\000\000\000\000\232\001\ +\150\000\232\001\232\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\150\000\000\000\000\000\150\000\232\001\000\000\ +\000\000\000\000\000\000\150\000\150\000\174\000\000\000\000\000\ +\000\000\000\000\097\005\000\000\000\000\000\000\000\000\100\005\ +\000\000\232\001\000\000\000\000\232\001\000\000\094\002\000\000\ +\232\001\232\001\000\000\000\000\000\000\000\000\000\000\232\001\ +\136\000\000\000\137\000\138\000\030\000\232\001\139\000\000\000\ +\000\000\140\000\141\000\173\002\000\000\000\000\000\000\177\000\ +\177\000\232\001\177\000\000\000\000\000\232\001\232\001\000\000\ +\000\000\000\000\142\000\000\000\177\000\177\000\000\000\135\005\ +\000\000\232\001\143\000\144\000\232\001\000\000\000\000\000\000\ +\194\000\000\000\145\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\177\000\003\002\146\000\147\000\ +\000\000\194\000\000\000\000\000\199\001\174\000\000\000\150\005\ +\000\000\152\005\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\174\000\174\000\173\002\000\000\ +\173\002\173\002\173\002\168\005\000\000\000\000\173\002\178\005\ +\179\005\000\000\000\000\173\002\000\000\000\000\000\000\173\002\ +\173\002\173\002\000\000\000\000\000\000\180\003\184\005\000\000\ +\173\002\173\002\173\002\173\002\000\000\000\000\000\000\000\000\ +\174\000\000\000\173\002\000\000\011\002\000\000\000\000\173\002\ +\000\000\174\000\000\000\174\000\197\005\000\000\173\002\173\002\ +\000\000\000\000\000\000\000\000\000\000\011\002\000\000\000\000\ +\194\000\000\000\173\002\000\000\000\000\173\002\173\002\000\000\ +\173\002\173\002\173\002\000\000\173\002\000\000\000\000\173\002\ +\173\002\000\000\000\000\000\000\000\000\194\000\173\002\000\000\ +\000\000\000\000\215\003\000\000\174\000\000\000\000\000\000\000\ +\000\000\173\002\173\002\000\000\173\002\173\002\173\002\173\002\ +\000\000\000\000\173\002\011\002\000\000\000\000\000\000\245\005\ +\000\000\163\000\173\002\173\002\171\000\173\002\000\000\000\000\ +\249\005\173\002\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\163\000\002\006\000\000\000\000\ +\004\006\000\000\000\000\163\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\194\000\180\000\000\000\ +\194\000\194\000\000\000\000\000\194\000\000\000\194\000\000\000\ +\000\000\163\000\163\000\000\000\062\004\000\000\000\000\000\000\ +\194\000\028\006\000\000\000\000\156\002\163\000\094\002\194\000\ +\094\002\094\002\094\002\000\000\163\000\163\000\094\002\163\000\ +\000\000\000\000\000\000\094\002\184\001\000\000\000\000\094\002\ +\094\002\094\002\000\000\000\000\000\000\194\000\000\000\174\000\ +\094\002\094\002\094\002\094\002\000\000\000\000\000\000\000\000\ +\000\000\194\000\094\002\000\000\000\000\000\000\000\000\094\002\ +\194\000\194\000\000\000\194\000\000\000\000\000\094\002\094\002\ +\163\000\000\000\174\000\000\000\000\000\000\000\000\000\177\000\ +\003\002\000\000\094\002\000\000\000\000\094\002\000\000\000\000\ +\094\002\094\002\094\002\000\000\094\002\000\000\000\000\094\002\ +\094\002\000\000\000\000\086\006\000\000\174\000\094\002\000\000\ +\177\000\177\000\177\000\000\000\194\000\000\000\000\000\000\000\ +\177\000\094\002\094\002\000\000\094\002\094\002\094\002\094\002\ +\000\000\174\000\174\000\000\000\000\000\000\000\174\000\174\000\ +\174\000\000\000\094\002\000\000\174\000\094\002\000\000\003\002\ +\177\000\094\002\174\000\000\000\003\002\000\000\000\000\000\000\ +\177\000\114\006\115\006\000\000\011\002\000\000\000\000\000\000\ +\000\000\122\006\000\000\180\000\180\000\000\000\180\000\000\000\ +\000\000\011\002\174\000\000\000\000\000\000\000\000\000\000\000\ +\180\000\180\000\000\000\000\000\177\000\133\006\011\002\000\000\ +\011\002\011\002\000\000\000\000\011\002\177\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\011\002\000\000\250\001\ +\180\000\180\000\178\000\000\000\000\000\000\000\195\000\177\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\011\002\000\000\000\000\194\000\219\004\195\000\011\002\011\002\ +\011\002\000\000\000\000\000\000\171\000\000\000\011\002\171\000\ +\000\000\000\000\000\000\000\000\011\002\000\000\000\000\000\000\ +\195\000\171\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\011\002\000\000\177\000\000\000\011\002\000\000\171\000\171\000\ +\171\000\171\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\011\002\000\000\000\000\011\002\000\000\171\000\000\000\000\000\ +\000\000\011\002\184\001\000\000\174\000\000\000\195\000\000\000\ +\195\000\195\000\000\000\000\000\156\002\000\000\000\000\156\002\ +\171\000\000\000\000\000\174\000\156\002\000\000\000\000\171\000\ +\171\000\156\002\156\002\000\000\000\000\000\000\171\000\156\002\ +\000\000\011\002\177\002\000\000\171\000\000\000\156\002\179\000\ +\156\002\156\002\000\000\000\000\000\000\000\000\000\000\000\000\ +\171\000\000\000\171\000\067\002\171\000\156\002\000\000\000\000\ +\000\000\000\000\000\000\159\001\078\002\000\000\000\000\000\000\ +\171\000\000\000\177\000\171\000\000\000\000\000\011\002\000\000\ +\156\002\000\000\000\000\156\002\000\000\177\002\156\002\156\002\ +\156\002\177\000\177\000\010\000\000\000\157\001\156\002\178\000\ +\178\000\000\000\178\000\156\002\156\002\000\000\000\000\000\000\ +\000\000\174\000\000\000\000\000\178\000\178\000\000\000\000\000\ +\156\002\000\000\181\003\000\000\156\002\156\002\011\002\000\000\ +\195\000\000\000\199\001\000\000\000\000\177\000\000\000\000\000\ +\156\002\000\000\000\000\156\002\178\000\004\002\177\000\000\000\ +\003\002\195\000\000\000\000\000\136\000\000\000\137\000\138\000\ +\030\000\000\000\139\000\000\000\000\000\140\000\141\000\000\000\ +\000\000\000\000\000\000\023\003\000\000\000\000\000\000\000\000\ +\000\000\184\001\000\000\000\000\000\000\000\000\142\000\000\000\ +\023\003\000\000\000\000\000\000\000\000\010\000\143\000\144\000\ +\000\000\003\002\000\000\000\000\054\000\023\003\145\000\023\003\ +\023\003\000\000\174\000\180\000\180\000\000\000\000\000\000\000\ +\000\000\000\000\146\000\147\000\023\003\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\179\000\179\000\000\000\179\000\ +\000\000\000\000\184\001\199\002\180\000\180\000\180\000\023\003\ +\195\000\179\000\179\000\000\000\180\000\000\000\136\000\023\003\ +\137\000\138\000\030\000\000\000\139\000\023\003\081\001\158\001\ +\141\000\000\000\000\000\023\003\000\000\195\000\000\000\000\000\ +\000\000\179\000\179\000\180\000\180\000\000\000\000\000\000\000\ +\180\000\000\000\000\000\023\003\180\000\220\000\220\000\000\000\ +\000\000\144\000\087\001\088\001\089\001\090\001\078\002\023\003\ +\145\000\011\002\023\003\000\000\000\000\000\000\000\000\000\000\ +\000\000\011\002\000\000\000\000\146\000\147\000\011\002\184\001\ +\180\000\186\000\000\000\174\000\177\000\000\000\092\001\093\001\ +\184\001\038\003\000\000\011\002\000\000\011\002\011\002\000\000\ +\000\000\000\000\095\001\096\001\097\001\098\001\000\000\174\000\ +\195\000\195\000\011\002\180\000\195\000\000\000\195\000\003\002\ +\130\001\131\001\000\000\100\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\011\002\000\000\000\000\ +\011\002\000\000\000\000\011\002\011\002\011\002\000\000\000\000\ +\000\000\000\000\177\000\011\002\000\000\000\000\000\000\000\000\ +\159\001\011\002\186\002\000\000\190\002\000\000\038\003\159\001\ +\000\000\159\001\000\000\000\000\000\000\011\002\177\000\003\002\ +\000\000\011\002\011\002\177\000\177\000\177\000\000\000\000\000\ +\174\000\177\000\184\001\000\000\000\000\011\002\000\000\177\000\ +\011\002\000\000\000\000\000\000\000\000\000\000\000\000\178\000\ +\004\002\000\000\000\000\000\000\000\000\000\000\174\000\000\000\ +\167\001\000\000\000\000\000\000\000\000\000\000\000\000\177\000\ +\138\002\180\003\000\000\000\000\000\000\168\001\000\000\000\000\ +\178\000\178\000\178\000\000\000\081\001\000\000\000\000\000\000\ +\178\000\000\000\000\000\000\000\000\000\048\006\000\000\000\000\ +\136\000\000\000\137\000\138\000\030\000\184\001\139\000\000\000\ +\060\006\169\001\141\000\000\000\054\000\000\000\180\000\004\002\ +\178\000\088\001\089\001\090\001\004\002\000\000\000\000\000\000\ +\178\000\054\000\000\000\000\000\000\000\180\000\180\000\000\000\ +\179\002\180\003\000\000\144\000\000\000\000\000\054\000\000\000\ +\054\000\054\000\145\000\000\000\092\001\093\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\178\000\054\000\146\000\147\000\ +\095\001\096\001\097\001\098\001\000\000\178\000\000\000\000\000\ +\000\000\180\000\000\000\000\000\179\000\179\000\000\000\000\000\ +\054\000\100\001\180\000\054\000\180\000\000\000\184\001\178\000\ +\054\000\003\002\000\000\000\000\000\000\000\000\054\000\000\000\ +\000\000\000\000\000\000\195\000\054\000\179\000\179\000\179\000\ +\003\002\000\000\000\000\000\000\000\000\179\000\179\000\000\000\ +\054\000\000\000\000\000\000\000\054\000\054\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\180\000\000\000\000\000\ +\054\000\000\000\178\000\054\000\179\000\179\000\000\000\000\000\ +\000\000\179\000\000\000\000\000\000\000\179\000\000\000\079\002\ +\080\002\081\002\082\002\083\002\084\002\085\002\086\002\087\002\ +\088\002\089\002\090\002\091\002\092\002\093\002\094\002\095\002\ +\096\002\097\002\098\002\099\002\182\002\102\002\000\000\000\000\ +\103\002\179\000\000\000\105\002\000\000\106\002\000\000\107\002\ +\000\000\108\002\179\000\109\002\000\000\000\000\003\002\000\000\ +\000\000\000\000\000\000\159\001\000\000\000\000\000\000\000\000\ +\126\002\000\000\000\000\000\000\179\000\000\000\000\000\186\002\ +\000\000\190\002\000\000\078\002\000\000\000\000\000\000\142\002\ +\000\000\143\002\000\000\000\000\000\000\000\000\186\002\186\002\ +\190\002\190\002\178\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\158\002\000\000\186\002\000\000\190\002\000\000\000\000\ +\180\000\178\000\178\000\000\000\138\002\000\000\000\000\179\000\ +\000\000\057\000\000\000\194\000\000\000\000\000\186\002\000\000\ +\190\002\186\002\000\000\190\002\000\000\000\000\186\002\000\000\ +\190\002\000\000\000\000\180\000\186\002\000\000\190\002\003\002\ +\000\000\000\000\186\002\213\002\190\002\178\000\000\000\000\000\ +\000\000\000\000\000\000\138\002\000\000\000\000\178\000\000\000\ +\004\002\000\000\186\002\186\002\190\002\190\002\180\000\000\000\ +\000\000\000\000\228\002\000\000\000\000\000\000\186\002\000\000\ +\190\002\186\002\212\002\190\002\213\002\000\000\000\000\000\000\ +\000\000\000\000\180\000\180\000\000\000\000\000\160\004\180\000\ +\180\000\180\000\000\000\000\000\213\002\180\000\213\002\213\002\ +\213\002\004\002\213\002\180\000\000\000\213\002\213\002\179\000\ +\000\000\003\003\136\000\006\003\137\000\138\000\030\000\000\000\ +\139\000\000\000\000\000\140\000\141\000\000\000\179\000\179\000\ +\000\000\020\003\000\000\180\000\000\000\177\001\022\003\213\002\ +\000\000\000\000\000\000\000\000\142\000\000\000\213\002\000\000\ +\003\002\000\000\000\000\000\000\143\000\144\000\000\000\194\000\ +\000\000\229\002\213\002\213\002\145\000\000\000\000\000\000\000\ +\000\000\000\000\179\000\000\000\003\002\000\000\000\000\000\000\ +\146\000\147\000\000\000\179\000\000\000\179\000\000\000\000\000\ +\000\000\000\000\000\000\220\000\220\000\000\000\000\000\000\000\ +\000\000\159\001\000\000\000\000\000\000\000\000\073\004\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\138\002\000\000\ +\000\000\247\000\000\000\000\000\182\002\000\000\000\000\182\002\ +\000\000\000\000\000\000\000\000\178\000\000\000\179\000\089\003\ +\000\000\182\002\000\000\000\000\095\003\096\003\097\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\003\002\182\002\182\002\ +\182\002\182\002\000\000\099\003\000\000\180\000\102\003\004\002\ +\000\000\000\000\000\000\000\000\000\000\182\002\000\000\000\000\ +\000\000\138\002\000\000\003\002\180\000\000\000\000\000\138\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\045\006\000\000\ +\182\002\000\000\178\000\000\000\173\002\000\000\182\002\182\002\ +\182\002\000\000\000\000\000\000\000\000\173\002\182\002\000\000\ +\000\000\057\000\000\000\000\000\182\002\000\000\178\000\004\002\ +\000\000\000\000\000\000\178\000\178\000\178\000\057\000\000\000\ +\182\002\178\000\182\002\000\000\182\002\173\002\000\000\178\000\ +\173\002\000\000\000\000\057\000\000\000\057\000\057\000\000\000\ +\182\002\173\002\011\002\182\002\000\000\000\000\078\006\161\003\ +\000\000\179\000\057\000\000\000\165\003\166\003\167\003\178\000\ +\000\000\014\003\180\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\183\003\000\000\057\000\000\000\000\000\ +\057\000\000\000\000\000\000\000\179\000\057\000\000\000\138\002\ +\000\000\000\000\000\000\057\000\000\000\000\000\000\000\000\000\ +\000\000\057\000\000\000\200\003\000\000\000\000\203\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\057\000\000\000\179\000\ +\000\000\057\000\057\000\210\003\138\002\000\000\000\000\138\002\ +\136\000\000\000\137\000\138\000\030\000\057\000\139\000\000\000\ +\057\000\140\000\141\000\179\000\179\000\232\004\000\000\000\000\ +\179\000\179\000\179\000\000\000\000\000\000\000\179\000\000\000\ +\000\000\000\000\142\000\180\000\179\000\000\000\000\000\000\000\ +\000\000\000\000\143\000\126\003\000\000\000\000\000\000\000\000\ +\032\000\000\000\145\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\004\002\000\000\000\000\179\000\151\004\146\000\147\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\004\002\000\000\000\000\000\000\000\000\000\000\000\000\040\004\ +\000\000\247\000\247\000\247\000\247\000\000\000\138\002\000\000\ +\000\000\247\000\247\000\247\000\000\000\138\002\247\000\247\000\ +\000\000\247\000\247\000\247\000\247\000\247\000\247\000\000\000\ +\000\000\247\000\247\000\247\000\247\000\247\000\247\000\000\000\ +\000\000\138\002\078\004\000\000\000\000\247\000\247\000\000\000\ +\000\000\247\000\247\000\247\000\247\000\000\000\081\000\000\000\ +\000\000\247\000\247\000\000\000\180\000\255\004\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\247\000\247\000\000\000\ +\247\000\000\000\000\000\247\000\247\000\247\000\004\002\247\000\ +\180\000\000\000\247\000\247\000\000\000\000\000\000\000\000\000\ +\000\000\247\000\000\000\247\000\000\000\000\000\179\000\118\004\ +\000\000\000\000\000\000\000\000\247\000\247\000\000\000\247\000\ +\247\000\247\000\247\000\000\000\000\000\179\000\000\000\000\000\ +\247\000\000\000\247\000\000\000\141\004\247\000\000\000\159\001\ +\247\000\000\000\011\002\000\000\247\000\011\002\000\000\148\004\ +\000\000\000\000\011\002\138\002\000\000\000\000\000\000\011\002\ +\000\000\000\000\000\000\195\000\000\000\011\002\023\003\000\000\ +\000\000\180\000\000\000\000\000\011\002\000\000\011\002\011\002\ +\000\000\000\000\000\000\023\003\000\000\000\000\000\000\004\002\ +\000\000\000\000\000\000\011\002\179\004\000\000\181\004\180\000\ +\255\004\138\002\000\000\000\000\000\000\000\000\023\003\000\000\ +\023\003\023\003\023\003\138\002\023\003\000\000\011\002\023\003\ +\023\003\011\002\000\000\179\000\011\002\011\002\011\002\000\000\ +\159\001\000\000\000\000\113\005\011\002\000\000\000\000\000\000\ +\000\000\000\000\011\002\000\000\000\000\000\000\208\004\209\004\ +\210\004\023\003\000\000\000\000\229\000\000\000\011\002\000\000\ +\023\003\000\000\011\002\011\002\000\000\216\004\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\003\023\003\011\002\000\000\ +\032\000\011\002\000\000\032\000\000\000\000\000\000\000\000\000\ +\000\000\230\004\000\000\138\002\138\002\032\000\032\000\000\000\ +\000\000\032\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\004\002\000\000\032\000\032\000\032\000\032\000\000\000\195\000\ +\000\000\238\004\239\004\240\004\179\000\000\000\000\000\000\000\ +\032\000\032\000\000\000\000\000\004\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\138\002\000\000\000\000\113\005\ +\000\000\000\000\000\000\000\000\032\000\000\000\000\000\032\000\ +\000\000\000\000\000\000\032\000\032\000\000\000\000\000\185\005\ +\186\005\032\000\032\000\030\005\000\000\000\000\081\000\255\004\ +\032\000\081\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\081\000\032\000\000\000\032\000\081\000\ +\032\000\032\000\000\000\000\000\000\000\255\004\000\000\000\000\ +\081\000\081\000\081\000\081\000\032\000\004\002\000\000\032\000\ +\000\000\060\002\000\000\032\000\000\000\000\000\052\005\081\000\ +\054\005\000\000\056\005\016\003\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\004\002\000\000\179\000\000\000\000\000\ +\000\000\000\000\081\000\000\000\000\000\081\000\078\005\079\005\ +\080\005\081\000\081\000\000\000\087\005\088\005\089\005\000\000\ +\081\000\179\000\000\000\000\000\000\000\000\000\081\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\081\000\000\000\081\000\103\005\081\000\081\000\ +\000\000\113\005\136\000\000\000\137\000\138\000\030\000\255\004\ +\139\000\118\005\081\000\140\000\141\000\081\000\000\000\000\000\ +\000\000\255\004\125\005\000\000\000\000\000\000\129\005\138\002\ +\000\000\000\000\000\000\000\000\142\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\143\000\144\000\000\000\000\000\ +\000\000\000\000\179\000\000\000\145\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\146\000\147\000\000\000\000\000\229\000\229\000\229\000\229\000\ +\179\000\000\000\255\004\000\000\229\000\229\000\229\000\000\000\ +\000\000\229\000\229\000\229\000\229\000\229\000\229\000\229\000\ +\229\000\229\000\000\000\000\000\229\000\229\000\229\000\229\000\ +\229\000\229\000\000\000\122\002\000\000\000\000\000\000\000\000\ +\229\000\229\000\000\000\000\000\229\000\229\000\229\000\229\000\ +\229\000\229\000\229\000\000\000\229\000\229\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\255\004\000\000\000\000\000\000\ +\229\000\229\000\000\000\229\000\000\000\000\000\229\000\229\000\ +\229\000\000\000\229\000\229\000\229\000\229\000\229\000\000\000\ +\000\000\000\000\000\000\113\005\229\000\113\005\229\000\229\000\ +\229\000\229\000\229\000\000\000\000\000\000\000\000\000\229\000\ +\229\000\000\000\229\000\229\000\229\000\229\000\000\000\000\000\ +\229\000\000\000\000\000\229\000\000\000\229\000\000\000\000\000\ +\229\000\000\000\000\000\229\000\000\000\000\000\000\000\229\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\239\005\000\000\000\000\000\000\014\000\000\000\000\000\000\000\ +\000\000\060\002\000\000\060\002\060\002\060\002\250\005\251\005\ +\252\005\060\002\000\000\015\000\016\000\000\000\060\002\164\002\ +\000\000\000\000\060\002\060\002\060\002\000\000\000\000\000\000\ +\023\000\000\000\007\006\060\002\060\002\060\002\060\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\060\002\000\000\018\006\ +\000\000\060\002\060\002\031\000\000\000\022\006\074\001\000\000\ +\000\000\060\002\060\002\035\000\000\000\000\000\000\000\000\000\ +\000\000\039\000\000\000\000\000\000\000\060\002\037\006\042\000\ +\060\002\000\000\000\000\060\002\060\002\060\002\046\006\060\002\ +\000\000\000\000\060\002\060\002\000\000\000\000\000\000\046\000\ +\000\000\060\002\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\050\000\060\002\060\002\053\000\060\002\ +\060\002\060\002\000\000\000\000\000\000\060\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\060\002\000\000\000\000\ +\060\002\000\000\000\000\000\000\060\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\079\006\080\006\ +\000\000\000\000\000\000\041\001\000\000\082\006\083\006\084\006\ +\085\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\089\006\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\122\002\122\002\122\002\122\002\000\000\ +\099\006\122\002\122\002\122\002\122\002\122\002\122\002\122\002\ +\122\002\122\002\122\002\122\002\122\002\122\002\122\002\122\002\ +\122\002\122\002\000\000\122\002\122\002\122\002\122\002\122\002\ +\122\002\122\002\122\002\000\000\000\000\000\000\000\000\122\002\ +\122\002\000\000\000\000\122\002\122\002\122\002\122\002\122\002\ +\122\002\122\002\122\002\122\002\122\002\122\002\122\002\000\000\ +\122\002\122\002\122\002\122\002\000\000\000\000\122\002\122\002\ +\122\002\110\002\122\002\122\002\122\002\122\002\122\002\122\002\ +\000\000\122\002\122\002\122\002\122\002\122\002\000\000\122\002\ +\000\000\000\000\000\000\122\002\122\002\122\002\122\002\122\002\ +\122\002\122\002\122\002\000\000\122\002\000\000\122\002\122\002\ +\061\001\122\002\122\002\122\002\122\002\122\002\000\000\122\002\ +\122\002\000\000\122\002\122\002\122\002\122\002\000\000\122\002\ +\122\002\000\000\122\002\000\000\000\000\000\000\122\002\164\002\ +\164\002\164\002\164\002\164\002\000\000\164\002\164\002\164\002\ +\164\002\164\002\164\002\164\002\164\002\164\002\164\002\164\002\ +\164\002\164\002\164\002\164\002\164\002\000\000\000\000\164\002\ +\164\002\164\002\164\002\164\002\164\002\164\002\164\002\000\000\ +\000\000\000\000\000\000\164\002\164\002\000\000\000\000\164\002\ +\164\002\164\002\164\002\164\002\164\002\164\002\164\002\164\002\ +\164\002\164\002\164\002\000\000\164\002\164\002\164\002\164\002\ +\000\000\000\000\164\002\164\002\164\002\000\000\164\002\164\002\ +\164\002\164\002\164\002\164\002\000\000\164\002\164\002\164\002\ +\164\002\164\002\000\000\164\002\000\000\000\000\000\000\164\002\ +\164\002\164\002\164\002\164\002\164\002\164\002\164\002\000\000\ +\164\002\000\000\164\002\164\002\047\001\164\002\164\002\164\002\ +\164\002\164\002\000\000\164\002\164\002\000\000\164\002\164\002\ +\164\002\164\002\000\000\164\002\164\002\000\000\164\002\000\000\ +\000\000\000\000\164\002\041\001\041\001\041\001\041\001\000\000\ +\000\000\041\001\041\001\041\001\041\001\041\001\041\001\041\001\ +\041\001\041\001\041\001\041\001\041\001\041\001\041\001\041\001\ +\041\001\041\001\000\000\041\001\041\001\041\001\041\001\041\001\ +\041\001\041\001\041\001\000\000\000\000\000\000\000\000\041\001\ +\041\001\000\000\000\000\041\001\041\001\041\001\041\001\041\001\ +\041\001\041\001\041\001\041\001\041\001\041\001\041\001\000\000\ +\041\001\041\001\041\001\041\001\000\000\000\000\041\001\041\001\ +\041\001\000\000\041\001\041\001\041\001\041\001\041\001\041\001\ +\000\000\041\001\041\001\041\001\041\001\041\001\000\000\041\001\ +\000\000\000\000\000\000\041\001\041\001\041\001\041\001\041\001\ +\041\001\041\001\041\001\000\000\041\001\000\000\041\001\041\001\ +\045\001\041\001\041\001\041\001\041\001\041\001\000\000\041\001\ +\041\001\000\000\041\001\041\001\041\001\041\001\000\000\041\001\ +\041\001\000\000\041\001\000\000\000\000\000\000\041\001\000\000\ +\061\001\061\001\061\001\061\001\000\000\000\000\061\001\061\001\ +\061\001\061\001\061\001\061\001\061\001\061\001\061\001\061\001\ +\061\001\061\001\061\001\061\001\061\001\061\001\061\001\000\000\ +\061\001\061\001\061\001\061\001\061\001\061\001\061\001\061\001\ +\000\000\000\000\000\000\000\000\061\001\061\001\000\000\000\000\ +\061\001\061\001\061\001\061\001\061\001\061\001\061\001\061\001\ +\061\001\061\001\061\001\061\001\000\000\061\001\061\001\061\001\ +\061\001\000\000\000\000\061\001\061\001\061\001\000\000\061\001\ +\061\001\061\001\061\001\061\001\061\001\000\000\061\001\061\001\ +\061\001\061\001\061\001\000\000\061\001\000\000\000\000\000\000\ +\061\001\061\001\061\001\061\001\061\001\061\001\061\001\061\001\ +\000\000\061\001\000\000\061\001\061\001\053\001\061\001\061\001\ +\061\001\061\001\061\001\000\000\061\001\061\001\000\000\061\001\ +\061\001\061\001\061\001\000\000\061\001\061\001\000\000\061\001\ +\000\000\000\000\000\000\061\001\047\001\047\001\047\001\047\001\ +\000\000\000\000\047\001\047\001\047\001\047\001\047\001\047\001\ +\047\001\047\001\047\001\047\001\047\001\047\001\047\001\047\001\ +\047\001\047\001\047\001\000\000\047\001\047\001\047\001\047\001\ +\047\001\047\001\047\001\047\001\000\000\000\000\000\000\000\000\ +\047\001\047\001\000\000\000\000\047\001\047\001\047\001\047\001\ +\047\001\047\001\047\001\047\001\047\001\047\001\047\001\047\001\ +\000\000\047\001\047\001\047\001\047\001\000\000\000\000\047\001\ +\047\001\047\001\000\000\047\001\047\001\047\001\047\001\047\001\ +\047\001\000\000\047\001\047\001\047\001\047\001\047\001\000\000\ +\047\001\000\000\000\000\000\000\047\001\047\001\047\001\047\001\ +\047\001\047\001\047\001\047\001\000\000\047\001\000\000\047\001\ +\047\001\049\001\047\001\047\001\047\001\047\001\047\001\000\000\ +\047\001\047\001\000\000\047\001\047\001\047\001\047\001\000\000\ +\047\001\047\001\000\000\047\001\000\000\000\000\000\000\047\001\ +\045\001\045\001\045\001\045\001\000\000\000\000\045\001\045\001\ +\045\001\045\001\045\001\045\001\045\001\045\001\045\001\045\001\ +\045\001\045\001\045\001\045\001\045\001\045\001\045\001\000\000\ +\045\001\045\001\045\001\045\001\045\001\045\001\045\001\045\001\ +\000\000\000\000\000\000\000\000\045\001\045\001\000\000\000\000\ +\045\001\045\001\045\001\045\001\045\001\045\001\045\001\045\001\ +\045\001\045\001\045\001\045\001\000\000\045\001\045\001\045\001\ +\045\001\000\000\000\000\045\001\045\001\045\001\000\000\045\001\ +\045\001\045\001\045\001\045\001\045\001\000\000\045\001\045\001\ +\045\001\045\001\045\001\000\000\045\001\000\000\000\000\000\000\ +\045\001\045\001\045\001\045\001\045\001\045\001\045\001\045\001\ +\000\000\045\001\000\000\045\001\045\001\051\001\045\001\045\001\ +\045\001\045\001\045\001\000\000\045\001\045\001\000\000\045\001\ +\045\001\045\001\045\001\000\000\045\001\045\001\000\000\045\001\ +\000\000\000\000\000\000\045\001\000\000\053\001\053\001\053\001\ +\053\001\000\000\000\000\053\001\053\001\053\001\053\001\053\001\ +\053\001\053\001\053\001\053\001\053\001\053\001\053\001\053\001\ +\053\001\053\001\053\001\053\001\000\000\053\001\053\001\053\001\ +\053\001\053\001\053\001\053\001\053\001\000\000\000\000\000\000\ +\000\000\053\001\053\001\000\000\000\000\053\001\053\001\053\001\ +\053\001\053\001\053\001\053\001\053\001\053\001\053\001\053\001\ +\053\001\000\000\053\001\053\001\053\001\053\001\000\000\000\000\ +\053\001\053\001\053\001\000\000\053\001\053\001\053\001\053\001\ +\053\001\053\001\000\000\053\001\053\001\053\001\053\001\053\001\ +\000\000\053\001\000\000\000\000\000\000\053\001\053\001\053\001\ +\053\001\053\001\053\001\053\001\053\001\000\000\053\001\000\000\ +\053\001\053\001\059\001\053\001\053\001\053\001\053\001\053\001\ +\000\000\053\001\053\001\000\000\053\001\053\001\053\001\053\001\ +\000\000\053\001\053\001\000\000\053\001\000\000\000\000\000\000\ +\053\001\049\001\049\001\049\001\049\001\000\000\000\000\049\001\ +\049\001\049\001\049\001\049\001\049\001\049\001\049\001\049\001\ +\049\001\049\001\049\001\049\001\049\001\049\001\049\001\049\001\ +\000\000\049\001\049\001\049\001\049\001\049\001\049\001\049\001\ +\049\001\000\000\000\000\000\000\000\000\049\001\049\001\000\000\ +\000\000\049\001\049\001\049\001\049\001\049\001\049\001\049\001\ +\049\001\049\001\049\001\049\001\049\001\000\000\049\001\049\001\ +\049\001\049\001\000\000\000\000\049\001\049\001\049\001\000\000\ +\049\001\049\001\049\001\049\001\049\001\049\001\000\000\049\001\ +\049\001\049\001\049\001\049\001\000\000\049\001\000\000\000\000\ +\000\000\049\001\049\001\049\001\049\001\049\001\049\001\049\001\ +\049\001\000\000\049\001\000\000\049\001\049\001\055\001\049\001\ +\049\001\049\001\049\001\049\001\000\000\049\001\049\001\000\000\ +\049\001\049\001\049\001\049\001\000\000\049\001\049\001\000\000\ +\049\001\000\000\000\000\000\000\049\001\051\001\051\001\051\001\ +\051\001\000\000\000\000\051\001\051\001\051\001\051\001\051\001\ +\051\001\051\001\051\001\051\001\051\001\051\001\051\001\051\001\ +\051\001\051\001\051\001\051\001\000\000\051\001\051\001\051\001\ +\051\001\051\001\051\001\051\001\051\001\000\000\000\000\000\000\ +\000\000\051\001\051\001\000\000\000\000\051\001\051\001\051\001\ +\051\001\051\001\051\001\051\001\051\001\051\001\051\001\051\001\ +\051\001\000\000\051\001\051\001\051\001\051\001\000\000\000\000\ +\051\001\051\001\051\001\000\000\051\001\051\001\051\001\051\001\ +\051\001\051\001\000\000\051\001\051\001\051\001\051\001\051\001\ +\000\000\051\001\000\000\000\000\000\000\051\001\051\001\051\001\ +\051\001\051\001\051\001\051\001\051\001\000\000\051\001\000\000\ +\051\001\051\001\057\001\051\001\051\001\051\001\051\001\051\001\ +\000\000\051\001\051\001\000\000\051\001\051\001\051\001\051\001\ +\000\000\051\001\051\001\000\000\051\001\000\000\000\000\000\000\ +\051\001\000\000\059\001\059\001\059\001\059\001\000\000\000\000\ +\059\001\059\001\059\001\059\001\059\001\059\001\059\001\059\001\ +\059\001\059\001\059\001\059\001\059\001\059\001\059\001\059\001\ +\059\001\000\000\059\001\059\001\059\001\059\001\059\001\059\001\ +\059\001\059\001\000\000\000\000\000\000\000\000\059\001\059\001\ +\000\000\000\000\059\001\059\001\059\001\059\001\059\001\059\001\ +\059\001\059\001\059\001\059\001\059\001\059\001\000\000\059\001\ +\059\001\059\001\059\001\000\000\000\000\059\001\059\001\059\001\ +\000\000\059\001\059\001\059\001\059\001\059\001\059\001\000\000\ +\059\001\059\001\059\001\059\001\059\001\000\000\059\001\000\000\ +\000\000\000\000\059\001\059\001\059\001\059\001\059\001\059\001\ +\059\001\059\001\000\000\059\001\000\000\059\001\059\001\088\001\ +\059\001\059\001\059\001\059\001\059\001\000\000\059\001\059\001\ +\000\000\059\001\059\001\059\001\059\001\000\000\059\001\059\001\ +\000\000\059\001\000\000\000\000\000\000\059\001\055\001\055\001\ +\055\001\055\001\000\000\000\000\055\001\055\001\055\001\055\001\ +\055\001\055\001\055\001\055\001\055\001\055\001\055\001\055\001\ +\055\001\055\001\055\001\055\001\055\001\000\000\055\001\055\001\ +\055\001\055\001\055\001\055\001\055\001\055\001\000\000\000\000\ +\000\000\000\000\055\001\055\001\000\000\000\000\055\001\055\001\ +\055\001\055\001\055\001\055\001\055\001\055\001\055\001\055\001\ +\055\001\055\001\000\000\055\001\055\001\055\001\055\001\000\000\ +\000\000\055\001\055\001\055\001\000\000\055\001\055\001\055\001\ +\055\001\055\001\055\001\000\000\055\001\055\001\055\001\055\001\ +\055\001\000\000\055\001\000\000\000\000\000\000\055\001\055\001\ +\055\001\055\001\055\001\055\001\055\001\055\001\000\000\055\001\ +\000\000\055\001\055\001\097\001\055\001\055\001\055\001\055\001\ +\055\001\000\000\055\001\055\001\000\000\055\001\055\001\055\001\ +\055\001\000\000\055\001\055\001\000\000\055\001\000\000\000\000\ +\000\000\055\001\057\001\057\001\057\001\057\001\000\000\000\000\ +\057\001\057\001\057\001\057\001\057\001\057\001\057\001\057\001\ +\057\001\057\001\057\001\057\001\057\001\057\001\057\001\057\001\ +\057\001\000\000\057\001\057\001\057\001\057\001\057\001\057\001\ +\057\001\057\001\000\000\000\000\000\000\000\000\057\001\057\001\ +\000\000\000\000\057\001\057\001\057\001\057\001\057\001\057\001\ +\057\001\057\001\057\001\057\001\057\001\057\001\000\000\057\001\ +\057\001\057\001\057\001\000\000\000\000\057\001\057\001\057\001\ +\000\000\057\001\057\001\057\001\057\001\057\001\057\001\000\000\ +\057\001\057\001\057\001\057\001\057\001\000\000\057\001\000\000\ +\000\000\000\000\057\001\057\001\057\001\057\001\057\001\057\001\ +\057\001\057\001\000\000\057\001\000\000\057\001\057\001\099\001\ +\057\001\057\001\057\001\057\001\057\001\000\000\057\001\057\001\ +\000\000\057\001\057\001\057\001\057\001\000\000\057\001\057\001\ +\000\000\057\001\000\000\000\000\000\000\057\001\000\000\088\001\ +\088\001\088\001\088\001\088\001\000\000\088\001\088\001\088\001\ +\088\001\088\001\088\001\088\001\088\001\088\001\088\001\088\001\ +\088\001\088\001\088\001\088\001\088\001\000\000\000\000\088\001\ +\088\001\088\001\088\001\088\001\088\001\088\001\088\001\000\000\ +\000\000\000\000\000\000\088\001\088\001\000\000\000\000\088\001\ +\088\001\088\001\088\001\088\001\088\001\088\001\000\000\088\001\ +\088\001\088\001\088\001\000\000\088\001\088\001\088\001\088\001\ +\000\000\000\000\088\001\088\001\088\001\000\000\088\001\088\001\ +\088\001\088\001\088\001\088\001\000\000\088\001\088\001\088\001\ +\088\001\088\001\000\000\088\001\000\000\000\000\000\000\088\001\ +\088\001\088\001\088\001\088\001\088\001\088\001\088\001\000\000\ +\088\001\000\000\088\001\088\001\102\001\088\001\088\001\088\001\ +\088\001\088\001\000\000\088\001\088\001\000\000\088\001\088\001\ +\088\001\088\001\000\000\088\001\088\001\000\000\088\001\000\000\ +\000\000\000\000\088\001\097\001\097\001\097\001\097\001\097\001\ +\000\000\097\001\097\001\097\001\097\001\097\001\097\001\097\001\ +\097\001\097\001\097\001\097\001\097\001\097\001\097\001\097\001\ +\097\001\000\000\000\000\097\001\097\001\097\001\097\001\097\001\ +\097\001\097\001\097\001\000\000\000\000\000\000\000\000\097\001\ +\097\001\000\000\000\000\097\001\097\001\097\001\097\001\097\001\ +\097\001\097\001\000\000\097\001\097\001\097\001\097\001\000\000\ +\097\001\097\001\097\001\097\001\000\000\000\000\097\001\097\001\ +\097\001\000\000\097\001\097\001\097\001\097\001\097\001\097\001\ +\000\000\097\001\097\001\097\001\097\001\097\001\000\000\097\001\ +\000\000\000\000\000\000\097\001\097\001\097\001\097\001\097\001\ +\097\001\097\001\097\001\000\000\097\001\000\000\097\001\097\001\ +\033\001\097\001\097\001\097\001\000\000\000\000\000\000\097\001\ +\097\001\000\000\097\001\097\001\097\001\097\001\000\000\097\001\ +\097\001\000\000\097\001\000\000\000\000\000\000\097\001\099\001\ +\099\001\099\001\099\001\099\001\000\000\099\001\099\001\099\001\ +\099\001\099\001\099\001\099\001\099\001\099\001\099\001\099\001\ +\099\001\099\001\099\001\099\001\099\001\000\000\000\000\099\001\ +\099\001\099\001\099\001\099\001\099\001\099\001\099\001\000\000\ +\000\000\000\000\000\000\099\001\099\001\000\000\000\000\099\001\ +\099\001\099\001\099\001\099\001\099\001\099\001\000\000\099\001\ +\099\001\099\001\099\001\000\000\099\001\099\001\099\001\099\001\ +\000\000\000\000\099\001\099\001\099\001\000\000\099\001\099\001\ +\099\001\099\001\099\001\099\001\000\000\099\001\099\001\099\001\ +\099\001\099\001\000\000\099\001\000\000\000\000\000\000\099\001\ +\099\001\099\001\099\001\099\001\099\001\099\001\099\001\000\000\ +\099\001\000\000\099\001\099\001\034\001\099\001\099\001\099\001\ +\000\000\000\000\000\000\099\001\099\001\000\000\099\001\099\001\ +\099\001\099\001\000\000\099\001\099\001\000\000\099\001\000\000\ +\000\000\000\000\099\001\000\000\102\001\102\001\102\001\102\001\ +\102\001\000\000\102\001\102\001\102\001\102\001\102\001\102\001\ +\102\001\102\001\102\001\102\001\102\001\102\001\102\001\102\001\ +\102\001\102\001\000\000\000\000\102\001\102\001\102\001\102\001\ +\102\001\102\001\102\001\102\001\000\000\000\000\000\000\000\000\ +\102\001\102\001\000\000\000\000\102\001\102\001\102\001\102\001\ +\102\001\102\001\102\001\000\000\102\001\102\001\102\001\102\001\ +\000\000\102\001\102\001\102\001\102\001\000\000\000\000\102\001\ +\102\001\102\001\000\000\102\001\102\001\102\001\102\001\102\001\ +\102\001\000\000\102\001\102\001\102\001\102\001\102\001\000\000\ +\102\001\000\000\000\000\000\000\102\001\102\001\102\001\102\001\ +\102\001\102\001\102\001\102\001\000\000\102\001\000\000\102\001\ +\102\001\228\000\102\001\102\001\102\001\000\000\000\000\000\000\ +\102\001\102\001\000\000\102\001\102\001\102\001\102\001\000\000\ +\102\001\102\001\000\000\102\001\000\000\000\000\000\000\102\001\ +\033\001\033\001\033\001\033\001\000\000\000\000\000\000\000\000\ +\033\001\033\001\033\001\000\000\000\000\033\001\033\001\033\001\ +\033\001\033\001\033\001\033\001\033\001\033\001\033\001\000\000\ +\033\001\033\001\033\001\033\001\033\001\033\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\033\001\033\001\000\000\000\000\ +\033\001\033\001\033\001\033\001\033\001\033\001\033\001\033\001\ +\033\001\033\001\000\000\033\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\033\001\033\001\000\000\033\001\ +\000\000\000\000\033\001\033\001\033\001\000\000\033\001\033\001\ +\033\001\033\001\033\001\000\000\000\000\000\000\000\000\000\000\ +\033\001\033\001\033\001\033\001\033\001\033\001\033\001\000\000\ +\000\000\033\001\000\000\033\001\033\001\240\000\033\001\033\001\ +\033\001\033\001\033\001\000\000\033\001\000\000\000\000\033\001\ +\033\001\033\001\000\000\000\000\033\001\000\000\000\000\033\001\ +\000\000\000\000\000\000\033\001\034\001\034\001\034\001\034\001\ +\000\000\000\000\000\000\000\000\034\001\034\001\034\001\000\000\ +\000\000\034\001\034\001\034\001\034\001\034\001\034\001\034\001\ +\034\001\034\001\034\001\000\000\034\001\034\001\034\001\034\001\ +\034\001\034\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\034\001\034\001\000\000\000\000\034\001\034\001\034\001\034\001\ +\034\001\034\001\034\001\034\001\034\001\034\001\000\000\034\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\034\001\034\001\000\000\034\001\000\000\000\000\034\001\034\001\ +\034\001\000\000\034\001\034\001\034\001\034\001\034\001\000\000\ +\000\000\000\000\000\000\000\000\034\001\034\001\034\001\034\001\ +\034\001\034\001\034\001\000\000\000\000\034\001\000\000\034\001\ +\034\001\241\000\034\001\034\001\034\001\034\001\034\001\000\000\ +\034\001\000\000\000\000\034\001\034\001\034\001\000\000\000\000\ +\034\001\000\000\000\000\034\001\000\000\000\000\000\000\034\001\ +\000\000\228\000\228\000\228\000\228\000\000\000\000\000\000\000\ +\000\000\228\000\228\000\228\000\000\000\000\000\228\000\228\000\ +\228\000\228\000\228\000\228\000\228\000\228\000\228\000\000\000\ +\000\000\228\000\228\000\228\000\228\000\228\000\228\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\228\000\228\000\000\000\ +\000\000\228\000\228\000\228\000\228\000\228\000\228\000\228\000\ +\000\000\228\000\228\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\228\000\228\000\000\000\ +\228\000\000\000\000\000\228\000\228\000\228\000\000\000\228\000\ +\228\000\228\000\228\000\228\000\000\000\000\000\000\000\000\000\ +\000\000\228\000\000\000\228\000\228\000\228\000\228\000\228\000\ +\000\000\000\000\000\000\000\000\228\000\228\000\242\000\228\000\ +\228\000\228\000\000\000\000\000\000\000\228\000\000\000\000\000\ +\228\000\000\000\228\000\000\000\000\000\228\000\000\000\000\000\ +\228\000\000\000\000\000\000\000\228\000\240\000\240\000\240\000\ +\240\000\000\000\000\000\000\000\000\000\240\000\240\000\240\000\ +\000\000\000\000\240\000\240\000\240\000\240\000\240\000\000\000\ +\240\000\240\000\240\000\000\000\000\000\240\000\240\000\240\000\ +\240\000\240\000\240\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\240\000\240\000\000\000\000\000\240\000\240\000\240\000\ +\240\000\240\000\240\000\240\000\000\000\240\000\240\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\240\000\240\000\000\000\240\000\000\000\000\000\240\000\ +\240\000\240\000\000\000\240\000\240\000\240\000\240\000\240\000\ +\000\000\000\000\000\000\000\000\000\000\240\000\000\000\240\000\ +\240\000\240\000\240\000\240\000\000\000\000\000\000\000\000\000\ +\240\000\240\000\025\001\240\000\240\000\240\000\240\000\000\000\ +\000\000\240\000\000\000\000\000\240\000\000\000\240\000\000\000\ +\000\000\240\000\000\000\000\000\240\000\000\000\000\000\000\000\ +\240\000\241\000\241\000\241\000\241\000\000\000\000\000\000\000\ +\000\000\241\000\241\000\241\000\000\000\000\000\241\000\241\000\ +\241\000\241\000\241\000\241\000\241\000\241\000\241\000\000\000\ +\000\000\241\000\241\000\241\000\241\000\241\000\241\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\241\000\241\000\000\000\ +\000\000\241\000\241\000\241\000\241\000\241\000\241\000\241\000\ +\000\000\241\000\241\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\241\000\241\000\000\000\ +\241\000\000\000\000\000\241\000\241\000\241\000\000\000\241\000\ +\241\000\241\000\241\000\241\000\000\000\000\000\000\000\000\000\ +\000\000\241\000\000\000\241\000\241\000\241\000\241\000\241\000\ +\000\000\000\000\000\000\000\000\241\000\241\000\026\001\241\000\ +\241\000\241\000\000\000\000\000\000\000\241\000\000\000\000\000\ +\241\000\000\000\241\000\000\000\000\000\241\000\000\000\000\000\ +\241\000\000\000\000\000\000\000\241\000\000\000\242\000\242\000\ +\242\000\242\000\000\000\000\000\000\000\000\000\242\000\242\000\ +\242\000\000\000\000\000\242\000\242\000\242\000\242\000\242\000\ +\242\000\242\000\242\000\242\000\000\000\000\000\242\000\242\000\ +\242\000\242\000\242\000\242\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\242\000\242\000\000\000\000\000\242\000\242\000\ +\242\000\242\000\242\000\242\000\242\000\000\000\242\000\242\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\242\000\242\000\000\000\242\000\000\000\000\000\ +\242\000\242\000\242\000\000\000\242\000\242\000\242\000\242\000\ +\242\000\000\000\000\000\000\000\000\000\000\000\242\000\000\000\ +\242\000\242\000\242\000\242\000\242\000\000\000\000\000\000\000\ +\000\000\242\000\242\000\251\000\242\000\242\000\242\000\000\000\ +\000\000\000\000\242\000\000\000\000\000\242\000\000\000\242\000\ +\000\000\000\000\242\000\000\000\000\000\242\000\000\000\000\000\ +\000\000\242\000\025\001\025\001\025\001\025\001\000\000\000\000\ +\000\000\000\000\025\001\025\001\025\001\000\000\000\000\025\001\ +\025\001\025\001\025\001\025\001\025\001\025\001\025\001\025\001\ +\000\000\000\000\025\001\025\001\025\001\025\001\025\001\025\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\025\001\025\001\ +\000\000\000\000\025\001\025\001\025\001\025\001\025\001\025\001\ +\025\001\000\000\025\001\025\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\025\001\025\001\ +\000\000\025\001\000\000\000\000\025\001\025\001\025\001\000\000\ +\025\001\025\001\025\001\025\001\025\001\000\000\000\000\000\000\ +\000\000\000\000\025\001\000\000\025\001\025\001\025\001\025\001\ +\025\001\000\000\000\000\000\000\000\000\025\001\025\001\252\000\ +\025\001\025\001\025\001\000\000\000\000\000\000\025\001\000\000\ +\000\000\025\001\000\000\025\001\000\000\000\000\025\001\000\000\ +\000\000\025\001\000\000\000\000\000\000\025\001\026\001\026\001\ +\026\001\026\001\000\000\000\000\000\000\000\000\026\001\026\001\ +\026\001\000\000\000\000\026\001\026\001\026\001\026\001\026\001\ +\026\001\026\001\026\001\026\001\000\000\000\000\026\001\026\001\ +\026\001\026\001\026\001\026\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\026\001\026\001\000\000\000\000\026\001\026\001\ +\026\001\026\001\026\001\026\001\026\001\000\000\026\001\026\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\026\001\026\001\000\000\026\001\000\000\000\000\ +\026\001\026\001\026\001\000\000\026\001\026\001\026\001\026\001\ +\026\001\000\000\000\000\000\000\000\000\000\000\026\001\000\000\ +\026\001\026\001\026\001\026\001\026\001\000\000\000\000\000\000\ +\000\000\026\001\026\001\003\001\026\001\026\001\026\001\000\000\ +\000\000\000\000\026\001\000\000\000\000\026\001\000\000\026\001\ +\000\000\000\000\026\001\000\000\000\000\026\001\000\000\000\000\ +\000\000\026\001\000\000\251\000\251\000\251\000\251\000\000\000\ +\000\000\000\000\000\000\251\000\251\000\251\000\000\000\000\000\ +\251\000\251\000\251\000\251\000\251\000\251\000\251\000\251\000\ +\251\000\000\000\000\000\251\000\251\000\251\000\251\000\251\000\ +\251\000\000\000\000\000\000\000\000\000\000\000\000\000\251\000\ +\251\000\000\000\000\000\251\000\251\000\251\000\251\000\251\000\ +\251\000\000\000\000\000\251\000\251\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\251\000\ +\251\000\000\000\251\000\000\000\000\000\251\000\251\000\251\000\ +\000\000\251\000\251\000\251\000\251\000\251\000\000\000\000\000\ +\000\000\000\000\000\000\251\000\000\000\251\000\251\000\251\000\ +\251\000\251\000\000\000\000\000\000\000\000\000\251\000\251\000\ +\002\001\251\000\251\000\251\000\251\000\000\000\000\000\251\000\ +\000\000\000\000\251\000\000\000\251\000\000\000\000\000\251\000\ +\000\000\000\000\251\000\000\000\000\000\000\000\251\000\252\000\ +\252\000\252\000\252\000\000\000\000\000\000\000\000\000\252\000\ +\252\000\252\000\000\000\000\000\252\000\252\000\252\000\252\000\ +\252\000\252\000\252\000\252\000\252\000\000\000\000\000\252\000\ +\252\000\252\000\252\000\252\000\252\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\252\000\252\000\000\000\000\000\252\000\ +\252\000\252\000\252\000\252\000\252\000\000\000\000\000\252\000\ +\252\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\252\000\252\000\000\000\252\000\000\000\ +\000\000\252\000\252\000\252\000\000\000\252\000\252\000\252\000\ +\252\000\252\000\000\000\000\000\000\000\000\000\000\000\252\000\ +\000\000\252\000\252\000\252\000\252\000\252\000\000\000\000\000\ +\000\000\000\000\252\000\252\000\234\000\252\000\252\000\252\000\ +\252\000\000\000\000\000\252\000\000\000\000\000\252\000\000\000\ +\252\000\000\000\000\000\252\000\000\000\000\000\252\000\000\000\ +\000\000\000\000\252\000\003\001\003\001\003\001\003\001\000\000\ +\000\000\000\000\000\000\003\001\003\001\003\001\000\000\000\000\ +\003\001\003\001\003\001\003\001\003\001\003\001\003\001\003\001\ +\003\001\000\000\000\000\003\001\003\001\003\001\003\001\003\001\ +\003\001\000\000\000\000\000\000\000\000\000\000\000\000\003\001\ +\003\001\000\000\000\000\003\001\003\001\003\001\003\001\003\001\ +\003\001\000\000\000\000\003\001\003\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\001\ +\003\001\000\000\003\001\000\000\000\000\003\001\003\001\003\001\ +\000\000\003\001\003\001\003\001\003\001\003\001\000\000\000\000\ +\000\000\000\000\000\000\003\001\000\000\003\001\003\001\003\001\ +\003\001\003\001\000\000\000\000\000\000\000\000\003\001\003\001\ +\237\000\003\001\003\001\003\001\003\001\000\000\000\000\003\001\ +\000\000\000\000\003\001\000\000\003\001\000\000\000\000\003\001\ +\000\000\000\000\003\001\000\000\000\000\000\000\003\001\000\000\ +\002\001\002\001\002\001\002\001\000\000\000\000\000\000\000\000\ +\002\001\002\001\002\001\000\000\000\000\002\001\002\001\002\001\ +\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\ +\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\002\001\002\001\000\000\000\000\ +\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\ +\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\002\001\002\001\000\000\002\001\ +\000\000\000\000\002\001\002\001\002\001\000\000\002\001\002\001\ +\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\ +\002\001\000\000\002\001\002\001\002\001\002\001\002\001\000\000\ +\000\000\000\000\000\000\002\001\002\001\238\000\002\001\002\001\ +\002\001\002\001\000\000\000\000\002\001\000\000\000\000\002\001\ +\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\ +\000\000\000\000\000\000\002\001\234\000\234\000\234\000\234\000\ +\000\000\000\000\000\000\000\000\000\000\234\000\234\000\000\000\ +\000\000\234\000\234\000\234\000\234\000\234\000\234\000\234\000\ +\234\000\234\000\000\000\000\000\234\000\234\000\234\000\234\000\ +\234\000\234\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\234\000\234\000\000\000\000\000\234\000\234\000\234\000\234\000\ +\234\000\234\000\234\000\000\000\234\000\234\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\234\000\234\000\000\000\234\000\000\000\000\000\234\000\234\000\ +\234\000\000\000\234\000\234\000\234\000\234\000\234\000\000\000\ +\000\000\000\000\000\000\000\000\234\000\000\000\234\000\234\000\ +\234\000\234\000\234\000\000\000\000\000\000\000\000\000\234\000\ +\234\000\250\000\234\000\234\000\234\000\234\000\000\000\000\000\ +\234\000\000\000\000\000\234\000\000\000\234\000\000\000\000\000\ +\234\000\000\000\000\000\234\000\000\000\000\000\000\000\234\000\ +\237\000\237\000\237\000\237\000\000\000\000\000\000\000\000\000\ +\000\000\237\000\237\000\000\000\000\000\237\000\237\000\237\000\ +\237\000\237\000\237\000\237\000\237\000\237\000\000\000\000\000\ +\237\000\237\000\237\000\237\000\237\000\237\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\237\000\237\000\000\000\000\000\ +\237\000\237\000\237\000\237\000\237\000\237\000\237\000\000\000\ +\237\000\237\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\237\000\237\000\000\000\237\000\ +\000\000\000\000\237\000\237\000\237\000\000\000\237\000\237\000\ +\237\000\237\000\237\000\000\000\000\000\000\000\000\000\000\000\ +\237\000\000\000\237\000\237\000\237\000\237\000\237\000\000\000\ +\000\000\000\000\000\000\237\000\237\000\000\001\237\000\237\000\ +\237\000\237\000\000\000\000\000\237\000\000\000\000\000\237\000\ +\000\000\237\000\000\000\000\000\237\000\000\000\000\000\237\000\ +\000\000\000\000\000\000\237\000\000\000\238\000\238\000\238\000\ +\238\000\000\000\000\000\000\000\000\000\000\000\238\000\238\000\ +\000\000\000\000\238\000\238\000\238\000\238\000\238\000\238\000\ +\238\000\238\000\238\000\000\000\000\000\238\000\238\000\238\000\ +\238\000\238\000\238\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\238\000\238\000\000\000\000\000\238\000\238\000\238\000\ +\238\000\238\000\238\000\238\000\000\000\238\000\238\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\238\000\238\000\000\000\238\000\000\000\000\000\238\000\ +\238\000\238\000\000\000\238\000\238\000\238\000\238\000\238\000\ +\000\000\000\000\000\000\000\000\000\000\238\000\000\000\238\000\ +\238\000\238\000\238\000\238\000\000\000\000\000\000\000\000\000\ +\238\000\238\000\001\001\238\000\238\000\238\000\238\000\000\000\ +\000\000\238\000\000\000\000\000\238\000\000\000\238\000\000\000\ +\000\000\238\000\000\000\000\000\238\000\000\000\000\000\000\000\ +\238\000\250\000\250\000\250\000\250\000\000\000\000\000\000\000\ +\000\000\250\000\250\000\250\000\000\000\000\000\250\000\250\000\ +\250\000\250\000\250\000\250\000\250\000\250\000\250\000\000\000\ +\000\000\250\000\250\000\250\000\250\000\250\000\250\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\250\000\250\000\000\000\ +\000\000\250\000\250\000\250\000\250\000\250\000\000\000\000\000\ +\000\000\250\000\250\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\250\000\250\000\000\000\ +\250\000\000\000\000\000\250\000\250\000\250\000\000\000\250\000\ +\250\000\250\000\250\000\250\000\000\000\000\000\000\000\000\000\ +\000\000\250\000\000\000\250\000\000\000\250\000\250\000\250\000\ +\000\000\000\000\000\000\000\000\250\000\250\000\253\000\250\000\ +\250\000\250\000\250\000\000\000\000\000\000\000\000\000\000\000\ +\250\000\000\000\250\000\000\000\000\000\250\000\000\000\000\000\ +\250\000\000\000\000\000\000\000\250\000\000\001\000\001\000\001\ +\000\001\000\000\000\000\000\000\000\000\000\001\000\001\000\001\ +\000\000\000\000\000\001\000\001\000\001\000\001\000\001\000\001\ +\000\001\000\001\000\001\000\000\000\000\000\001\000\001\000\001\ +\000\001\000\001\000\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\001\000\001\000\000\000\000\000\001\000\001\000\001\ +\000\001\000\001\000\000\000\000\000\000\000\001\000\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\001\000\001\000\000\000\001\000\000\000\000\000\001\ +\000\001\000\001\000\000\000\001\000\001\000\001\000\001\000\001\ +\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\ +\000\000\000\001\000\001\000\001\000\000\000\000\000\000\000\000\ +\000\001\000\001\254\000\000\001\000\001\000\001\000\001\000\000\ +\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\ +\000\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\ +\000\001\000\000\001\001\001\001\001\001\001\001\000\000\000\000\ +\000\000\000\000\001\001\001\001\001\001\000\000\000\000\001\001\ +\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ +\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\ +\000\000\000\000\001\001\001\001\001\001\001\001\001\001\000\000\ +\000\000\000\000\001\001\001\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\ +\000\000\001\001\000\000\000\000\001\001\001\001\001\001\000\000\ +\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\ +\000\000\000\000\001\001\000\000\001\001\000\000\001\001\001\001\ +\001\001\000\000\000\000\000\000\000\000\001\001\001\001\255\000\ +\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\ +\000\000\001\001\000\000\001\001\000\000\000\000\001\001\000\000\ +\000\000\001\001\000\000\000\000\000\000\001\001\253\000\253\000\ +\253\000\253\000\000\000\000\000\000\000\000\000\253\000\253\000\ +\253\000\000\000\000\000\253\000\253\000\253\000\253\000\253\000\ +\253\000\253\000\253\000\253\000\000\000\000\000\253\000\253\000\ +\253\000\253\000\253\000\253\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\253\000\253\000\000\000\000\000\253\000\253\000\ +\253\000\253\000\253\000\000\000\000\000\000\000\253\000\253\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\253\000\253\000\000\000\253\000\000\000\000\000\ +\253\000\253\000\253\000\000\000\253\000\253\000\253\000\253\000\ +\253\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000\ +\253\000\000\000\253\000\253\000\253\000\000\000\000\000\000\000\ +\000\000\253\000\253\000\208\000\253\000\253\000\253\000\253\000\ +\000\000\000\000\000\000\000\000\000\000\253\000\000\000\253\000\ +\000\000\000\000\253\000\000\000\000\000\253\000\000\000\000\000\ +\000\000\253\000\254\000\254\000\254\000\254\000\000\000\000\000\ +\000\000\000\000\254\000\254\000\254\000\000\000\000\000\254\000\ +\254\000\254\000\254\000\254\000\254\000\254\000\254\000\254\000\ +\000\000\000\000\254\000\254\000\254\000\254\000\254\000\254\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\254\000\254\000\ +\000\000\000\000\254\000\254\000\254\000\254\000\254\000\000\000\ +\000\000\000\000\254\000\254\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\254\000\254\000\ +\000\000\254\000\000\000\000\000\254\000\254\000\254\000\000\000\ +\254\000\254\000\254\000\254\000\254\000\000\000\000\000\000\000\ +\000\000\000\000\254\000\000\000\254\000\000\000\254\000\254\000\ +\254\000\000\000\000\000\000\000\000\000\254\000\254\000\004\001\ +\254\000\254\000\254\000\254\000\000\000\000\000\000\000\000\000\ +\000\000\254\000\000\000\254\000\000\000\000\000\254\000\000\000\ +\000\000\254\000\000\000\000\000\000\000\254\000\000\000\255\000\ +\255\000\255\000\255\000\000\000\000\000\000\000\000\000\255\000\ +\255\000\255\000\000\000\000\000\255\000\255\000\255\000\255\000\ +\255\000\255\000\255\000\255\000\255\000\000\000\000\000\255\000\ +\255\000\255\000\255\000\255\000\255\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\255\000\255\000\000\000\000\000\255\000\ +\255\000\255\000\255\000\255\000\000\000\000\000\000\000\255\000\ +\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\255\000\255\000\000\000\255\000\000\000\ +\000\000\255\000\255\000\255\000\000\000\255\000\255\000\255\000\ +\255\000\255\000\000\000\000\000\000\000\000\000\000\000\255\000\ +\000\000\255\000\000\000\255\000\255\000\255\000\000\000\000\000\ +\000\000\000\000\255\000\255\000\006\001\255\000\255\000\255\000\ +\255\000\000\000\000\000\000\000\000\000\000\000\255\000\000\000\ +\255\000\000\000\000\000\255\000\000\000\000\000\255\000\000\000\ +\000\000\000\000\255\000\208\000\208\000\208\000\208\000\000\000\ +\000\000\000\000\000\000\208\000\208\000\208\000\000\000\000\000\ +\208\000\208\000\208\000\208\000\208\000\208\000\208\000\208\000\ +\208\000\000\000\000\000\208\000\208\000\208\000\208\000\208\000\ +\208\000\000\000\000\000\000\000\000\000\000\000\000\000\208\000\ +\208\000\000\000\000\000\208\000\208\000\208\000\208\000\208\000\ +\208\000\208\000\000\000\208\000\208\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\208\000\ +\208\000\000\000\000\000\000\000\000\000\208\000\208\000\208\000\ +\000\000\208\000\000\000\000\000\208\000\208\000\000\000\000\000\ +\000\000\000\000\000\000\208\000\000\000\208\000\000\000\000\000\ +\000\000\208\000\000\000\000\000\000\000\000\000\208\000\208\000\ +\248\000\208\000\208\000\208\000\208\000\000\000\000\000\208\000\ +\000\000\000\000\208\000\000\000\208\000\000\000\000\000\208\000\ +\000\000\000\000\208\000\000\000\000\000\000\000\208\000\004\001\ +\004\001\004\001\004\001\000\000\000\000\000\000\000\000\004\001\ +\004\001\004\001\000\000\000\000\004\001\004\001\000\000\004\001\ +\004\001\004\001\004\001\004\001\004\001\000\000\000\000\004\001\ +\004\001\004\001\004\001\004\001\004\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\004\001\004\001\000\000\000\000\004\001\ +\004\001\004\001\000\000\000\000\000\000\000\000\000\000\004\001\ +\004\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\004\001\004\001\000\000\004\001\000\000\ +\000\000\000\000\004\001\004\001\000\000\004\001\000\000\000\000\ +\004\001\004\001\000\000\000\000\000\000\000\000\000\000\004\001\ +\000\000\004\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\004\001\004\001\249\000\004\001\004\001\004\001\ +\004\001\000\000\000\000\000\000\000\000\000\000\004\001\000\000\ +\004\001\000\000\000\000\004\001\000\000\000\000\004\001\000\000\ +\000\000\000\000\004\001\000\000\006\001\006\001\006\001\006\001\ +\000\000\000\000\000\000\000\000\006\001\006\001\006\001\000\000\ +\000\000\006\001\006\001\000\000\006\001\006\001\006\001\006\001\ +\006\001\006\001\000\000\000\000\006\001\006\001\006\001\006\001\ +\006\001\006\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\006\001\006\001\000\000\000\000\006\001\006\001\006\001\000\000\ +\000\000\000\000\000\000\000\000\006\001\006\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\006\001\006\001\000\000\006\001\000\000\000\000\000\000\006\001\ +\006\001\000\000\006\001\000\000\000\000\006\001\006\001\000\000\ +\000\000\000\000\000\000\000\000\006\001\000\000\006\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\001\ +\006\001\005\001\006\001\006\001\006\001\006\001\000\000\000\000\ +\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\ +\006\001\000\000\000\000\006\001\000\000\000\000\000\000\006\001\ +\248\000\248\000\248\000\248\000\000\000\000\000\000\000\000\000\ +\248\000\248\000\248\000\000\000\000\000\248\000\248\000\000\000\ +\248\000\248\000\248\000\248\000\248\000\248\000\000\000\000\000\ +\248\000\248\000\248\000\248\000\248\000\248\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\248\000\248\000\000\000\000\000\ +\248\000\248\000\248\000\000\000\000\000\000\000\000\000\000\000\ +\248\000\248\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\248\000\248\000\000\000\248\000\ +\000\000\000\000\000\000\248\000\248\000\000\000\248\000\000\000\ +\000\000\248\000\248\000\000\000\000\000\000\000\000\000\000\000\ +\248\000\010\001\248\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\248\000\248\000\000\000\248\000\248\000\ +\248\000\248\000\000\000\000\000\000\000\000\000\000\000\248\000\ +\000\000\248\000\000\000\000\000\248\000\000\000\000\000\248\000\ +\000\000\000\000\000\000\248\000\249\000\249\000\249\000\249\000\ +\000\000\000\000\000\000\000\000\249\000\249\000\249\000\000\000\ +\000\000\249\000\249\000\000\000\249\000\249\000\249\000\249\000\ +\249\000\249\000\000\000\000\000\249\000\249\000\249\000\249\000\ +\249\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\249\000\249\000\000\000\000\000\249\000\249\000\249\000\000\000\ +\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\249\000\249\000\000\000\249\000\000\000\000\000\000\000\249\000\ +\249\000\009\001\249\000\000\000\000\000\249\000\249\000\000\000\ +\000\000\000\000\000\000\000\000\249\000\000\000\249\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\ +\249\000\000\000\249\000\249\000\249\000\249\000\000\000\000\000\ +\000\000\000\000\000\000\249\000\000\000\249\000\000\000\000\000\ +\249\000\000\000\000\000\249\000\000\000\000\000\000\000\249\000\ +\000\000\005\001\005\001\005\001\005\001\000\000\000\000\000\000\ +\000\000\005\001\005\001\005\001\000\000\000\000\005\001\005\001\ +\000\000\005\001\005\001\005\001\005\001\005\001\005\001\000\000\ +\000\000\005\001\005\001\005\001\005\001\005\001\005\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\005\001\005\001\000\000\ +\000\000\005\001\005\001\005\001\000\000\000\000\000\000\000\000\ +\000\000\005\001\005\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\008\001\000\000\000\000\000\000\005\001\005\001\000\000\ +\005\001\000\000\000\000\000\000\005\001\005\001\000\000\005\001\ +\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\000\ +\000\000\005\001\000\000\005\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\005\001\005\001\000\000\005\001\ +\005\001\005\001\005\001\000\000\000\000\000\000\000\000\000\000\ +\005\001\010\001\005\001\000\000\010\001\005\001\000\000\000\000\ +\005\001\010\001\010\001\010\001\005\001\000\000\010\001\010\001\ +\000\000\010\001\010\001\010\001\010\001\010\001\010\001\000\000\ +\000\000\010\001\010\001\010\001\000\000\010\001\010\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\010\001\000\000\ +\000\000\010\001\010\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\010\001\010\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\131\001\000\000\000\000\000\000\010\001\000\000\000\000\ +\010\001\000\000\000\000\000\000\010\001\010\001\000\000\010\001\ +\000\000\000\000\010\001\010\001\000\000\000\000\000\000\000\000\ +\000\000\010\001\000\000\010\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\010\001\010\001\000\000\010\001\ +\010\001\010\001\010\001\000\000\000\000\000\000\000\000\000\000\ +\010\001\009\001\010\001\000\000\009\001\010\001\000\000\000\000\ +\010\001\009\001\009\001\009\001\010\001\000\000\009\001\009\001\ +\000\000\009\001\009\001\009\001\009\001\009\001\009\001\000\000\ +\000\000\009\001\009\001\009\001\000\000\009\001\009\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\009\001\000\000\ +\000\000\009\001\009\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\009\001\009\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\007\001\000\000\000\000\000\000\009\001\000\000\000\000\ +\009\001\000\000\000\000\000\000\009\001\009\001\000\000\009\001\ +\000\000\000\000\009\001\009\001\000\000\000\000\000\000\000\000\ +\000\000\009\001\000\000\009\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\009\001\009\001\000\000\009\001\ +\009\001\009\001\009\001\000\000\000\000\000\000\000\000\000\000\ +\009\001\008\001\009\001\000\000\008\001\009\001\000\000\000\000\ +\009\001\008\001\000\000\008\001\009\001\000\000\008\001\008\001\ +\000\000\008\001\008\001\008\001\008\001\008\001\008\001\000\000\ +\000\000\008\001\008\001\008\001\000\000\008\001\008\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\008\001\000\000\ +\000\000\008\001\008\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\008\001\008\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\130\001\000\000\000\000\000\000\008\001\000\000\000\000\ +\008\001\000\000\000\000\000\000\008\001\008\001\000\000\008\001\ +\000\000\000\000\008\001\008\001\000\000\000\000\000\000\000\000\ +\000\000\008\001\000\000\000\000\000\000\000\000\000\000\021\003\ +\000\000\000\000\000\000\000\000\008\001\008\001\000\000\008\001\ +\008\001\008\001\008\001\000\000\000\000\000\000\000\000\000\000\ +\008\001\131\001\008\001\000\000\131\001\008\001\000\000\000\000\ +\008\001\131\001\000\000\131\001\008\001\000\000\131\001\131\001\ +\000\000\131\001\131\001\131\001\131\001\131\001\131\001\000\000\ +\000\000\131\001\131\001\131\001\000\000\131\001\131\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\131\001\000\000\ +\000\000\131\001\131\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\131\001\131\001\000\000\011\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\131\001\000\000\000\000\ +\131\001\000\000\000\000\000\000\131\001\131\001\000\000\131\001\ +\000\000\000\000\131\001\131\001\000\000\000\000\000\000\000\000\ +\000\000\131\001\021\003\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\131\001\131\001\000\000\131\001\ +\131\001\131\001\131\001\000\000\000\000\000\000\000\000\000\000\ +\131\001\007\001\131\001\000\000\007\001\131\001\000\000\000\000\ +\131\001\007\001\000\000\007\001\131\001\000\000\007\001\007\001\ +\000\000\007\001\007\001\007\001\007\001\007\001\007\001\000\000\ +\000\000\007\001\007\001\007\001\000\000\007\001\007\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\007\001\000\000\ +\000\000\007\001\007\001\000\000\000\000\000\000\000\000\024\001\ +\000\000\007\001\007\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\007\001\000\000\000\000\ +\007\001\000\000\000\000\000\000\007\001\007\001\000\000\007\001\ +\000\000\000\000\007\001\007\001\000\000\000\000\000\000\000\000\ +\000\000\007\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\007\001\007\001\000\000\007\001\ +\007\001\007\001\007\001\000\000\000\000\000\000\000\000\000\000\ +\007\001\130\001\007\001\000\000\130\001\007\001\000\000\000\000\ +\007\001\130\001\000\000\130\001\007\001\000\000\130\001\130\001\ +\000\000\130\001\130\001\130\001\130\001\130\001\130\001\000\000\ +\000\000\130\001\130\001\130\001\000\000\130\001\130\001\021\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\130\001\000\000\ +\000\000\130\001\130\001\000\000\021\003\000\000\000\000\014\001\ +\167\001\130\001\130\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\021\003\000\000\021\003\021\003\130\001\000\000\000\000\ +\130\001\000\000\000\000\000\000\130\001\130\001\000\000\130\001\ +\021\003\000\000\130\001\130\001\000\000\094\000\000\000\000\000\ +\136\000\130\001\137\000\138\000\030\000\000\000\139\000\000\000\ +\000\000\169\001\141\000\021\003\130\001\130\001\021\003\130\001\ +\130\001\130\001\130\001\021\003\011\001\000\000\000\000\011\001\ +\130\001\021\003\130\001\000\000\011\001\130\001\011\001\021\003\ +\130\001\011\001\011\001\144\000\130\001\011\001\000\000\011\001\ +\011\001\011\001\145\000\021\003\011\001\011\001\011\001\021\003\ +\011\001\011\001\021\003\000\000\000\000\021\003\146\000\147\000\ +\000\000\011\001\000\000\021\003\011\001\011\001\021\003\021\003\ +\000\000\000\000\243\000\000\000\011\001\011\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\021\003\000\000\021\003\021\003\ +\011\001\000\000\000\000\011\001\000\000\000\000\000\000\011\001\ +\011\001\000\000\011\001\021\003\000\000\011\001\011\001\000\000\ +\104\000\174\003\000\000\136\000\011\001\137\000\138\000\030\000\ +\000\000\139\000\000\000\000\000\158\001\141\000\021\003\011\001\ +\011\001\000\000\011\001\011\001\011\001\011\001\021\003\024\001\ +\000\000\000\000\024\001\011\001\021\003\011\001\000\000\024\001\ +\011\001\024\001\021\003\011\001\024\001\024\001\144\000\011\001\ +\024\001\000\000\024\001\024\001\024\001\145\000\021\003\024\001\ +\024\001\024\001\021\003\024\001\024\001\000\000\000\000\000\000\ +\000\000\146\000\147\000\000\000\024\001\000\000\021\003\024\001\ +\024\001\021\003\000\000\000\000\000\000\017\001\000\000\024\001\ +\024\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\001\000\000\000\000\024\001\000\000\ +\000\000\000\000\024\001\024\001\000\000\024\001\000\000\000\000\ +\024\001\024\001\000\000\000\000\000\000\000\000\000\000\024\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\024\001\024\001\000\000\024\001\024\001\024\001\ +\024\001\000\000\000\000\000\000\000\000\000\000\024\001\014\001\ +\024\001\000\000\014\001\024\001\000\000\000\000\024\001\014\001\ +\000\000\014\001\024\001\000\000\014\001\014\001\000\000\000\000\ +\014\001\000\000\014\001\014\001\014\001\000\000\000\000\014\001\ +\014\001\014\001\000\000\014\001\014\001\094\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\014\001\000\000\000\000\014\001\ +\014\001\000\000\094\000\000\000\000\000\016\001\000\000\014\001\ +\014\001\000\000\000\000\000\000\000\000\000\000\000\000\094\000\ +\000\000\094\000\094\000\014\001\000\000\000\000\014\001\000\000\ +\000\000\000\000\014\001\014\001\000\000\014\001\094\000\000\000\ +\014\001\014\001\000\000\021\003\000\000\000\000\136\000\014\001\ +\137\000\138\000\030\000\000\000\139\000\000\000\000\000\158\001\ +\141\000\094\000\014\001\014\001\000\000\014\001\014\001\014\001\ +\014\001\094\000\243\000\000\000\000\000\243\000\014\001\094\000\ +\014\001\000\000\243\000\014\001\243\000\094\000\014\001\243\000\ +\243\000\144\000\014\001\243\000\000\000\243\000\243\000\243\000\ +\145\000\094\000\243\000\243\000\243\000\094\000\243\000\243\000\ +\104\000\000\000\000\000\000\000\146\000\147\000\000\000\243\000\ +\000\000\094\000\243\000\243\000\094\000\104\000\000\000\000\000\ +\015\001\000\000\243\000\243\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\104\000\000\000\104\000\104\000\243\000\000\000\ +\000\000\243\000\000\000\000\000\000\000\243\000\243\000\000\000\ +\243\000\104\000\000\000\243\000\243\000\000\000\099\000\000\000\ +\000\000\000\000\243\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\104\000\243\000\243\000\000\000\ +\243\000\243\000\243\000\243\000\104\000\017\001\000\000\000\000\ +\017\001\243\000\104\000\243\000\000\000\017\001\243\000\017\001\ +\104\000\243\000\017\001\017\001\000\000\243\000\017\001\000\000\ +\017\001\017\001\017\001\000\000\104\000\017\001\017\001\017\001\ +\104\000\017\001\017\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\017\001\000\000\104\000\017\001\017\001\104\000\ +\000\000\000\000\000\000\020\001\000\000\017\001\017\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\017\001\000\000\000\000\017\001\000\000\000\000\000\000\ +\017\001\017\001\000\000\017\001\000\000\000\000\017\001\017\001\ +\000\000\000\000\000\000\000\000\000\000\017\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\017\001\017\001\000\000\017\001\017\001\017\001\017\001\000\000\ +\000\000\000\000\000\000\000\000\017\001\016\001\017\001\000\000\ +\016\001\017\001\000\000\000\000\017\001\016\001\000\000\016\001\ +\017\001\000\000\016\001\016\001\000\000\000\000\016\001\000\000\ +\016\001\016\001\016\001\000\000\000\000\016\001\016\001\016\001\ +\000\000\016\001\016\001\021\003\000\000\000\000\000\000\000\000\ +\000\000\000\000\016\001\000\000\000\000\016\001\016\001\000\000\ +\021\003\000\000\000\000\018\001\000\000\016\001\016\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\021\003\000\000\021\003\ +\021\003\016\001\000\000\000\000\016\001\000\000\000\000\000\000\ +\016\001\016\001\000\000\016\001\021\003\000\000\016\001\016\001\ +\000\000\103\000\000\000\000\000\000\000\016\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\003\ +\016\001\016\001\000\000\016\001\016\001\016\001\016\001\021\003\ +\015\001\000\000\000\000\015\001\016\001\021\003\016\001\000\000\ +\015\001\016\001\015\001\021\003\016\001\015\001\015\001\000\000\ +\016\001\015\001\000\000\015\001\015\001\015\001\000\000\021\003\ +\015\001\015\001\015\001\021\003\015\001\015\001\099\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\015\001\000\000\021\003\ +\015\001\015\001\021\003\099\000\000\000\000\000\019\001\000\000\ +\015\001\015\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\099\000\000\000\099\000\099\000\015\001\000\000\000\000\015\001\ +\000\000\000\000\000\000\015\001\015\001\000\000\015\001\099\000\ +\000\000\015\001\015\001\000\000\000\000\000\000\000\000\000\000\ +\015\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\099\000\015\001\015\001\000\000\015\001\015\001\ +\015\001\015\001\099\000\020\001\000\000\000\000\020\001\015\001\ +\099\000\015\001\000\000\020\001\015\001\020\001\099\000\015\001\ +\020\001\020\001\000\000\015\001\020\001\000\000\020\001\020\001\ +\020\001\000\000\099\000\020\001\020\001\020\001\099\000\020\001\ +\020\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\020\001\000\000\099\000\020\001\020\001\099\000\000\000\000\000\ +\000\000\023\001\000\000\020\001\020\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\001\ +\000\000\000\000\020\001\000\000\000\000\000\000\020\001\020\001\ +\000\000\020\001\000\000\000\000\020\001\020\001\000\000\000\000\ +\000\000\000\000\000\000\020\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\020\001\020\001\ +\000\000\020\001\020\001\020\001\020\001\000\000\000\000\000\000\ +\000\000\000\000\020\001\018\001\020\001\000\000\018\001\020\001\ +\000\000\000\000\020\001\018\001\000\000\018\001\020\001\000\000\ +\018\001\018\001\000\000\000\000\018\001\000\000\018\001\018\001\ +\018\001\000\000\000\000\018\001\018\001\018\001\000\000\018\001\ +\018\001\103\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\018\001\000\000\000\000\018\001\018\001\000\000\103\000\000\000\ +\000\000\021\001\000\000\018\001\018\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\103\000\000\000\103\000\103\000\018\001\ +\000\000\000\000\018\001\000\000\000\000\000\000\018\001\018\001\ +\000\000\018\001\103\000\000\000\018\001\018\001\000\000\000\000\ +\000\000\000\000\000\000\018\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\103\000\018\001\018\001\ +\000\000\018\001\018\001\018\001\018\001\103\000\019\001\000\000\ +\000\000\019\001\018\001\103\000\018\001\000\000\019\001\018\001\ +\019\001\103\000\018\001\019\001\019\001\000\000\018\001\019\001\ +\000\000\019\001\019\001\019\001\000\000\103\000\019\001\019\001\ +\019\001\103\000\019\001\019\001\010\000\000\000\157\001\000\000\ +\000\000\000\000\000\000\019\001\000\000\103\000\019\001\019\001\ +\103\000\000\000\000\000\000\000\022\001\000\000\019\001\019\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\019\001\000\000\000\000\019\001\000\000\000\000\ +\000\000\019\001\019\001\000\000\019\001\000\000\000\000\019\001\ +\019\001\000\000\000\000\000\000\000\000\136\000\019\001\137\000\ +\138\000\030\000\000\000\139\000\000\000\000\000\158\001\141\000\ +\000\000\019\001\019\001\000\000\019\001\019\001\019\001\019\001\ +\000\000\023\001\000\000\000\000\023\001\019\001\000\000\019\001\ +\000\000\023\001\019\001\023\001\000\000\019\001\023\001\023\001\ +\144\000\019\001\023\001\000\000\023\001\023\001\023\001\145\000\ +\000\000\023\001\023\001\023\001\000\000\023\001\023\001\000\000\ +\000\000\000\000\000\000\146\000\147\000\000\000\023\001\000\000\ +\000\000\023\001\023\001\000\000\000\000\000\000\000\000\207\000\ +\000\000\023\001\023\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\023\001\000\000\000\000\ +\023\001\000\000\000\000\000\000\023\001\023\001\000\000\023\001\ +\000\000\000\000\023\001\023\001\000\000\000\000\000\000\000\000\ +\000\000\023\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\001\023\001\000\000\023\001\ +\023\001\023\001\023\001\000\000\000\000\000\000\000\000\000\000\ +\023\001\021\001\023\001\000\000\021\001\023\001\000\000\000\000\ +\023\001\021\001\000\000\021\001\023\001\000\000\021\001\021\001\ +\000\000\000\000\021\001\000\000\021\001\021\001\021\001\000\000\ +\000\000\021\001\021\001\021\001\000\000\021\001\021\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\021\001\000\000\ +\000\000\021\001\021\001\000\000\000\000\000\000\000\000\244\000\ +\000\000\021\001\021\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\021\001\000\000\000\000\ +\021\001\000\000\000\000\000\000\021\001\021\001\000\000\021\001\ +\000\000\000\000\021\001\021\001\000\000\000\000\000\000\000\000\ +\000\000\021\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\021\001\021\001\000\000\021\001\ +\021\001\021\001\021\001\000\000\022\001\000\000\000\000\022\001\ +\021\001\000\000\021\001\000\000\022\001\021\001\022\001\000\000\ +\021\001\022\001\022\001\000\000\021\001\022\001\000\000\022\001\ +\022\001\022\001\000\000\000\000\022\001\022\001\022\001\000\000\ +\022\001\022\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\022\001\000\000\000\000\022\001\022\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\022\001\022\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\061\002\000\000\000\000\ +\022\001\000\000\000\000\022\001\000\000\000\000\000\000\022\001\ +\022\001\000\000\022\001\000\000\000\000\022\001\022\001\000\000\ +\000\000\000\000\000\000\000\000\022\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\001\ +\022\001\000\000\022\001\022\001\022\001\022\001\000\000\207\000\ +\000\000\000\000\207\000\022\001\000\000\022\001\000\000\207\000\ +\022\001\207\000\000\000\022\001\207\000\207\000\000\000\022\001\ +\207\000\000\000\207\000\207\000\207\000\000\000\000\000\207\000\ +\207\000\207\000\000\000\207\000\207\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\207\000\000\000\000\000\207\000\ +\207\000\000\000\000\000\000\000\000\000\000\000\000\000\207\000\ +\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\095\002\000\000\000\000\207\000\000\000\000\000\207\000\000\000\ +\000\000\000\000\207\000\207\000\000\000\207\000\000\000\000\000\ +\207\000\207\000\000\000\000\000\000\000\000\000\000\000\207\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\207\000\207\000\000\000\207\000\000\000\207\000\ +\207\000\000\000\000\000\000\000\000\000\000\000\207\000\244\000\ +\207\000\000\000\244\000\207\000\000\000\000\000\207\000\244\000\ +\000\000\244\000\207\000\000\000\244\000\244\000\000\000\000\000\ +\244\000\000\000\244\000\244\000\244\000\000\000\000\000\244\000\ +\000\000\244\000\000\000\244\000\244\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\244\000\000\000\000\000\244\000\ +\244\000\000\000\000\000\000\000\000\000\000\000\000\000\244\000\ +\244\000\000\000\000\000\059\002\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\244\000\000\000\000\000\244\000\000\000\ +\000\000\000\000\244\000\244\000\000\000\244\000\000\000\000\000\ +\244\000\244\000\000\000\000\000\000\000\000\000\000\000\244\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\244\000\244\000\000\000\244\000\244\000\244\000\ +\244\000\000\000\000\000\000\000\000\000\000\000\244\000\000\000\ +\244\000\000\000\000\000\244\000\000\000\061\002\244\000\061\002\ +\061\002\061\002\244\000\000\000\000\000\061\002\000\000\000\000\ +\000\000\000\000\061\002\000\000\000\000\000\000\061\002\061\002\ +\061\002\000\000\000\000\000\000\000\000\154\003\000\000\061\002\ +\061\002\061\002\061\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\061\002\000\000\000\000\000\000\061\002\061\002\000\000\ +\057\002\000\000\000\000\000\000\000\000\061\002\061\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\061\002\000\000\000\000\061\002\000\000\000\000\061\002\ +\061\002\061\002\000\000\061\002\000\000\000\000\061\002\061\002\ +\000\000\000\000\000\000\000\000\136\000\061\002\137\000\138\000\ +\030\000\000\000\139\000\000\000\000\000\140\000\141\000\000\000\ +\061\002\061\002\000\000\061\002\061\002\061\002\000\000\000\000\ +\095\002\061\002\095\002\095\002\095\002\000\000\142\000\000\000\ +\095\002\061\002\000\000\000\000\061\002\095\002\143\000\144\000\ +\061\002\095\002\095\002\095\002\000\000\000\000\145\000\000\000\ +\000\000\000\000\095\002\095\002\095\002\095\002\000\000\000\000\ +\059\005\000\000\146\000\147\000\095\002\000\000\000\000\000\000\ +\000\000\095\002\000\000\058\002\000\000\000\000\000\000\160\005\ +\095\002\095\002\000\000\000\000\000\000\000\000\243\001\000\000\ +\000\000\000\000\000\000\000\000\095\002\000\000\000\000\095\002\ +\000\000\000\000\095\002\095\002\095\002\000\000\095\002\000\000\ +\000\000\095\002\095\002\000\000\000\000\000\000\000\000\061\005\ +\095\002\137\000\138\000\030\000\000\000\139\000\000\000\000\000\ +\140\000\062\005\000\000\095\002\095\002\000\000\095\002\095\002\ +\095\002\095\002\000\000\059\002\000\000\059\002\059\002\059\002\ +\000\000\142\000\000\000\059\002\095\002\000\000\000\000\095\002\ +\059\002\143\000\144\000\095\002\059\002\059\002\059\002\000\000\ +\000\000\145\000\000\000\000\000\000\000\059\002\059\002\059\002\ +\059\002\000\000\246\001\000\000\000\000\064\005\147\000\059\002\ +\000\000\000\000\000\000\000\000\059\002\000\000\056\002\000\000\ +\000\000\000\000\000\000\059\002\059\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\002\ +\000\000\000\000\059\002\000\000\000\000\059\002\059\002\059\002\ +\000\000\059\002\000\000\000\000\000\000\059\002\000\000\000\000\ +\000\000\000\000\000\000\059\002\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\059\002\059\002\ +\000\000\059\002\059\002\059\002\059\002\000\000\000\000\000\000\ +\057\002\000\000\057\002\057\002\057\002\000\000\000\000\059\002\ +\057\002\000\000\059\002\000\000\000\000\057\002\059\002\000\000\ +\000\000\057\002\057\002\057\002\000\000\000\000\000\000\000\000\ +\000\000\000\000\057\002\057\002\057\002\057\002\000\000\000\000\ +\000\000\000\000\000\000\000\000\057\002\000\000\000\000\000\000\ +\000\000\057\002\000\000\053\002\000\000\000\000\000\000\000\000\ +\057\002\057\002\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\057\002\000\000\000\000\057\002\ +\000\000\000\000\057\002\057\002\057\002\000\000\057\002\000\000\ +\000\000\000\000\057\002\000\000\000\000\000\000\000\000\136\000\ +\057\002\137\000\138\000\030\000\000\000\139\000\000\000\000\000\ +\140\000\141\000\000\000\057\002\057\002\000\000\057\002\057\002\ +\057\002\057\002\177\001\058\002\000\000\058\002\058\002\058\002\ +\000\000\142\000\000\000\058\002\057\002\000\000\000\000\057\002\ +\058\002\143\000\144\000\057\002\058\002\058\002\058\002\042\002\ +\000\000\145\000\000\000\000\000\000\000\058\002\058\002\058\002\ +\058\002\000\000\000\000\000\000\000\000\146\000\147\000\058\002\ +\000\000\000\000\000\000\000\000\058\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\058\002\058\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\058\002\ +\000\000\000\000\058\002\000\000\000\000\058\002\058\002\058\002\ +\000\000\058\002\000\000\000\000\000\000\058\002\000\000\000\000\ +\000\000\041\002\136\000\058\002\137\000\138\000\030\000\000\000\ +\139\000\000\000\000\000\140\000\141\000\000\000\058\002\058\002\ +\000\000\058\002\058\002\058\002\058\002\000\000\056\002\000\000\ +\056\002\056\002\056\002\000\000\142\000\000\000\056\002\058\002\ +\000\000\000\000\058\002\056\002\143\000\126\003\058\002\056\002\ +\056\002\056\002\000\000\000\000\145\000\000\000\000\000\000\000\ +\056\002\056\002\056\002\056\002\000\000\000\000\000\000\068\006\ +\146\000\147\000\056\002\039\002\000\000\000\000\000\000\056\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\056\002\056\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\056\002\000\000\000\000\056\002\000\000\000\000\ +\056\002\056\002\056\002\000\000\056\002\000\000\000\000\000\000\ +\056\002\000\000\000\000\000\000\000\000\000\000\056\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\056\002\056\002\000\000\056\002\056\002\056\002\056\002\ +\000\000\197\000\000\000\053\002\000\000\053\002\053\002\000\000\ +\000\000\000\000\056\002\053\002\000\000\056\002\000\000\000\000\ +\053\002\056\002\000\000\000\000\053\002\053\002\053\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\053\002\053\002\053\002\ +\053\002\000\000\000\000\000\000\000\000\000\000\000\000\053\002\ +\000\000\000\000\000\000\000\000\053\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\053\002\053\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\084\000\000\000\000\000\000\000\053\002\ +\000\000\000\000\053\002\000\000\000\000\053\002\053\002\053\002\ +\000\000\053\002\000\000\000\000\010\000\053\002\157\001\042\002\ +\000\000\000\000\042\002\053\002\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\042\002\000\000\053\002\053\002\ +\042\002\053\002\053\002\053\002\053\002\000\000\000\000\000\000\ +\000\000\042\002\042\002\042\002\042\002\000\000\000\000\053\002\ +\000\000\000\000\053\002\000\000\000\000\000\000\053\002\000\000\ +\042\002\000\000\000\000\000\000\000\000\136\000\000\000\137\000\ +\138\000\030\000\000\000\139\000\000\000\000\000\158\001\141\000\ +\000\000\041\002\000\000\042\002\041\002\000\000\042\002\000\000\ +\000\000\042\002\042\002\042\002\000\000\000\000\041\002\000\000\ +\042\002\042\002\041\002\000\000\000\000\000\000\000\000\042\002\ +\144\000\000\000\227\002\041\002\041\002\041\002\041\002\145\000\ +\000\000\000\000\000\000\042\002\023\003\042\002\000\000\042\002\ +\042\002\000\000\041\002\146\000\147\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\042\002\000\000\000\000\042\002\000\000\ +\000\000\000\000\042\002\039\002\000\000\041\002\039\002\000\000\ +\041\002\000\000\000\000\041\002\041\002\041\002\000\000\000\000\ +\039\002\000\000\041\002\041\002\039\002\000\000\000\000\000\000\ +\000\000\041\002\000\000\000\000\000\000\039\002\039\002\039\002\ +\039\002\000\000\000\000\000\000\000\000\041\002\000\000\041\002\ +\000\000\041\002\041\002\000\000\039\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\041\002\000\000\000\000\ +\041\002\000\000\000\000\000\000\041\002\000\000\000\000\039\002\ +\000\000\197\000\039\002\000\000\197\000\039\002\039\002\039\002\ +\000\000\000\000\000\000\000\000\039\002\039\002\197\000\000\000\ +\000\000\000\000\197\000\039\002\197\000\000\000\000\000\000\000\ +\000\000\000\000\128\000\197\000\197\000\197\000\197\000\039\002\ +\000\000\039\002\000\000\039\002\039\002\000\000\000\000\000\000\ +\000\000\000\000\197\000\000\000\000\000\000\000\000\000\039\002\ +\000\000\000\000\039\002\000\000\000\000\000\000\039\002\000\000\ +\000\000\000\000\000\000\084\000\000\000\197\000\084\000\000\000\ +\197\000\000\000\000\000\000\000\197\000\197\000\000\000\000\000\ +\084\000\000\000\197\000\197\000\084\000\000\000\000\000\000\000\ +\000\000\197\000\000\000\000\000\000\000\084\000\084\000\084\000\ +\084\000\000\000\000\000\000\000\000\000\197\000\000\000\197\000\ +\000\000\197\000\197\000\000\000\084\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\ +\197\000\120\000\000\000\000\000\197\000\000\000\000\000\084\000\ +\000\000\000\000\084\000\000\000\000\000\000\000\084\000\084\000\ +\000\000\000\000\000\000\000\000\084\000\084\000\244\004\000\000\ +\137\000\138\000\030\000\084\000\139\000\000\000\245\004\246\004\ +\141\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\ +\000\000\084\000\000\000\084\000\084\000\247\004\000\000\000\000\ +\248\004\000\000\000\000\000\000\000\000\000\000\000\000\084\000\ +\249\004\144\000\084\000\000\000\023\003\000\000\084\000\023\003\ +\145\000\023\003\023\003\023\003\023\003\000\000\000\000\023\003\ +\023\003\023\003\000\000\000\000\146\000\147\000\000\000\023\003\ +\000\000\000\000\000\000\023\003\000\000\000\000\023\003\000\000\ +\023\003\023\003\023\003\023\003\023\003\023\003\023\003\023\003\ +\023\003\000\000\000\000\023\003\023\003\023\003\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\003\023\003\023\003\023\003\ +\023\003\023\003\023\003\023\003\023\003\023\003\023\003\023\003\ +\023\003\023\003\150\001\023\003\023\003\023\003\000\000\023\003\ +\023\003\023\003\023\003\023\003\023\003\000\000\023\003\023\003\ +\023\003\023\003\023\003\000\000\023\003\023\003\000\000\000\000\ +\023\003\023\003\000\000\023\003\023\003\023\003\023\003\023\003\ +\023\003\023\003\000\000\023\003\023\003\023\003\000\000\023\003\ +\000\000\023\003\023\003\000\000\023\003\000\000\023\003\023\003\ +\023\003\023\003\023\003\023\003\023\003\000\000\023\003\009\000\ +\010\000\011\000\000\000\000\000\000\000\012\000\013\000\014\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\015\000\016\000\ +\017\000\018\000\019\000\020\000\021\000\000\000\000\000\000\000\ +\000\000\022\000\000\000\023\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\024\000\000\000\025\000\026\000\ +\027\000\028\000\029\000\000\000\000\000\030\000\031\000\000\000\ +\000\000\032\000\033\000\034\000\000\000\164\002\035\000\036\000\ +\000\000\037\000\038\000\000\000\039\000\000\000\040\000\000\000\ +\041\000\000\000\042\000\000\000\000\000\000\000\043\000\044\000\ +\000\000\045\000\000\000\000\000\000\000\000\000\009\000\010\000\ +\011\000\000\000\129\000\121\000\012\000\013\000\014\000\047\000\ +\000\000\000\000\000\000\000\000\048\000\049\000\050\000\051\000\ +\052\000\053\000\000\000\000\000\054\000\015\000\016\000\017\000\ +\018\000\019\000\020\000\021\000\000\000\000\000\000\000\000\000\ +\022\000\000\000\023\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\000\000\000\025\000\026\000\027\000\ +\028\000\029\000\000\000\000\000\030\000\031\000\000\000\000\000\ +\032\000\033\000\034\000\000\000\000\000\035\000\036\000\000\000\ +\037\000\038\000\000\000\039\000\000\000\040\000\000\000\041\000\ +\000\000\042\000\000\000\109\000\000\000\043\000\044\000\000\000\ +\045\000\178\001\136\000\000\000\137\000\138\000\030\000\000\000\ +\139\000\000\000\121\000\140\000\141\000\000\000\047\000\000\000\ +\000\000\000\000\000\000\048\000\049\000\050\000\051\000\052\000\ +\053\000\000\000\000\000\054\000\142\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\143\000\144\000\000\000\009\000\ +\010\000\011\000\000\000\000\000\145\000\012\000\013\000\014\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\146\000\147\000\000\000\000\000\000\000\000\000\015\000\016\000\ +\017\000\018\000\019\000\020\000\021\000\000\000\000\000\000\000\ +\000\000\022\000\000\000\023\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\024\000\000\000\025\000\026\000\ +\027\000\028\000\029\000\000\000\000\000\030\000\031\000\000\000\ +\000\000\032\000\033\000\034\000\000\000\000\000\035\000\036\000\ +\000\000\037\000\038\000\000\000\039\000\132\000\040\000\000\000\ +\041\000\000\000\042\000\000\000\000\000\000\000\043\000\044\000\ +\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\121\000\000\000\000\000\000\000\047\000\ +\000\000\000\000\000\000\000\000\048\000\049\000\050\000\051\000\ +\052\000\053\000\000\000\000\000\054\000\164\002\000\000\000\000\ +\000\000\164\002\000\000\164\002\000\000\164\002\000\000\164\002\ +\000\000\164\002\000\000\164\002\164\002\000\000\164\002\164\002\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\164\002\164\002\000\000\164\002\164\002\134\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\164\002\ +\164\002\164\002\164\002\000\000\164\002\164\002\000\000\000\000\ +\164\002\000\000\000\000\000\000\000\000\164\002\164\002\164\002\ +\000\000\000\000\000\000\000\000\164\002\000\000\164\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\164\002\000\000\ +\000\000\164\002\000\000\000\000\000\000\000\000\164\002\135\000\ +\164\002\164\002\000\000\164\002\164\002\000\000\164\002\000\000\ +\000\000\000\000\164\002\109\000\000\000\164\002\000\000\164\002\ +\000\000\178\001\164\002\164\002\000\000\178\001\164\002\178\001\ +\109\000\178\001\000\000\178\001\000\000\178\001\000\000\178\001\ +\178\001\000\000\178\001\178\001\000\000\109\000\000\000\109\000\ +\109\000\000\000\000\000\000\000\178\001\000\000\000\000\178\001\ +\178\001\000\000\000\000\000\000\109\000\000\000\000\000\000\000\ +\000\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\178\001\178\001\000\000\178\001\109\000\ +\178\001\178\001\000\000\000\000\178\001\000\000\109\000\109\000\ +\000\000\178\001\178\001\178\001\000\000\109\000\000\000\000\000\ +\178\001\000\000\178\001\109\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\178\001\000\000\000\000\178\001\000\000\109\000\ +\000\000\000\000\178\001\109\000\178\001\178\001\000\000\178\001\ +\178\001\000\000\178\001\136\000\000\000\000\000\178\001\109\000\ +\000\000\178\001\109\000\178\001\000\000\132\000\178\001\178\001\ +\132\000\132\000\178\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\132\000\132\000\000\000\000\000\000\000\000\000\ +\132\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\ +\000\000\132\000\132\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\132\000\132\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\132\000\000\000\000\000\132\000\000\000\000\000\132\000\ +\132\000\132\000\000\000\132\000\000\000\134\000\000\000\132\000\ +\134\000\134\000\014\002\000\000\000\000\132\000\000\000\000\000\ +\000\000\000\000\134\000\134\000\000\000\000\000\000\000\000\000\ +\134\000\132\000\000\000\132\000\000\000\132\000\132\000\134\000\ +\000\000\134\000\134\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\132\000\000\000\000\000\132\000\000\000\134\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\134\000\134\000\000\000\ +\000\000\000\000\000\000\181\000\000\000\000\000\000\000\135\000\ +\000\000\134\000\135\000\135\000\134\000\000\000\000\000\134\000\ +\134\000\134\000\000\000\134\000\135\000\135\000\000\000\134\000\ +\000\000\000\000\135\000\000\000\000\000\134\000\000\000\000\000\ +\000\000\135\000\000\000\135\000\135\000\000\000\000\000\000\000\ +\000\000\134\000\000\000\134\000\000\000\134\000\134\000\000\000\ +\135\000\000\000\000\000\000\000\000\000\183\002\000\000\135\000\ +\135\000\134\000\000\000\000\000\134\000\000\000\000\000\000\000\ +\000\000\130\000\000\000\135\000\130\000\130\000\135\000\000\000\ +\000\000\000\000\135\000\135\000\000\000\135\000\130\000\130\000\ +\000\000\135\000\000\000\000\000\130\000\000\000\000\000\135\000\ +\000\000\000\000\000\000\130\000\000\000\130\000\130\000\000\000\ +\000\000\000\000\000\000\135\000\000\000\135\000\000\000\135\000\ +\135\000\000\000\130\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\130\000\130\000\135\000\000\000\000\000\135\000\000\000\ +\000\000\000\000\000\000\136\000\000\000\130\000\136\000\136\000\ +\130\000\015\002\000\000\000\000\130\000\130\000\000\000\130\000\ +\136\000\136\000\000\000\130\000\000\000\000\000\136\000\000\000\ +\000\000\130\000\000\000\000\000\000\000\136\000\000\000\136\000\ +\136\000\000\000\000\000\000\000\000\000\130\000\000\000\130\000\ +\000\000\130\000\130\000\000\000\136\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\136\000\136\000\130\000\000\000\000\000\ +\130\000\000\000\000\000\000\000\000\000\000\000\000\000\136\000\ +\000\000\000\000\136\000\182\000\000\000\000\000\136\000\136\000\ +\000\000\136\000\000\000\000\000\000\000\136\000\136\000\000\000\ +\137\000\138\000\030\000\136\000\139\000\000\000\000\000\140\000\ +\141\000\000\000\014\002\000\000\000\000\014\002\000\000\136\000\ +\000\000\136\000\014\002\136\000\136\000\000\000\000\000\014\002\ +\142\000\000\000\000\000\000\000\000\000\014\002\000\000\136\000\ +\143\000\126\003\136\000\000\000\014\002\000\000\014\002\014\002\ +\145\000\000\000\000\000\000\000\000\000\021\003\000\000\000\000\ +\000\000\000\000\014\002\014\002\146\000\147\000\000\000\000\000\ +\000\000\000\000\000\000\181\000\000\000\000\000\181\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\014\002\000\000\ +\181\000\014\002\000\000\000\000\014\002\014\002\014\002\000\000\ +\000\000\000\000\000\000\098\002\014\002\181\000\181\000\181\000\ +\181\000\000\000\014\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\181\000\000\000\014\002\023\003\ +\000\000\000\000\014\002\014\002\000\000\183\002\098\002\000\000\ +\183\002\000\000\000\000\000\000\000\000\000\000\014\002\181\000\ +\000\000\014\002\183\002\080\002\000\000\181\000\181\000\181\000\ +\000\000\000\000\000\000\000\000\080\002\181\000\000\000\183\002\ +\183\002\183\002\183\002\181\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\183\002\181\000\ +\000\000\181\000\000\000\181\000\080\002\000\000\000\000\080\002\ +\000\000\232\001\000\000\000\000\000\000\000\000\000\000\181\000\ +\080\002\183\002\181\000\000\000\000\000\174\002\000\000\183\002\ +\183\002\183\002\000\000\000\000\000\000\000\000\174\002\183\002\ +\000\000\015\002\000\000\000\000\015\002\183\002\000\000\000\000\ +\000\000\015\002\000\000\000\000\000\000\000\000\015\002\000\000\ +\000\000\183\002\000\000\183\002\015\002\183\002\174\002\000\000\ +\000\000\174\002\071\000\015\002\000\000\015\002\015\002\000\000\ +\000\000\183\002\174\002\000\000\183\002\000\000\000\000\000\000\ +\000\000\015\002\015\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\182\000\000\000\015\002\182\000\000\000\ +\015\002\000\000\000\000\015\002\015\002\015\002\000\000\000\000\ +\182\000\000\000\015\002\015\002\000\000\000\000\182\000\233\001\ +\000\000\015\002\000\000\000\000\000\000\182\000\182\000\182\000\ +\182\000\000\000\000\000\000\000\000\000\015\002\000\000\000\000\ +\000\000\015\002\015\002\000\000\182\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\182\000\000\000\015\002\000\000\000\000\ +\015\002\000\000\000\000\000\000\000\000\021\003\000\000\182\000\ +\021\003\000\000\182\000\000\000\000\000\000\000\182\000\182\000\ +\000\000\182\000\021\003\000\000\235\001\182\000\000\000\000\000\ +\021\003\000\000\000\000\182\000\000\000\000\000\000\000\021\003\ +\000\000\021\003\021\003\000\000\000\000\000\000\000\000\182\000\ +\000\000\182\000\000\000\182\000\182\000\021\003\021\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\021\003\021\003\182\000\ +\000\000\000\000\182\000\000\000\000\000\000\000\000\000\023\003\ +\000\000\021\003\023\003\000\000\021\003\000\000\000\000\023\003\ +\000\000\021\003\000\000\021\003\023\003\000\000\000\000\021\003\ +\000\000\000\000\023\003\000\000\000\000\021\003\000\000\000\000\ +\000\000\023\003\000\000\023\003\023\003\000\000\000\000\234\001\ +\000\000\021\003\000\000\000\000\000\000\021\003\021\003\000\000\ +\023\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\021\003\000\000\000\000\021\003\000\000\000\000\000\000\ +\000\000\232\001\000\000\023\003\232\001\000\000\023\003\000\000\ +\000\000\000\000\023\003\023\003\000\000\000\000\232\001\000\000\ +\000\000\023\003\000\000\000\000\232\001\000\000\000\000\023\003\ +\000\000\000\000\000\000\232\001\236\001\232\001\232\001\000\000\ +\000\000\000\000\000\000\023\003\000\000\011\002\000\000\023\003\ +\023\003\000\000\232\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\071\000\023\003\000\000\071\000\023\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\232\001\000\000\071\000\ +\232\001\000\000\000\000\000\000\232\001\232\001\000\000\000\000\ +\000\000\000\000\000\000\232\001\071\000\000\000\071\000\071\000\ +\000\000\232\001\000\000\000\000\000\000\000\000\000\000\240\001\ +\000\000\000\000\071\000\071\000\000\000\232\001\000\000\000\000\ +\000\000\232\001\232\001\000\000\000\000\000\000\000\000\233\001\ +\000\000\000\000\233\001\000\000\000\000\232\001\071\000\000\000\ +\232\001\071\000\000\000\000\000\233\001\071\000\071\000\000\000\ +\000\000\000\000\233\001\000\000\071\000\000\000\000\000\000\000\ +\000\000\233\001\071\000\233\001\233\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\011\002\000\000\071\000\000\000\ +\233\001\000\000\071\000\071\000\000\000\021\003\000\000\000\000\ +\000\000\000\000\000\000\000\000\235\001\000\000\071\000\235\001\ +\000\000\071\000\000\000\233\001\000\000\000\000\233\001\000\000\ +\000\000\235\001\233\001\233\001\000\000\000\000\000\000\235\001\ +\000\000\233\001\000\000\000\000\000\000\000\000\235\001\233\001\ +\235\001\235\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\233\001\000\000\235\001\000\000\233\001\ +\233\001\000\000\125\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\233\001\000\000\000\000\233\001\000\000\ +\235\001\000\000\000\000\235\001\000\000\000\000\000\000\235\001\ +\235\001\000\000\000\000\000\000\000\000\000\000\235\001\234\001\ +\000\000\000\000\234\001\000\000\235\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\234\001\000\000\000\000\000\000\ +\235\001\000\000\234\001\000\000\235\001\235\001\000\000\126\000\ +\000\000\234\001\000\000\234\001\234\001\000\000\000\000\000\000\ +\235\001\000\000\000\000\235\001\000\000\000\000\000\000\000\000\ +\234\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\236\001\000\000\000\000\236\001\ +\000\000\000\000\000\000\234\001\000\000\011\002\234\001\000\000\ +\000\000\236\001\234\001\234\001\000\000\011\002\000\000\236\001\ +\023\003\234\001\011\002\000\000\000\000\000\000\236\001\234\001\ +\236\001\236\001\023\003\000\000\000\000\000\000\000\000\011\002\ +\000\000\011\002\011\002\234\001\000\000\236\001\000\000\234\001\ +\234\001\000\000\000\000\000\000\000\000\000\000\011\002\000\000\ +\000\000\000\000\000\000\234\001\000\000\000\000\234\001\240\001\ +\236\001\000\000\240\001\236\001\000\000\000\000\000\000\236\001\ +\236\001\011\002\000\000\000\000\240\001\000\000\236\001\011\002\ +\011\002\011\002\240\001\000\000\236\001\000\000\000\000\011\002\ +\000\000\240\001\000\000\240\001\240\001\011\002\000\000\000\000\ +\236\001\000\000\000\000\118\000\236\001\236\001\000\000\000\000\ +\240\001\011\002\000\000\000\000\000\000\011\002\000\000\000\000\ +\236\001\000\000\000\000\236\001\011\002\000\000\000\000\000\000\ +\000\000\011\002\000\000\240\001\011\002\021\003\240\001\000\000\ +\021\003\011\002\240\001\240\001\000\000\000\000\000\000\000\000\ +\000\000\240\001\021\003\000\000\000\000\000\000\011\002\240\001\ +\011\002\011\002\000\000\000\000\021\003\000\000\000\000\021\003\ +\000\000\021\003\021\003\240\001\000\000\011\002\119\000\240\001\ +\240\001\000\000\000\000\000\000\000\000\021\003\021\003\000\000\ +\000\000\000\000\000\000\240\001\000\000\000\000\240\001\000\000\ +\011\002\000\000\125\000\011\002\000\000\125\000\011\002\011\002\ +\011\002\021\003\000\000\000\000\021\003\000\000\011\002\125\000\ +\000\000\021\003\000\000\000\000\011\002\000\000\000\000\021\003\ +\000\000\000\000\000\000\000\000\125\000\021\003\125\000\125\000\ +\011\002\000\000\000\000\000\000\011\002\011\002\000\000\000\000\ +\000\000\021\003\000\000\125\000\223\001\021\003\021\003\000\000\ +\011\002\000\000\000\000\011\002\000\000\000\000\000\000\126\000\ +\000\000\021\003\126\000\000\000\021\003\000\000\125\000\000\000\ +\000\000\125\000\000\000\000\000\126\000\125\000\125\000\000\000\ +\000\000\000\000\000\000\000\000\125\000\000\000\000\000\000\000\ +\000\000\126\000\125\000\126\000\126\000\000\000\000\000\000\000\ +\061\000\000\000\000\000\000\000\000\000\000\000\125\000\000\000\ +\126\000\064\000\125\000\125\000\000\000\000\000\000\000\000\000\ +\023\003\000\000\000\000\000\000\000\000\000\000\125\000\000\000\ +\023\003\125\000\023\003\126\000\000\000\023\003\126\000\000\000\ +\000\000\000\000\126\000\126\000\000\000\000\000\000\000\023\003\ +\000\000\126\000\023\003\000\000\023\003\023\003\000\000\126\000\ +\000\000\000\000\000\000\000\000\023\003\000\000\023\003\023\003\ +\000\000\023\003\065\000\126\000\000\000\000\000\000\000\126\000\ +\126\000\000\000\000\000\023\003\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\126\000\023\003\000\000\126\000\023\003\ +\000\000\000\000\000\000\023\003\023\003\000\000\023\003\000\000\ +\000\000\023\003\023\003\118\000\000\000\023\003\023\003\000\000\ +\023\003\000\000\000\000\000\000\023\003\000\000\021\003\000\000\ +\118\000\000\000\023\003\000\000\023\003\000\000\000\000\000\000\ +\023\003\023\003\000\000\000\000\000\000\118\000\023\003\118\000\ +\118\000\000\000\023\003\023\003\023\003\000\000\000\000\023\003\ +\000\000\000\000\000\000\000\000\118\000\000\000\023\003\000\000\ +\000\000\023\003\000\000\000\000\021\003\000\000\000\000\021\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\119\000\118\000\ +\000\000\021\003\118\000\000\000\000\000\000\000\118\000\118\000\ +\000\000\000\000\000\000\119\000\000\000\118\000\021\003\000\000\ +\021\003\021\003\000\000\118\000\000\000\000\000\000\000\000\000\ +\119\000\000\000\119\000\119\000\000\000\021\003\000\000\118\000\ +\000\000\000\000\000\000\118\000\118\000\000\000\000\000\119\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\118\000\ +\021\003\000\000\118\000\021\003\000\000\000\000\000\000\000\000\ +\021\003\000\000\119\000\000\000\223\001\119\000\021\003\000\000\ +\000\000\119\000\119\000\000\000\021\003\000\000\000\000\000\000\ +\119\000\223\001\000\000\000\000\000\000\000\000\119\000\000\000\ +\021\003\000\000\000\000\000\000\021\003\021\003\223\001\000\000\ +\223\001\223\001\119\000\000\000\000\000\000\000\119\000\119\000\ +\021\003\000\000\000\000\021\003\000\000\223\001\000\000\000\000\ +\061\000\000\000\119\000\000\000\000\000\119\000\000\000\000\000\ +\000\000\064\000\000\000\000\000\000\000\061\000\000\000\000\000\ +\223\001\000\000\000\000\223\001\000\000\000\000\064\000\223\001\ +\223\001\000\000\061\000\000\000\061\000\061\000\223\001\000\000\ +\000\000\000\000\000\000\064\000\223\001\064\000\064\000\000\000\ +\000\000\061\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\223\001\000\000\064\000\000\000\223\001\223\001\000\000\000\000\ +\000\000\000\000\065\000\000\000\061\000\000\000\000\000\061\000\ +\223\001\000\000\000\000\223\001\061\000\064\000\000\000\065\000\ +\064\000\000\000\061\000\000\000\000\000\064\000\000\000\000\000\ +\061\000\000\000\000\000\064\000\065\000\000\000\065\000\065\000\ +\000\000\064\000\000\000\000\000\061\000\000\000\000\000\000\000\ +\061\000\061\000\000\000\065\000\000\000\064\000\021\003\000\000\ +\000\000\064\000\064\000\000\000\061\000\000\000\000\000\061\000\ +\000\000\000\000\000\000\021\003\000\000\064\000\065\000\000\000\ +\064\000\065\000\000\000\000\000\000\000\000\000\065\000\000\000\ +\021\003\000\000\021\003\021\003\065\000\000\000\000\000\000\000\ +\000\000\000\000\065\000\000\000\000\000\000\000\000\000\021\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\065\000\000\000\ +\000\000\000\000\065\000\065\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\021\003\000\000\000\000\021\003\065\000\000\000\ +\000\000\065\000\021\003\000\000\000\000\000\000\000\000\000\000\ +\021\003\000\000\000\000\000\000\000\000\000\000\021\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\021\003\016\003\000\000\000\000\021\003\021\003\ +\016\003\016\003\016\003\016\003\000\000\000\000\016\003\016\003\ +\016\003\016\003\021\003\000\000\000\000\021\003\016\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\016\003\000\000\016\003\ +\016\003\016\003\016\003\016\003\016\003\016\003\016\003\000\000\ +\000\000\000\000\016\003\000\000\016\003\000\000\000\000\000\000\ +\000\000\000\000\000\000\016\003\016\003\016\003\016\003\016\003\ +\016\003\016\003\016\003\016\003\000\000\000\000\016\003\016\003\ +\000\000\000\000\016\003\016\003\016\003\016\003\000\000\016\003\ +\016\003\016\003\016\003\016\003\000\000\016\003\000\000\016\003\ +\016\003\016\003\000\000\016\003\016\003\000\000\000\000\016\003\ +\016\003\000\000\016\003\000\000\016\003\016\003\000\000\016\003\ +\016\003\000\000\000\000\016\003\016\003\000\000\016\003\000\000\ +\016\003\016\003\000\000\016\003\000\000\016\003\016\003\016\003\ +\016\003\016\003\016\003\016\003\023\003\016\003\000\000\000\000\ +\000\000\023\003\023\003\023\003\023\003\000\000\000\000\023\003\ +\023\003\000\000\000\000\000\000\000\000\000\000\000\000\023\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\023\003\000\000\ +\023\003\000\000\023\003\023\003\023\003\023\003\023\003\023\003\ +\000\000\000\000\000\000\023\003\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\003\023\003\023\003\023\003\ +\023\003\023\003\023\003\023\003\023\003\000\000\000\000\023\003\ +\023\003\000\000\000\000\023\003\023\003\023\003\000\000\000\000\ +\023\003\023\003\023\003\023\003\023\003\000\000\023\003\000\000\ +\023\003\023\003\023\003\000\000\000\000\023\003\000\000\000\000\ +\023\003\023\003\000\000\023\003\000\000\023\003\023\003\000\000\ +\000\000\023\003\000\000\000\000\000\000\023\003\000\000\023\003\ +\000\000\023\003\023\003\000\000\023\003\000\000\023\003\023\003\ +\000\000\023\003\023\003\023\003\023\003\000\000\023\003\026\001\ +\027\001\028\001\000\000\000\000\009\000\010\000\029\001\000\000\ +\030\001\000\000\012\000\013\000\000\000\000\000\031\001\032\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\033\001\000\000\000\000\017\000\018\000\019\000\ +\020\000\021\000\000\000\034\001\000\000\000\000\022\000\000\000\ +\000\000\035\001\036\001\037\001\038\001\039\001\040\001\000\000\ +\000\000\024\000\000\000\025\000\026\000\027\000\028\000\029\000\ +\000\000\000\000\030\000\000\000\041\001\000\000\032\000\033\000\ +\034\000\000\000\000\000\000\000\036\000\000\000\042\001\043\001\ +\000\000\044\001\000\000\040\000\000\000\041\000\000\000\000\000\ +\000\000\045\001\046\001\047\001\048\001\049\001\050\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\051\001\000\000\000\000\ +\000\000\052\001\000\000\053\001\047\000\000\000\000\000\000\000\ +\000\000\048\000\049\000\000\000\051\000\052\000\026\001\027\001\ +\028\001\054\000\000\000\009\000\010\000\029\001\000\000\030\001\ +\000\000\012\000\013\000\000\000\000\000\079\003\032\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\033\001\000\000\000\000\017\000\018\000\019\000\020\000\ +\021\000\000\000\034\001\000\000\000\000\022\000\000\000\000\000\ +\035\001\036\001\037\001\038\001\039\001\040\001\000\000\000\000\ +\024\000\000\000\025\000\026\000\027\000\028\000\029\000\000\000\ +\000\000\030\000\000\000\041\001\000\000\032\000\033\000\034\000\ +\000\000\000\000\000\000\036\000\000\000\042\001\043\001\000\000\ +\080\003\000\000\040\000\000\000\041\000\000\000\000\000\000\000\ +\045\001\046\001\047\001\048\001\049\001\050\001\000\000\000\000\ +\000\000\000\000\000\000\089\002\081\003\089\002\089\002\089\002\ +\052\001\089\002\053\001\047\000\089\002\089\002\000\000\000\000\ +\048\000\049\000\000\000\051\000\052\000\023\003\000\000\000\000\ +\054\000\000\000\023\003\023\003\023\003\089\002\000\000\000\000\ +\023\003\023\003\023\003\000\000\000\000\089\002\089\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\089\002\000\000\023\003\ +\000\000\023\003\023\003\023\003\023\003\023\003\023\003\023\003\ +\000\000\089\002\089\002\000\000\023\003\000\000\023\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\003\ +\000\000\023\003\023\003\023\003\023\003\023\003\000\000\000\000\ +\023\003\023\003\000\000\000\000\023\003\023\003\023\003\000\000\ +\000\000\023\003\023\003\000\000\023\003\023\003\000\000\023\003\ +\000\000\023\003\000\000\023\003\000\000\023\003\000\000\000\000\ +\000\000\023\003\023\003\143\002\023\003\000\000\000\000\000\000\ +\217\002\217\002\217\002\000\000\000\000\023\003\217\002\217\002\ +\000\000\000\000\023\003\000\000\000\000\000\000\000\000\023\003\ +\023\003\023\003\023\003\023\003\023\003\000\000\000\000\023\003\ +\000\000\217\002\217\002\217\002\217\002\217\002\000\000\000\000\ +\000\000\000\000\217\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\217\002\000\000\217\002\ +\217\002\217\002\217\002\217\002\000\000\000\000\217\002\000\000\ +\000\000\000\000\217\002\217\002\217\002\000\000\000\000\000\000\ +\217\002\000\000\217\002\217\002\000\000\000\000\000\000\217\002\ +\000\000\217\002\000\000\000\000\000\000\000\000\000\000\217\002\ +\217\002\144\002\217\002\000\000\000\000\000\000\218\002\218\002\ +\218\002\143\002\000\000\000\000\218\002\218\002\000\000\000\000\ +\217\002\000\000\000\000\000\000\000\000\217\002\217\002\000\000\ +\217\002\217\002\000\000\000\000\000\000\217\002\000\000\218\002\ +\218\002\218\002\218\002\218\002\000\000\000\000\000\000\000\000\ +\218\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\218\002\000\000\218\002\218\002\218\002\ +\218\002\218\002\000\000\000\000\218\002\000\000\000\000\000\000\ +\218\002\218\002\218\002\000\000\000\000\000\000\218\002\000\000\ +\218\002\218\002\000\000\000\000\000\000\218\002\000\000\218\002\ +\000\000\000\000\000\000\000\000\000\000\218\002\218\002\141\002\ +\218\002\000\000\000\000\000\000\219\002\219\002\219\002\144\002\ +\000\000\000\000\219\002\219\002\000\000\000\000\218\002\000\000\ +\000\000\000\000\000\000\218\002\218\002\000\000\218\002\218\002\ +\000\000\000\000\000\000\218\002\000\000\219\002\219\002\219\002\ +\219\002\219\002\000\000\000\000\000\000\000\000\219\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\219\002\000\000\219\002\219\002\219\002\219\002\219\002\ +\000\000\000\000\219\002\000\000\000\000\000\000\219\002\219\002\ +\219\002\000\000\000\000\000\000\219\002\000\000\219\002\219\002\ +\000\000\000\000\000\000\219\002\000\000\219\002\000\000\000\000\ +\000\000\000\000\000\000\219\002\219\002\142\002\219\002\000\000\ +\000\000\000\000\220\002\220\002\220\002\141\002\000\000\000\000\ +\220\002\220\002\000\000\000\000\219\002\000\000\000\000\000\000\ +\000\000\219\002\219\002\000\000\219\002\219\002\000\000\000\000\ +\000\000\219\002\000\000\220\002\220\002\220\002\220\002\220\002\ +\000\000\000\000\000\000\000\000\220\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\220\002\ +\000\000\220\002\220\002\220\002\220\002\220\002\000\000\000\000\ +\220\002\000\000\000\000\000\000\220\002\220\002\220\002\000\000\ +\000\000\000\000\220\002\000\000\220\002\220\002\000\000\000\000\ +\000\000\220\002\000\000\220\002\000\000\000\000\000\000\000\000\ +\000\000\220\002\220\002\000\000\220\002\000\000\000\000\000\000\ +\000\000\000\000\000\000\142\002\224\000\225\000\226\000\000\000\ +\000\000\000\000\220\002\000\000\227\000\000\000\228\000\220\002\ +\220\002\000\000\220\002\220\002\229\000\230\000\231\000\220\002\ +\000\000\232\000\233\000\234\000\000\000\235\000\236\000\237\000\ +\000\000\238\000\239\000\240\000\241\000\000\000\000\000\000\000\ +\242\000\243\000\244\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\245\000\246\000\000\000\000\000\247\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\248\000\249\000\000\000\000\000\000\000\062\002\250\000\251\000\ +\000\000\062\002\000\000\252\000\253\000\254\000\255\000\000\001\ +\001\001\002\001\000\000\003\001\000\000\000\000\062\002\000\000\ +\062\002\004\001\000\000\045\002\000\000\000\000\005\001\062\002\ +\062\002\000\000\000\000\000\000\006\001\000\000\000\000\007\001\ +\008\001\062\002\009\001\010\001\011\001\012\001\013\001\000\000\ +\014\001\015\001\016\001\017\001\018\001\062\002\062\002\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\062\002\000\000\000\000\000\000\062\002\000\000\062\002\ +\062\002\062\002\000\000\062\002\000\000\000\000\062\002\000\000\ +\000\000\000\000\026\001\027\001\028\001\000\000\000\000\000\000\ +\010\000\207\001\000\000\030\001\000\000\000\000\013\000\045\002\ +\062\002\031\001\032\001\000\000\062\002\000\000\062\002\000\000\ +\000\000\062\002\000\000\000\000\000\000\033\001\161\000\000\000\ +\017\000\018\000\062\002\000\000\062\002\000\000\034\001\000\000\ +\000\000\000\000\000\000\000\000\035\001\036\001\037\001\038\001\ +\039\001\040\001\000\000\000\000\024\000\000\000\162\000\163\000\ +\000\000\164\000\165\000\000\000\000\000\030\000\000\000\041\001\ +\000\000\000\000\166\000\167\000\000\000\000\000\000\000\000\000\ +\000\000\208\001\209\001\000\000\210\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\045\001\046\001\211\001\212\001\ +\049\001\213\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\051\001\000\000\000\000\170\000\052\001\000\000\053\001\047\000\ +\000\000\000\000\000\000\000\000\048\000\000\000\240\002\051\000\ +\171\000\026\001\027\001\028\001\000\000\000\000\000\000\010\000\ +\207\001\000\000\030\001\000\000\000\000\013\000\000\000\000\000\ +\031\001\032\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\033\001\161\000\000\000\017\000\ +\018\000\000\000\000\000\000\000\000\000\034\001\000\000\000\000\ +\000\000\000\000\000\000\035\001\036\001\037\001\038\001\039\001\ +\040\001\000\000\000\000\024\000\000\000\162\000\163\000\000\000\ +\164\000\165\000\000\000\000\000\030\000\000\000\041\001\000\000\ +\000\000\166\000\167\000\000\000\000\000\000\000\000\000\000\000\ +\208\001\209\001\000\000\210\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\045\001\046\001\211\001\212\001\049\001\ +\213\001\000\000\000\000\000\000\000\000\000\000\000\000\051\001\ +\000\000\000\000\170\000\052\001\000\000\053\001\047\000\000\000\ +\000\000\000\000\000\000\048\000\000\000\194\003\051\000\171\000\ +\026\001\027\001\028\001\000\000\000\000\000\000\010\000\207\001\ +\000\000\030\001\000\000\000\000\013\000\000\000\000\000\031\001\ +\032\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\033\001\161\000\000\000\017\000\018\000\ +\000\000\000\000\000\000\000\000\034\001\000\000\000\000\000\000\ +\000\000\000\000\035\001\036\001\037\001\038\001\039\001\040\001\ +\000\000\000\000\024\000\000\000\162\000\163\000\000\000\164\000\ +\165\000\000\000\000\000\030\000\000\000\041\001\000\000\000\000\ +\166\000\167\000\000\000\000\000\000\000\000\000\000\000\208\001\ +\209\001\000\000\210\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\045\001\046\001\211\001\212\001\049\001\213\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\051\001\000\000\ +\000\000\170\000\052\001\000\000\053\001\047\000\000\000\000\000\ +\000\000\000\000\048\000\000\000\154\004\051\000\171\000\026\001\ +\027\001\028\001\000\000\000\000\000\000\010\000\207\001\000\000\ +\030\001\000\000\000\000\013\000\000\000\000\000\031\001\032\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\033\001\161\000\000\000\017\000\018\000\000\000\ +\000\000\000\000\000\000\034\001\000\000\000\000\000\000\000\000\ +\000\000\035\001\036\001\037\001\038\001\039\001\040\001\000\000\ +\000\000\024\000\000\000\162\000\163\000\000\000\164\000\165\000\ +\000\000\000\000\030\000\000\000\041\001\000\000\000\000\166\000\ +\167\000\000\000\000\000\000\000\000\000\000\000\208\001\209\001\ +\000\000\210\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\045\001\046\001\211\001\212\001\049\001\213\001\000\000\ +\000\000\157\003\000\000\000\000\000\000\051\001\000\000\010\000\ +\170\000\052\001\000\000\053\001\047\000\013\000\000\000\000\000\ +\079\003\048\000\000\000\000\000\051\000\171\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\161\000\000\000\017\000\ +\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\000\000\000\162\000\163\000\000\000\ +\164\000\165\000\000\000\000\000\030\000\000\000\200\002\000\000\ +\000\000\166\000\167\000\000\000\010\000\000\000\000\000\000\000\ +\168\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\169\000\000\000\000\000\ +\000\000\000\000\161\000\000\000\017\000\018\000\000\000\158\003\ +\000\000\000\000\170\000\000\000\000\000\000\000\047\000\000\000\ +\000\000\000\000\000\000\048\000\000\000\000\000\051\000\171\000\ +\024\000\000\000\162\000\163\000\000\000\164\000\165\000\000\000\ +\000\000\030\000\000\000\202\002\000\000\000\000\166\000\167\000\ +\000\000\010\000\000\000\000\000\000\000\168\000\000\000\013\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\169\000\000\000\000\000\000\000\000\000\161\000\ +\000\000\017\000\018\000\000\000\000\000\000\000\000\000\170\000\ +\000\000\000\000\000\000\047\000\000\000\000\000\000\000\000\000\ +\048\000\000\000\000\000\051\000\171\000\024\000\000\000\162\000\ +\163\000\000\000\164\000\165\000\000\000\000\000\030\000\000\000\ +\204\002\000\000\000\000\166\000\167\000\000\000\010\000\000\000\ +\000\000\000\000\168\000\000\000\013\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\169\000\ +\000\000\000\000\000\000\000\000\161\000\000\000\017\000\018\000\ +\000\000\000\000\000\000\000\000\170\000\000\000\000\000\000\000\ +\047\000\000\000\000\000\000\000\000\000\048\000\000\000\000\000\ +\051\000\171\000\024\000\000\000\162\000\163\000\000\000\164\000\ +\165\000\000\000\000\000\030\000\000\000\161\004\000\000\000\000\ +\166\000\167\000\000\000\010\000\000\000\000\000\000\000\168\000\ +\000\000\013\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\169\000\000\000\000\000\000\000\ +\000\000\161\000\000\000\017\000\018\000\000\000\000\000\000\000\ +\000\000\170\000\000\000\000\000\000\000\047\000\000\000\000\000\ +\000\000\000\000\048\000\000\000\000\000\051\000\171\000\024\000\ +\000\000\162\000\163\000\000\000\164\000\165\000\000\000\000\000\ +\030\000\000\000\163\004\000\000\000\000\166\000\167\000\000\000\ +\010\000\000\000\000\000\000\000\168\000\000\000\013\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\169\000\000\000\000\000\000\000\000\000\161\000\000\000\ +\017\000\018\000\000\000\000\000\000\000\000\000\170\000\000\000\ +\000\000\000\000\047\000\000\000\000\000\000\000\000\000\048\000\ +\000\000\000\000\051\000\171\000\024\000\000\000\162\000\163\000\ +\000\000\164\000\165\000\000\000\000\000\030\000\000\000\165\004\ +\000\000\000\000\166\000\167\000\000\000\010\000\000\000\000\000\ +\000\000\168\000\000\000\013\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\169\000\000\000\ +\000\000\000\000\000\000\161\000\000\000\017\000\018\000\000\000\ +\000\000\000\000\000\000\170\000\000\000\000\000\000\000\047\000\ +\000\000\000\000\000\000\000\000\048\000\000\000\000\000\051\000\ +\171\000\024\000\000\000\162\000\163\000\000\000\164\000\165\000\ +\000\000\000\000\030\000\000\000\000\000\000\000\000\000\166\000\ +\167\000\009\000\010\000\011\000\000\000\000\000\168\000\012\000\ +\013\000\014\000\032\002\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\ +\015\000\016\000\017\000\018\000\019\000\020\000\021\000\000\000\ +\170\000\000\000\000\000\022\000\047\000\023\000\000\000\000\000\ +\000\000\048\000\000\000\000\000\051\000\171\000\024\000\000\000\ +\025\000\026\000\027\000\028\000\029\000\000\000\000\000\030\000\ +\031\000\000\000\000\000\032\000\033\000\034\000\000\000\000\000\ +\035\000\036\000\000\000\037\000\038\000\000\000\039\000\000\000\ +\040\000\000\000\041\000\000\000\042\000\000\000\000\000\000\000\ +\043\000\044\000\000\000\045\000\000\000\033\002\000\000\000\000\ +\009\000\010\000\011\000\000\000\046\000\000\000\012\000\013\000\ +\014\000\047\000\000\000\000\000\000\000\000\000\048\000\049\000\ +\050\000\051\000\052\000\053\000\000\000\000\000\054\000\015\000\ +\016\000\017\000\018\000\019\000\020\000\021\000\000\000\000\000\ +\000\000\000\000\022\000\000\000\023\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\024\000\000\000\025\000\ +\026\000\027\000\028\000\029\000\000\000\000\000\030\000\031\000\ +\000\000\000\000\032\000\033\000\034\000\000\000\000\000\035\000\ +\036\000\000\000\037\000\038\000\000\000\039\000\000\000\040\000\ +\000\000\041\000\000\000\042\000\000\000\000\000\000\000\043\000\ +\044\000\000\000\045\000\000\000\000\000\000\000\009\000\010\000\ +\011\000\000\000\000\000\046\000\012\000\013\000\000\000\000\000\ +\047\000\000\000\000\000\000\000\000\000\048\000\049\000\050\000\ +\051\000\052\000\053\000\000\000\000\000\054\000\000\000\017\000\ +\018\000\019\000\020\000\021\000\000\000\000\000\000\000\000\000\ +\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\000\000\000\025\000\026\000\027\000\ +\028\000\029\000\000\000\000\000\030\000\000\000\000\000\000\000\ +\032\000\033\000\034\000\000\000\000\000\000\000\036\000\000\000\ +\037\000\038\000\000\000\000\000\000\000\040\000\000\000\041\000\ +\000\000\000\000\000\000\000\000\000\000\043\000\044\000\000\000\ +\045\000\000\000\000\000\000\000\000\000\219\000\009\000\010\000\ +\011\000\000\000\000\000\222\000\012\000\013\000\047\000\000\000\ +\000\000\000\000\000\000\048\000\049\000\000\000\051\000\052\000\ +\000\000\000\000\000\000\054\000\000\000\000\000\000\000\017\000\ +\018\000\019\000\020\000\021\000\000\000\000\000\000\000\000\000\ +\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\024\000\000\000\025\000\026\000\027\000\ +\028\000\029\000\000\000\000\000\030\000\000\000\000\000\000\000\ +\032\000\033\000\034\000\000\000\000\000\000\000\036\000\000\000\ +\037\000\038\000\000\000\000\000\000\000\040\000\000\000\041\000\ +\000\000\000\000\000\000\000\000\000\000\043\000\044\000\000\000\ +\045\000\000\000\000\000\009\000\010\000\011\000\000\000\000\000\ +\000\000\012\000\013\000\000\000\000\000\000\000\047\000\000\000\ +\000\000\000\000\000\000\048\000\049\000\000\000\051\000\052\000\ +\238\001\000\000\000\000\054\000\017\000\018\000\019\000\020\000\ +\021\000\000\000\000\000\000\000\000\000\022\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\024\000\000\000\025\000\026\000\027\000\028\000\029\000\000\000\ +\000\000\030\000\000\000\000\000\000\000\032\000\033\000\034\000\ +\000\000\000\000\000\000\036\000\000\000\037\000\038\000\000\000\ +\000\000\000\000\040\000\000\000\041\000\000\000\000\000\000\000\ +\000\000\000\000\043\000\044\000\000\000\045\000\000\000\000\000\ +\009\000\010\000\011\000\000\000\000\000\000\000\012\000\013\000\ +\000\000\000\000\000\000\047\000\000\000\000\000\000\000\000\000\ +\048\000\049\000\000\000\051\000\052\000\000\000\000\000\000\000\ +\054\000\017\000\018\000\019\000\020\000\021\000\000\000\000\000\ +\000\000\000\000\022\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\024\000\000\000\025\000\ +\026\000\027\000\028\000\029\000\000\000\000\000\030\000\000\000\ +\000\000\000\000\032\000\033\000\034\000\000\000\000\000\000\000\ +\036\000\000\000\037\000\038\000\000\000\000\000\000\000\040\000\ +\000\000\041\000\000\000\000\000\000\000\000\000\100\002\043\000\ +\044\000\000\000\045\000\000\000\000\000\009\000\010\000\011\000\ +\000\000\000\000\000\000\012\000\013\000\000\000\000\000\000\000\ +\047\000\000\000\000\000\000\000\000\000\048\000\049\000\000\000\ +\051\000\052\000\000\000\000\000\000\000\054\000\017\000\018\000\ +\019\000\020\000\021\000\000\000\000\000\000\000\000\000\022\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\024\000\000\000\025\000\026\000\027\000\028\000\ +\029\000\000\000\000\000\030\000\000\000\000\000\000\000\032\000\ +\033\000\034\000\000\000\000\000\000\000\036\000\000\000\037\000\ +\038\000\000\000\000\000\000\000\040\000\000\000\041\000\000\000\ +\000\000\000\000\000\000\000\000\043\000\044\000\000\000\045\000\ +\000\000\000\000\000\000\000\000\075\003\009\000\010\000\011\000\ +\000\000\000\000\077\003\012\000\013\000\047\000\000\000\000\000\ +\000\000\000\000\048\000\049\000\000\000\051\000\052\000\000\000\ +\000\000\000\000\054\000\000\000\000\000\000\000\017\000\018\000\ +\019\000\020\000\021\000\000\000\000\000\000\000\000\000\022\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\024\000\000\000\025\000\026\000\027\000\028\000\ +\029\000\000\000\000\000\030\000\000\000\000\000\000\000\032\000\ +\033\000\034\000\000\000\000\000\000\000\036\000\000\000\037\000\ +\038\000\000\000\000\000\000\000\040\000\000\000\041\000\000\000\ +\000\000\000\000\000\000\000\000\043\000\044\000\000\000\045\000\ +\000\000\000\000\000\000\009\000\010\000\011\000\000\000\000\000\ +\000\000\012\000\013\000\000\000\000\000\047\000\000\000\000\000\ +\000\000\000\000\048\000\049\000\134\004\051\000\052\000\000\000\ +\000\000\000\000\054\000\000\000\017\000\018\000\019\000\020\000\ +\021\000\000\000\000\000\000\000\000\000\022\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\024\000\000\000\025\000\026\000\027\000\028\000\029\000\000\000\ +\000\000\030\000\000\000\000\000\000\000\032\000\033\000\034\000\ +\000\000\000\000\000\000\036\000\000\000\037\000\038\000\000\000\ +\000\000\000\000\040\000\000\000\041\000\000\000\000\000\000\000\ +\000\000\000\000\043\000\044\000\000\000\045\000\000\000\000\000\ +\025\003\025\003\025\003\000\000\000\000\000\000\025\003\025\003\ +\000\000\000\000\000\000\047\000\000\000\000\000\000\000\000\000\ +\048\000\049\000\000\000\051\000\052\000\025\003\000\000\000\000\ +\054\000\025\003\025\003\025\003\025\003\025\003\000\000\000\000\ +\000\000\000\000\025\003\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\025\003\000\000\025\003\ +\025\003\025\003\025\003\025\003\000\000\000\000\025\003\000\000\ +\000\000\000\000\025\003\025\003\025\003\000\000\000\000\000\000\ +\025\003\000\000\025\003\025\003\000\000\000\000\000\000\025\003\ +\000\000\025\003\000\000\000\000\000\000\000\000\000\000\025\003\ +\025\003\000\000\025\003\000\000\000\000\009\000\010\000\011\000\ +\000\000\000\000\000\000\012\000\013\000\000\000\000\000\000\000\ +\025\003\000\000\000\000\000\000\000\000\025\003\025\003\000\000\ +\025\003\025\003\000\000\000\000\000\000\025\003\017\000\018\000\ +\019\000\020\000\021\000\000\000\000\000\000\000\000\000\022\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\024\000\000\000\025\000\026\000\027\000\028\000\ +\029\000\000\000\000\000\030\000\000\000\000\000\000\000\032\000\ +\033\000\034\000\000\000\000\000\000\000\036\000\000\000\037\000\ +\038\000\000\000\000\000\000\000\040\000\000\000\041\000\000\000\ +\000\000\000\000\000\000\000\000\043\000\044\000\000\000\045\000\ +\000\000\000\000\025\003\025\003\025\003\000\000\000\000\000\000\ +\025\003\025\003\000\000\000\000\000\000\047\000\000\000\000\000\ +\000\000\000\000\048\000\049\000\000\000\051\000\052\000\000\000\ +\000\000\000\000\054\000\025\003\025\003\025\003\025\003\025\003\ +\000\000\000\000\000\000\000\000\025\003\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025\003\ +\000\000\025\003\025\003\025\003\025\003\025\003\000\000\000\000\ +\025\003\000\000\000\000\000\000\025\003\025\003\025\003\000\000\ +\000\000\000\000\025\003\000\000\025\003\025\003\000\000\000\000\ +\000\000\025\003\000\000\025\003\000\000\000\000\000\000\000\000\ +\000\000\025\003\025\003\000\000\025\003\000\000\000\000\023\003\ +\023\003\023\003\000\000\000\000\000\000\023\003\023\003\000\000\ +\000\000\000\000\025\003\000\000\000\000\000\000\000\000\025\003\ +\025\003\000\000\025\003\025\003\000\000\000\000\000\000\025\003\ +\023\003\023\003\023\003\023\003\023\003\000\000\000\000\000\000\ +\000\000\023\003\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\003\000\000\023\003\023\003\ +\023\003\023\003\023\003\000\000\000\000\023\003\000\000\000\000\ +\000\000\023\003\023\003\023\003\000\000\000\000\000\000\023\003\ +\000\000\023\003\023\003\000\000\000\000\010\000\023\003\000\000\ +\023\003\000\000\000\000\013\000\000\000\217\003\023\003\023\003\ +\018\002\023\003\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\218\003\000\000\000\000\017\000\018\000\023\003\ +\000\000\000\000\000\000\000\000\023\003\023\003\000\000\023\003\ +\023\003\000\000\000\000\000\000\023\003\000\000\000\000\000\000\ +\000\000\024\000\252\001\000\000\163\000\000\000\164\000\165\000\ +\000\000\000\000\030\000\000\000\000\000\000\000\000\000\166\000\ +\219\003\000\000\010\000\000\000\000\000\000\000\168\000\000\000\ +\013\000\000\000\017\002\000\000\000\000\018\002\000\000\000\000\ +\254\001\000\000\000\000\169\000\000\000\000\000\000\000\218\003\ +\255\001\000\000\017\000\018\000\000\000\010\000\000\000\000\000\ +\170\000\000\000\000\000\013\000\047\000\250\002\000\000\000\002\ +\000\000\048\000\000\000\000\000\051\000\171\000\024\000\252\001\ +\000\000\163\000\000\000\164\000\165\000\017\000\018\000\030\000\ +\000\000\000\000\000\000\000\000\166\000\219\003\000\000\000\000\ +\000\000\000\000\000\000\168\000\000\000\000\000\000\000\000\000\ +\000\000\024\000\252\001\000\000\163\000\254\001\164\000\165\000\ +\169\000\000\000\030\000\000\000\000\000\255\001\000\000\166\000\ +\251\002\000\000\000\000\000\000\000\000\170\000\168\000\000\000\ +\252\002\047\000\000\000\000\000\000\002\000\000\048\000\000\000\ +\254\001\051\000\171\000\169\000\000\000\000\000\010\000\000\000\ +\255\001\000\000\000\000\000\000\013\000\000\000\107\004\000\000\ +\170\000\000\000\000\000\000\000\047\000\000\000\000\000\000\002\ +\000\000\048\000\000\000\108\004\051\000\171\000\017\000\018\000\ +\000\000\010\000\000\000\000\000\000\000\000\000\000\000\013\000\ +\000\000\031\006\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\024\000\252\001\000\000\163\000\218\003\164\000\ +\165\000\017\000\018\000\030\000\000\000\000\000\000\000\000\000\ +\166\000\167\000\000\000\000\000\000\000\000\000\000\000\168\000\ +\000\000\000\000\000\000\000\000\000\000\024\000\252\001\000\000\ +\163\000\254\001\164\000\165\000\169\000\000\000\030\000\000\000\ +\000\000\255\001\000\000\166\000\219\003\000\000\010\000\000\000\ +\000\000\170\000\168\000\000\000\013\000\047\000\000\000\000\000\ +\000\002\000\000\048\000\000\000\254\001\051\000\171\000\169\000\ +\000\000\000\000\000\000\000\000\255\001\000\000\017\000\018\000\ +\000\000\010\000\000\000\000\000\170\000\000\000\000\000\013\000\ +\047\000\000\000\000\000\000\002\000\000\048\000\000\000\000\000\ +\051\000\171\000\024\000\252\001\000\000\163\000\000\000\164\000\ +\165\000\017\000\018\000\030\000\000\000\000\000\000\000\000\000\ +\166\000\167\000\000\000\000\000\000\000\000\000\000\000\168\000\ +\000\000\015\006\000\000\000\000\000\000\024\000\252\001\000\000\ +\163\000\254\001\164\000\165\000\169\000\000\000\030\000\000\000\ +\000\000\255\001\000\000\166\000\253\001\000\000\010\000\000\000\ +\000\000\170\000\168\000\000\000\013\000\047\000\000\000\000\000\ +\000\002\000\000\048\000\000\000\254\001\051\000\171\000\169\000\ +\000\000\000\000\000\000\000\000\255\001\000\000\017\000\018\000\ +\000\000\025\003\000\000\000\000\170\000\000\000\000\000\025\003\ +\047\000\000\000\000\000\000\002\000\000\048\000\000\000\000\000\ +\051\000\171\000\024\000\252\001\000\000\163\000\000\000\164\000\ +\165\000\025\003\025\003\030\000\000\000\000\000\000\000\000\000\ +\166\000\167\000\000\000\000\000\000\000\000\000\000\000\168\000\ +\000\000\000\000\000\000\000\000\000\000\025\003\025\003\000\000\ +\025\003\254\001\025\003\025\003\169\000\000\000\025\003\000\000\ +\000\000\255\001\000\000\025\003\025\003\000\000\023\003\000\000\ +\000\000\170\000\025\003\000\000\023\003\047\000\000\000\000\000\ +\000\002\000\000\048\000\000\000\025\003\051\000\171\000\025\003\ +\000\000\000\000\000\000\000\000\025\003\000\000\023\003\023\003\ +\000\000\000\000\000\000\000\000\025\003\000\000\000\000\000\000\ +\025\003\000\000\000\000\025\003\000\000\025\003\000\000\000\000\ +\025\003\025\003\023\003\023\003\000\000\023\003\000\000\023\003\ +\023\003\000\000\000\000\023\003\000\000\000\000\000\000\000\000\ +\023\003\023\003\000\000\000\000\010\000\000\000\000\000\023\003\ +\000\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\023\003\000\000\000\000\023\003\000\000\000\000\000\000\ +\000\000\023\003\161\000\000\000\017\000\018\000\000\000\000\000\ +\000\000\023\003\000\000\000\000\000\000\023\003\000\000\000\000\ +\023\003\000\000\023\003\000\000\000\000\023\003\023\003\000\000\ +\024\000\000\000\162\000\163\000\000\000\164\000\165\000\000\000\ +\000\000\030\000\000\000\000\000\000\000\000\000\166\000\167\000\ +\000\000\000\000\000\000\010\000\000\000\168\000\000\000\205\001\ +\000\000\013\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\161\000\219\000\017\000\018\000\000\000\000\000\170\000\ +\000\000\000\000\000\000\047\000\000\000\000\000\000\000\000\000\ +\048\000\000\000\000\000\051\000\171\000\000\000\000\000\024\000\ +\000\000\162\000\163\000\000\000\164\000\165\000\000\000\000\000\ +\030\000\000\000\000\000\000\000\000\000\166\000\167\000\000\000\ +\010\000\000\000\000\000\000\000\168\000\000\000\013\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\010\000\011\000\000\000\ +\000\000\169\000\012\000\013\000\000\000\000\000\161\000\000\000\ +\017\000\018\000\000\000\000\000\000\000\000\000\170\000\000\000\ +\000\000\000\000\047\000\000\000\000\000\017\000\018\000\048\000\ +\000\000\000\000\051\000\171\000\024\000\000\000\162\000\163\000\ +\000\000\164\000\165\000\000\000\000\000\030\000\000\000\000\000\ +\000\000\024\000\166\000\167\000\026\000\027\000\028\000\029\000\ +\000\000\168\000\030\000\000\000\025\003\000\000\025\003\166\000\ +\034\000\000\000\025\003\000\000\000\000\000\000\169\000\000\000\ +\000\000\000\000\000\000\040\000\000\000\000\000\156\003\000\000\ +\000\000\000\000\025\003\170\000\025\003\025\003\045\000\047\000\ +\000\000\000\000\000\000\000\000\048\000\000\000\000\000\051\000\ +\171\000\000\000\000\000\000\000\047\000\000\000\000\000\000\000\ +\025\003\048\000\025\003\025\003\051\000\025\003\025\003\000\000\ +\000\000\025\003\000\000\000\000\000\000\000\000\025\003\025\003\ +\000\000\010\000\000\000\000\000\000\000\025\003\000\000\013\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\025\003\000\000\000\000\000\000\000\000\161\000\ +\000\000\017\000\018\000\000\000\000\000\000\000\000\000\025\003\ +\000\000\000\000\000\000\025\003\000\000\000\000\000\000\000\000\ +\025\003\000\000\000\000\025\003\025\003\024\000\000\000\162\000\ +\163\000\000\000\164\000\165\000\000\000\000\000\030\000\000\000\ +\000\000\000\000\000\000\166\000\167\000\000\000\025\003\000\000\ +\000\000\000\000\168\000\000\000\025\003\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\169\000\ +\000\000\000\000\000\000\000\000\025\003\000\000\025\003\025\003\ +\000\000\025\003\000\000\000\000\170\000\000\000\000\000\025\003\ +\047\000\000\000\000\000\000\000\000\000\048\000\000\000\000\000\ +\051\000\171\000\025\003\000\000\025\003\025\003\000\000\025\003\ +\025\003\025\003\025\003\025\003\000\000\000\000\000\000\000\000\ +\025\003\025\003\000\000\000\000\000\000\000\000\000\000\025\003\ +\000\000\000\000\000\000\000\000\000\000\025\003\000\000\025\003\ +\025\003\000\000\025\003\025\003\025\003\000\000\025\003\000\000\ +\000\000\000\000\000\000\025\003\025\003\000\000\213\002\000\000\ +\000\000\025\003\025\003\000\000\213\002\025\003\000\000\000\000\ +\000\000\000\000\025\003\000\000\000\000\025\003\025\003\025\003\ +\000\000\000\000\000\000\000\000\213\002\000\000\213\002\213\002\ +\025\003\010\000\000\000\000\000\025\003\000\000\000\000\013\000\ +\025\003\000\000\000\000\000\000\000\000\025\003\000\000\000\000\ +\025\003\025\003\213\002\000\000\213\002\213\002\000\000\213\002\ +\213\002\017\000\018\000\213\002\000\000\000\000\000\000\000\000\ +\213\002\213\002\000\000\000\000\000\000\000\000\000\000\213\002\ +\000\000\000\000\000\000\000\000\000\000\024\000\000\000\162\000\ +\163\000\000\000\164\000\165\000\213\002\000\000\030\000\000\000\ +\000\000\000\000\000\000\166\000\167\000\000\000\194\002\000\000\ +\000\000\213\002\168\000\000\000\194\002\213\002\000\000\000\000\ +\000\000\000\000\213\002\000\000\000\000\213\002\213\002\169\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\194\002\194\002\ +\000\000\023\003\000\000\000\000\170\000\000\000\000\000\023\003\ +\047\000\000\000\000\000\000\000\000\000\048\000\000\000\000\000\ +\051\000\171\000\194\002\000\000\194\002\194\002\000\000\194\002\ +\194\002\023\003\023\003\194\002\000\000\000\000\000\000\000\000\ +\194\002\194\002\000\000\000\000\000\000\000\000\000\000\194\002\ +\000\000\000\000\000\000\000\000\000\000\023\003\000\000\023\003\ +\023\003\000\000\023\003\023\003\194\002\000\000\023\003\000\000\ +\000\000\000\000\000\000\023\003\023\003\000\000\010\000\000\000\ +\000\000\194\002\023\003\000\000\013\000\194\002\000\000\000\000\ +\000\000\000\000\194\002\000\000\000\000\194\002\194\002\023\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\017\000\018\000\ +\000\000\025\003\000\000\000\000\023\003\000\000\000\000\025\003\ +\023\003\000\000\000\000\000\000\000\000\023\003\000\000\000\000\ +\023\003\023\003\024\000\000\000\000\000\163\000\000\000\164\000\ +\165\000\025\003\025\003\030\000\000\000\000\000\000\000\000\000\ +\166\000\167\000\000\000\000\000\000\000\000\000\000\000\168\000\ +\000\000\000\000\000\000\000\000\000\000\025\003\000\000\000\000\ +\025\003\000\000\025\003\025\003\169\000\000\000\025\003\000\000\ +\000\000\000\000\000\000\025\003\025\003\000\000\000\000\000\000\ +\000\000\170\000\025\003\000\000\000\000\047\000\010\000\011\000\ +\000\000\000\000\048\000\012\000\013\000\051\000\171\000\025\003\ +\000\000\000\000\000\000\000\000\000\000\000\000\115\001\000\000\ +\000\000\000\000\000\000\000\000\025\003\000\000\017\000\018\000\ +\025\003\000\000\000\000\000\000\000\000\025\003\000\000\000\000\ +\025\003\025\003\000\000\000\000\000\000\000\000\000\000\116\001\ +\000\000\000\000\024\000\117\001\000\000\026\000\027\000\028\000\ +\029\000\000\000\000\000\030\000\000\000\000\000\000\000\000\000\ +\166\000\034\000\010\000\011\000\000\000\000\000\000\000\012\000\ +\013\000\000\000\000\000\000\000\040\000\000\000\000\000\000\000\ +\000\000\118\001\000\000\000\000\000\000\000\000\000\000\045\000\ +\000\000\119\001\017\000\018\000\000\000\000\000\000\000\000\000\ +\000\000\120\001\121\001\000\000\000\000\047\000\000\000\000\000\ +\122\001\000\000\048\000\000\000\000\000\051\000\024\000\117\001\ +\000\000\026\000\027\000\028\000\029\000\000\000\000\000\030\000\ +\000\000\000\000\000\000\000\000\166\000\034\000\010\000\011\000\ +\000\000\000\000\000\000\012\000\013\000\025\003\025\003\000\000\ +\040\000\000\000\025\003\025\003\000\000\118\001\000\000\000\000\ +\000\000\000\000\000\000\045\000\000\000\119\001\017\000\018\000\ +\000\000\000\000\000\000\000\000\000\000\025\003\025\003\000\000\ +\000\000\047\000\000\000\000\000\122\001\000\000\048\000\000\000\ +\000\000\051\000\024\000\000\000\000\000\026\000\027\000\028\000\ +\029\000\025\003\000\000\030\000\025\003\025\003\025\003\025\003\ +\207\000\034\000\025\003\000\000\000\000\000\000\059\005\025\003\ +\025\003\000\000\000\000\000\000\040\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\025\003\000\000\060\005\000\000\045\000\ +\000\000\000\000\000\000\000\000\243\001\000\000\025\003\000\000\ +\000\000\000\000\000\000\000\000\000\000\047\000\000\000\000\000\ +\000\000\000\000\048\000\000\000\025\003\051\000\000\000\000\000\ +\000\000\025\003\000\000\000\000\025\003\061\005\000\000\137\000\ +\138\000\030\000\000\000\139\000\000\000\000\000\140\000\062\005\ +\000\000\000\000\000\000\032\005\078\001\079\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\080\001\000\000\000\000\142\000\ +\000\000\033\005\081\001\082\001\034\005\083\001\063\005\143\000\ +\144\000\000\000\000\000\000\000\000\000\000\000\084\001\145\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\085\001\ +\246\001\000\000\000\000\064\005\147\000\086\001\087\001\088\001\ +\089\001\090\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\091\001\000\000\000\000\000\000\000\000\186\000\000\000\000\000\ +\000\000\000\000\092\001\093\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\094\001\095\001\096\001\ +\097\001\098\001\000\000\026\001\027\001\028\001\000\000\000\000\ +\000\000\035\005\207\001\000\000\030\001\000\000\000\000\100\001\ +\000\000\000\000\023\003\032\001\023\003\023\003\023\003\000\000\ +\023\003\000\000\000\000\023\003\023\003\000\000\033\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\034\001\ +\000\000\000\000\000\000\000\000\023\003\035\001\036\001\037\001\ +\038\001\039\001\040\001\000\000\023\003\023\003\000\000\000\000\ +\000\000\000\000\000\000\000\000\023\003\000\000\000\000\000\000\ +\041\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\023\003\023\003\234\002\209\001\000\000\235\002\000\000\000\000\ +\000\000\000\000\041\004\078\001\079\001\045\001\046\001\236\002\ +\212\001\049\001\213\001\080\001\000\000\000\000\000\000\000\000\ +\000\000\081\001\082\001\000\000\083\001\052\001\000\000\053\001\ +\000\000\000\000\000\000\000\000\000\000\084\001\000\000\000\000\ +\000\000\000\000\043\004\078\001\079\001\000\000\085\001\000\000\ +\000\000\000\000\000\000\080\001\086\001\087\001\088\001\089\001\ +\090\001\081\001\082\001\000\000\083\001\000\000\000\000\000\000\ +\043\002\000\000\043\002\043\002\043\002\084\001\043\002\091\001\ +\000\000\043\002\043\002\000\000\186\000\000\000\085\001\000\000\ +\000\000\092\001\093\001\000\000\086\001\087\001\088\001\089\001\ +\090\001\000\000\043\002\000\000\094\001\095\001\096\001\097\001\ +\098\001\000\000\043\002\043\002\000\000\042\004\000\000\091\001\ +\000\000\000\000\043\002\000\000\186\000\000\000\100\001\000\000\ +\000\000\092\001\093\001\000\000\000\000\000\000\043\002\043\002\ +\045\004\078\001\079\001\000\000\094\001\095\001\096\001\097\001\ +\098\001\080\001\000\000\000\000\000\000\000\000\044\004\081\001\ +\082\001\000\000\083\001\000\000\000\000\000\000\100\001\000\000\ +\000\000\000\000\000\000\084\001\000\000\000\000\000\000\000\000\ +\041\004\078\001\079\001\000\000\085\001\000\000\000\000\000\000\ +\000\000\080\001\086\001\087\001\088\001\089\001\090\001\081\001\ +\082\001\000\000\083\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\084\001\000\000\091\001\000\000\000\000\ +\000\000\000\000\186\000\000\000\085\001\000\000\000\000\092\001\ +\093\001\000\000\086\001\087\001\088\001\089\001\090\001\000\000\ +\000\000\000\000\094\001\095\001\096\001\097\001\098\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\091\001\046\004\000\000\ +\000\000\000\000\186\000\000\000\100\001\000\000\000\000\092\001\ +\093\001\000\000\000\000\000\000\000\000\000\000\043\004\078\001\ +\079\001\000\000\094\001\095\001\096\001\097\001\098\001\080\001\ +\000\000\000\000\000\000\099\004\000\000\081\001\082\001\000\000\ +\083\001\000\000\000\000\000\000\100\001\000\000\000\000\000\000\ +\000\000\084\001\000\000\000\000\000\000\000\000\045\004\078\001\ +\079\001\000\000\085\001\000\000\000\000\000\000\000\000\080\001\ +\086\001\087\001\088\001\089\001\090\001\081\001\082\001\000\000\ +\083\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\084\001\000\000\091\001\000\000\000\000\000\000\000\000\ +\186\000\000\000\085\001\000\000\000\000\092\001\093\001\000\000\ +\086\001\087\001\088\001\089\001\090\001\000\000\000\000\000\000\ +\094\001\095\001\096\001\097\001\098\001\000\000\000\000\000\000\ +\000\000\000\000\100\004\091\001\000\000\000\000\000\000\000\000\ +\186\000\000\000\100\001\000\000\000\000\092\001\093\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\094\001\095\001\096\001\097\001\098\001\081\005\078\001\079\001\ +\000\000\000\000\000\000\000\000\101\004\000\000\080\001\000\000\ +\000\000\000\000\100\001\000\000\081\001\082\001\000\000\083\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\084\001\000\000\000\000\000\000\000\000\083\005\078\001\079\001\ +\000\000\085\001\000\000\000\000\000\000\000\000\080\001\086\001\ +\087\001\088\001\089\001\090\001\081\001\082\001\000\000\083\001\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\084\001\000\000\091\001\000\000\000\000\000\000\000\000\186\000\ +\000\000\085\001\000\000\000\000\092\001\093\001\000\000\086\001\ +\087\001\088\001\089\001\090\001\000\000\000\000\000\000\094\001\ +\095\001\096\001\097\001\098\001\000\000\000\000\000\000\000\000\ +\082\005\000\000\091\001\000\000\000\000\000\000\000\000\186\000\ +\000\000\100\001\000\000\000\000\092\001\093\001\000\000\000\000\ +\000\000\000\000\000\000\085\005\078\001\079\001\000\000\094\001\ +\095\001\096\001\097\001\098\001\080\001\000\000\000\000\000\000\ +\000\000\084\005\081\001\082\001\000\000\083\001\000\000\000\000\ +\000\000\100\001\000\000\000\000\000\000\000\000\084\001\000\000\ +\000\000\000\000\000\000\081\005\078\001\079\001\000\000\085\001\ +\000\000\000\000\000\000\000\000\080\001\086\001\087\001\088\001\ +\089\001\090\001\081\001\082\001\000\000\083\001\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\084\001\000\000\ +\091\001\000\000\000\000\000\000\000\000\186\000\000\000\085\001\ +\000\000\000\000\092\001\093\001\000\000\086\001\087\001\088\001\ +\089\001\090\001\000\000\000\000\000\000\094\001\095\001\096\001\ +\097\001\098\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\091\001\086\005\000\000\000\000\000\000\186\000\000\000\100\001\ +\000\000\000\000\092\001\093\001\000\000\000\000\000\000\000\000\ +\000\000\083\005\078\001\079\001\000\000\094\001\095\001\096\001\ +\097\001\098\001\080\001\000\000\000\000\000\000\106\005\000\000\ +\081\001\082\001\000\000\083\001\000\000\000\000\000\000\100\001\ +\000\000\000\000\000\000\000\000\084\001\000\000\000\000\000\000\ +\000\000\085\005\078\001\079\001\000\000\085\001\000\000\000\000\ +\000\000\000\000\080\001\086\001\087\001\088\001\089\001\090\001\ +\081\001\082\001\000\000\083\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\084\001\000\000\091\001\000\000\ +\000\000\000\000\000\000\186\000\000\000\085\001\000\000\000\000\ +\092\001\093\001\000\000\086\001\087\001\088\001\089\001\090\001\ +\000\000\000\000\000\000\094\001\095\001\096\001\097\001\098\001\ +\000\000\000\000\000\000\000\000\000\000\107\005\091\001\078\001\ +\079\001\000\000\000\000\186\000\000\000\100\001\000\000\080\001\ +\092\001\093\001\000\000\000\000\000\000\081\001\082\001\000\000\ +\083\001\000\000\000\000\094\001\095\001\096\001\097\001\098\001\ +\000\000\084\001\000\000\000\000\000\000\000\000\000\000\108\005\ +\000\000\000\000\085\001\000\000\000\000\100\001\000\000\000\000\ +\086\001\087\001\088\001\089\001\090\001\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\091\001\078\001\079\001\000\000\000\000\ +\186\000\000\000\000\000\000\000\080\001\092\001\093\001\000\000\ +\000\000\000\000\081\001\082\001\000\000\083\001\000\000\000\000\ +\094\001\095\001\096\001\097\001\098\001\000\000\084\001\000\000\ +\000\000\000\000\000\000\000\000\000\000\099\001\000\000\085\001\ +\000\000\000\000\100\001\000\000\000\000\086\001\087\001\088\001\ +\089\001\090\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\091\001\078\001\079\001\000\000\000\000\186\000\000\000\000\000\ +\000\000\080\001\092\001\093\001\000\000\000\000\000\000\081\001\ +\082\001\000\000\083\001\000\000\000\000\094\001\095\001\096\001\ +\097\001\098\001\000\000\084\001\000\000\000\000\031\004\000\000\ +\000\000\078\001\079\001\000\000\085\001\000\000\000\000\100\001\ +\000\000\080\001\086\001\087\001\088\001\089\001\090\001\081\001\ +\082\001\000\000\083\001\000\000\000\000\000\000\000\000\000\000\ +\000\000\138\004\000\000\084\001\000\000\091\001\000\000\000\000\ +\000\000\000\000\186\000\000\000\085\001\000\000\000\000\092\001\ +\093\001\000\000\086\001\087\001\088\001\089\001\090\001\000\000\ +\000\000\000\000\094\001\095\001\096\001\097\001\098\001\000\000\ +\000\000\000\000\000\000\093\004\000\000\091\001\078\001\079\001\ +\000\000\000\000\186\000\000\000\100\001\000\000\080\001\092\001\ +\093\001\000\000\000\000\000\000\081\001\082\001\000\000\083\001\ +\000\000\000\000\094\001\095\001\096\001\097\001\098\001\000\000\ +\084\001\000\000\000\000\000\000\000\000\000\000\240\000\240\000\ +\000\000\085\001\000\000\000\000\100\001\000\000\240\000\086\001\ +\087\001\088\001\089\001\090\001\240\000\240\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\240\000\000\000\091\001\000\000\000\000\000\000\000\000\186\000\ +\000\000\240\000\000\000\000\000\092\001\093\001\000\000\240\000\ +\240\000\240\000\240\000\240\000\000\000\000\000\000\000\094\001\ +\095\001\096\001\097\001\098\001\000\000\000\000\000\000\000\000\ +\000\000\000\000\240\000\078\001\079\001\000\000\000\000\240\000\ +\000\000\100\001\000\000\080\001\240\000\240\000\000\000\000\000\ +\000\000\081\001\000\000\000\000\000\000\000\000\000\000\240\000\ +\240\000\240\000\240\000\240\000\000\000\084\001\000\000\000\000\ +\240\000\000\000\000\000\078\001\079\001\000\000\085\001\000\000\ +\000\000\240\000\000\000\000\000\086\001\087\001\088\001\089\001\ +\090\001\081\001\000\000\000\000\000\000\000\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\084\001\000\000\091\001\ +\000\000\000\000\000\000\000\000\186\000\000\000\085\001\000\000\ +\000\000\092\001\093\001\000\000\086\001\087\001\088\001\089\001\ +\090\001\094\000\000\000\000\000\094\001\095\001\096\001\097\001\ +\098\001\000\000\000\000\000\000\000\000\000\000\000\000\091\001\ +\095\000\016\000\000\000\000\000\186\000\000\000\100\001\000\000\ +\000\000\092\001\093\001\000\000\000\000\096\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\095\001\096\001\097\001\ +\098\001\000\000\000\000\136\000\000\000\137\000\138\000\030\000\ +\031\000\139\000\000\000\000\000\140\000\141\000\100\001\000\000\ +\035\000\000\000\000\000\000\000\000\000\000\000\097\000\000\000\ +\000\000\000\000\000\000\000\000\042\000\142\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\143\000\144\000\000\000\ +\000\000\000\000\000\000\000\000\098\000\145\000\000\000\000\000\ +\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ +\099\000\146\000\147\000\053\000" + +let yycheck = "\009\000\ +\210\000\145\000\012\000\002\000\014\000\015\000\016\000\136\000\ +\199\000\019\000\020\000\021\000\022\000\023\000\002\000\025\000\ +\163\000\132\001\142\000\205\000\136\000\163\002\032\000\202\000\ +\002\000\123\001\036\000\002\000\202\000\039\000\040\000\041\000\ +\011\000\001\000\034\003\002\000\010\000\024\001\010\002\049\000\ +\050\000\027\000\136\000\053\000\054\000\139\000\002\000\026\000\ +\002\000\138\000\002\000\234\003\163\002\002\000\038\003\253\002\ +\098\000\157\000\221\000\029\000\223\000\105\002\003\000\004\000\ +\186\003\225\002\045\000\063\004\110\000\000\000\170\000\115\004\ +\194\003\063\003\003\000\004\000\031\000\006\000\046\000\241\004\ +\035\000\056\005\201\004\063\005\094\000\095\000\096\000\097\000\ +\131\000\099\000\133\000\003\000\008\001\001\000\134\001\003\000\ +\004\000\141\002\000\000\098\000\054\001\003\003\021\001\000\001\ +\083\000\034\000\085\000\086\000\058\000\110\002\098\000\110\000\ +\067\005\214\004\203\000\000\000\000\001\003\005\000\001\042\002\ +\098\000\127\002\110\000\098\000\017\001\240\001\010\001\164\001\ +\000\001\166\001\005\000\098\000\110\000\074\001\192\004\110\000\ +\000\001\056\001\046\000\149\000\007\001\110\004\098\000\110\000\ +\098\000\000\001\098\000\121\000\000\001\098\000\058\000\161\000\ +\162\000\139\000\110\000\000\001\110\000\008\001\110\000\000\000\ +\087\004\110\000\244\004\173\000\014\001\000\001\052\005\108\001\ +\226\004\000\001\144\000\077\005\060\001\066\001\000\000\001\005\ +\092\001\006\001\188\000\030\001\103\002\008\001\157\005\000\001\ +\066\001\004\001\127\000\197\000\129\000\008\001\131\000\073\001\ +\133\000\000\001\066\001\092\001\015\001\099\003\133\001\018\001\ +\129\000\000\000\066\001\030\001\055\001\000\001\037\001\162\005\ +\092\001\073\001\189\000\095\001\094\001\214\002\065\001\008\001\ +\000\001\129\000\224\002\127\000\014\001\129\000\094\001\131\000\ +\115\001\133\000\000\001\206\000\055\001\079\001\094\001\186\000\ +\187\000\115\001\203\004\121\005\091\001\030\001\065\001\091\001\ +\095\001\000\001\036\001\027\001\130\005\000\001\091\001\066\001\ +\107\002\108\002\095\001\115\001\054\005\027\001\073\001\106\001\ +\101\005\237\005\109\001\094\001\008\001\000\001\055\001\092\001\ +\095\001\017\001\121\003\196\000\022\001\023\001\064\001\000\000\ +\065\001\000\001\197\001\204\000\027\001\094\001\123\005\106\001\ +\027\001\008\001\109\001\109\005\143\002\151\004\022\001\094\001\ +\154\004\005\003\044\001\000\001\000\001\055\001\113\001\067\001\ +\091\001\204\001\037\001\206\001\202\003\095\001\064\001\097\001\ +\058\001\193\001\029\001\091\001\176\001\063\001\094\001\095\001\ +\231\001\106\001\000\001\109\001\109\001\091\001\027\001\157\001\ +\074\001\095\001\000\001\000\001\192\001\022\001\164\001\050\001\ +\166\001\252\001\046\003\217\003\091\001\010\001\001\002\173\001\ +\174\001\087\003\088\003\094\001\027\001\040\006\094\001\094\001\ +\092\001\236\001\130\002\094\001\102\001\027\001\188\001\105\001\ +\154\005\107\001\000\001\109\001\095\001\111\001\094\001\038\002\ +\205\005\163\005\033\005\034\005\151\001\115\003\153\001\019\001\ +\155\001\021\001\215\005\000\001\071\001\000\000\048\002\008\001\ +\164\005\000\001\072\001\160\002\026\001\024\001\091\001\091\001\ +\057\001\015\006\095\001\141\001\107\006\143\001\120\001\066\001\ +\255\005\066\001\117\001\118\001\069\001\026\001\121\001\000\001\ +\123\001\000\001\048\004\074\005\056\001\159\001\069\002\094\001\ +\094\001\010\001\015\001\000\001\035\001\091\001\000\001\092\001\ +\094\001\095\001\095\001\008\006\072\001\000\001\000\001\177\001\ +\178\001\014\001\099\001\000\001\017\001\000\001\103\001\081\006\ +\099\005\083\006\004\001\014\001\059\001\000\001\008\001\125\004\ +\000\001\064\001\065\001\173\001\174\001\015\001\092\001\000\001\ +\018\001\203\001\190\005\074\001\000\001\003\001\188\004\103\004\ +\210\001\000\001\088\006\092\001\214\001\004\001\105\001\092\001\ +\027\001\008\001\151\001\010\001\153\001\058\006\155\001\014\001\ +\000\001\227\001\228\001\018\001\099\001\076\004\232\001\027\001\ +\234\001\008\001\010\001\000\001\027\001\000\001\109\001\066\001\ +\062\001\094\001\000\001\092\001\091\001\000\001\095\001\007\000\ +\066\001\251\001\000\001\151\001\000\001\153\001\032\002\155\001\ +\171\005\094\001\004\001\039\006\094\001\007\002\008\001\009\002\ +\010\002\000\001\000\001\094\001\094\001\015\001\091\001\000\001\ +\018\001\092\001\095\001\055\004\052\003\241\003\193\005\000\001\ +\091\001\000\001\073\001\004\001\095\001\035\001\094\001\008\001\ +\017\001\010\001\018\001\092\001\004\001\014\001\040\002\091\001\ +\000\001\032\002\094\001\095\001\091\001\092\001\221\005\094\001\ +\095\001\027\002\027\001\190\002\032\002\059\001\014\001\000\001\ +\172\002\173\002\064\001\065\001\092\001\092\001\032\002\095\001\ +\066\001\032\002\113\001\000\001\074\001\000\001\091\001\103\003\ +\091\001\032\002\160\002\231\001\095\001\109\003\070\005\171\002\ +\094\001\002\001\253\002\094\001\032\002\003\001\032\002\091\001\ +\032\002\036\002\056\002\032\002\038\003\099\001\028\005\073\002\ +\073\001\000\001\066\001\022\001\091\001\072\002\000\001\109\001\ +\094\001\065\001\066\001\010\001\014\001\094\001\094\001\113\001\ +\074\002\075\002\091\001\092\001\151\002\094\001\095\001\094\001\ +\003\001\018\001\042\002\038\003\047\001\000\001\229\004\129\002\ +\038\003\004\001\132\002\053\003\134\002\008\001\094\001\010\001\ +\113\001\004\001\000\001\014\001\022\001\027\001\008\001\018\001\ +\230\002\066\001\232\002\092\001\164\000\165\000\017\002\018\002\ +\027\001\100\002\018\001\076\002\064\001\107\004\000\001\092\001\ +\014\001\177\000\178\000\094\001\250\002\032\002\015\001\159\005\ +\008\001\069\002\036\001\022\001\018\001\205\003\097\001\098\001\ +\018\001\076\003\170\005\078\003\066\001\183\002\090\001\103\002\ +\019\001\201\000\003\001\073\001\094\001\092\001\111\002\112\002\ +\115\001\019\001\092\001\092\001\036\001\094\001\073\001\201\002\ +\192\005\203\002\110\001\205\002\066\001\237\003\073\001\209\002\ +\090\001\008\001\068\006\065\001\066\001\048\001\180\002\018\001\ +\091\001\092\001\151\002\094\001\095\001\083\001\048\001\049\001\ +\049\003\060\001\092\001\018\001\092\001\115\001\066\003\233\002\ +\018\001\068\001\060\001\070\001\200\004\062\003\113\001\090\001\ +\094\001\027\002\068\001\018\001\070\001\094\001\092\001\146\003\ +\094\001\022\001\242\005\151\002\092\001\255\002\134\003\133\005\ +\232\005\172\003\004\003\005\003\000\000\012\001\172\003\008\001\ +\214\004\001\006\118\003\022\001\067\001\015\003\130\003\017\003\ +\251\003\036\001\253\003\254\003\111\001\113\003\000\001\027\001\ +\031\001\022\001\028\003\029\003\060\004\111\001\133\005\073\002\ +\118\003\092\001\088\001\067\004\065\001\039\003\215\002\216\002\ +\000\001\019\001\248\004\050\001\046\003\092\001\006\003\170\002\ +\026\001\220\003\047\001\027\001\094\001\139\003\220\003\057\003\ +\000\000\015\001\112\001\022\001\030\001\238\002\066\001\186\002\ +\071\001\094\001\067\001\031\005\102\003\060\003\048\001\049\001\ +\022\001\196\002\000\001\252\002\095\001\084\001\080\003\090\001\ +\060\003\065\001\060\001\047\005\187\005\055\001\189\005\065\001\ +\014\001\019\001\068\001\017\001\070\001\000\001\101\001\065\001\ +\022\001\047\001\100\003\014\001\022\004\027\001\065\001\014\001\ +\064\001\065\001\006\003\014\001\066\001\000\001\017\001\102\003\ +\027\001\004\001\237\002\022\001\027\001\008\001\094\001\014\001\ +\027\001\047\001\102\003\014\001\015\001\109\001\128\003\018\001\ +\092\005\131\003\004\001\133\003\102\003\111\001\008\001\102\003\ +\106\001\067\001\003\001\109\001\047\001\107\003\144\003\102\003\ +\018\001\177\004\148\003\097\001\098\001\070\003\064\001\101\005\ +\066\001\155\003\102\003\027\001\102\003\159\003\102\003\000\001\ +\126\003\102\003\083\003\015\001\079\001\091\001\018\001\117\005\ +\079\001\095\001\065\001\097\001\098\001\123\005\088\001\066\001\ +\066\006\067\006\047\001\181\003\196\001\064\001\184\003\215\004\ +\091\001\035\001\188\003\003\001\095\001\115\001\097\001\098\001\ +\066\001\225\004\066\001\110\004\064\001\065\001\112\001\073\001\ +\110\004\000\001\069\003\094\001\022\001\221\001\222\001\223\001\ +\115\001\059\001\125\004\213\003\022\001\229\001\066\001\065\001\ +\030\001\139\004\092\001\022\001\019\001\004\001\082\004\064\001\ +\065\001\008\001\109\001\026\001\097\001\098\001\014\001\014\001\ +\015\001\090\001\124\006\018\001\066\001\067\001\240\003\241\003\ +\096\001\055\001\110\001\073\001\000\001\005\002\115\001\065\001\ +\250\003\048\001\252\003\065\001\102\001\110\001\176\004\205\005\ +\206\005\067\001\022\001\109\001\000\001\060\001\065\001\096\001\ +\004\001\215\005\012\004\014\001\008\001\068\001\010\001\070\001\ +\035\001\033\002\014\001\015\001\197\003\198\003\018\001\035\001\ +\027\001\065\001\066\001\066\001\027\001\115\001\116\004\027\001\ +\203\004\035\001\211\003\212\003\106\001\203\004\216\004\109\001\ +\059\001\218\003\132\005\009\004\060\002\065\001\065\001\059\001\ +\000\001\051\004\227\003\053\004\064\001\065\001\000\001\094\001\ +\111\001\059\001\008\006\061\004\000\001\091\001\074\001\065\001\ +\004\001\095\001\030\001\066\001\008\001\071\004\066\001\000\000\ +\066\001\019\001\026\001\015\001\079\001\073\001\018\001\073\001\ +\026\001\220\004\084\004\102\001\055\001\000\001\209\003\099\001\ +\064\001\065\001\109\001\055\001\094\001\064\001\217\003\091\001\ +\092\001\109\001\094\001\095\001\102\001\065\001\048\001\049\001\ +\064\001\014\001\229\003\109\001\058\006\111\001\005\000\077\004\ +\007\000\028\005\060\001\075\001\008\001\113\001\027\001\065\001\ +\035\001\115\001\068\001\244\004\070\001\248\003\066\001\000\001\ +\031\001\064\001\027\001\023\001\059\005\109\001\112\004\035\003\ +\244\004\116\005\030\001\105\004\142\004\112\001\106\001\145\004\ +\059\001\109\001\073\005\050\001\127\005\064\001\065\001\051\003\ +\112\001\026\001\094\001\055\003\065\001\000\001\244\004\074\001\ +\162\004\053\001\164\004\055\001\166\004\111\001\168\004\169\004\ +\064\001\066\001\055\001\173\004\099\005\065\001\109\001\191\002\ +\178\004\008\001\180\004\064\001\182\004\004\001\184\004\026\001\ +\099\001\008\001\086\003\064\001\065\001\004\001\206\002\207\002\ +\023\001\008\001\109\001\018\001\061\005\022\001\200\004\030\001\ +\015\001\097\001\123\004\018\001\027\001\064\001\127\004\066\001\ +\108\004\061\005\125\005\132\004\027\001\109\001\106\001\125\005\ +\075\001\109\001\014\001\066\001\222\004\017\001\053\001\014\001\ +\055\001\227\004\242\002\112\001\149\004\150\004\145\005\061\005\ +\030\001\235\004\065\001\145\005\053\001\158\004\055\001\056\001\ +\065\001\136\000\169\005\066\001\139\000\247\004\141\000\142\000\ +\065\001\027\001\252\004\066\001\050\001\112\001\000\005\106\006\ +\002\005\066\001\004\005\126\004\181\004\007\005\109\001\130\004\ +\191\005\000\001\064\001\065\001\000\001\164\000\165\000\008\001\ +\167\000\065\001\083\001\106\001\022\005\064\001\109\001\064\001\ +\026\005\073\001\177\000\178\000\019\001\031\005\004\001\019\001\ +\066\001\235\005\008\001\026\001\109\001\008\005\026\001\210\005\ +\035\001\015\001\027\001\108\001\210\005\047\005\048\005\101\001\ +\050\005\028\001\201\000\202\000\106\001\027\001\205\000\109\001\ +\179\004\048\001\049\001\088\001\048\001\232\005\014\001\065\005\ +\059\001\066\001\232\005\190\004\109\001\060\001\065\001\000\001\ +\060\001\100\001\003\001\027\001\212\005\068\001\000\000\070\001\ +\068\001\066\001\070\001\112\001\013\001\014\001\027\001\066\001\ +\017\001\091\005\092\005\027\001\066\001\094\001\022\001\074\001\ +\098\005\026\001\027\001\028\001\029\001\080\001\000\001\003\005\ +\083\001\045\001\046\001\102\001\029\005\064\001\112\005\040\001\ +\041\001\065\001\109\001\066\001\111\001\035\001\003\001\047\001\ +\111\001\019\001\043\005\111\001\045\005\066\001\128\005\037\001\ +\026\001\145\003\066\001\060\001\083\001\088\001\063\001\022\001\ +\065\001\066\001\067\001\068\001\064\001\059\001\144\005\083\001\ +\073\001\074\001\064\001\065\001\064\001\151\005\048\001\080\001\ +\052\005\000\001\064\001\040\001\074\001\112\001\109\001\161\005\ +\100\001\132\005\060\001\092\001\166\005\094\001\000\001\096\001\ +\097\001\067\001\068\001\236\003\070\001\035\001\041\005\000\001\ +\066\001\155\005\180\005\108\001\158\005\099\001\111\001\199\003\ +\023\001\109\001\115\001\018\001\064\001\066\001\037\001\109\001\ +\026\001\109\001\019\001\004\004\063\005\059\001\200\005\075\001\ +\000\001\026\001\064\001\065\001\094\001\207\005\064\001\000\001\ +\224\003\225\003\226\003\213\005\074\001\111\001\230\003\136\005\ +\218\005\219\005\000\001\019\001\236\003\121\005\224\005\048\001\ +\049\001\227\005\026\001\027\001\010\001\053\001\130\005\055\001\ +\000\000\026\001\236\005\060\001\112\001\099\001\240\005\134\001\ +\064\001\065\001\244\005\068\001\004\004\070\001\064\001\109\001\ +\048\001\049\001\004\001\109\001\230\005\231\005\008\001\233\005\ +\234\005\022\001\000\001\003\001\060\001\015\001\157\001\009\006\ +\018\001\064\001\112\001\067\001\068\001\164\001\070\001\166\001\ +\090\001\027\001\064\001\040\001\143\005\012\006\173\001\174\001\ +\064\001\176\001\149\005\064\001\065\001\109\001\111\001\022\001\ +\012\006\000\001\071\001\109\001\110\001\188\001\035\001\037\001\ +\040\001\192\001\044\006\045\006\167\005\196\001\197\001\084\001\ +\225\005\051\006\052\006\053\006\054\006\090\001\109\001\111\001\ +\066\001\059\006\033\001\026\001\075\001\063\006\059\001\109\001\ +\110\001\022\001\016\001\069\006\065\001\109\001\221\001\222\001\ +\223\001\110\001\000\000\077\006\078\006\027\001\229\001\202\005\ +\055\001\004\001\037\001\040\001\059\001\008\001\064\001\095\001\ +\063\001\064\001\065\001\066\001\015\001\095\006\096\006\018\001\ +\076\000\112\001\100\006\064\001\102\006\252\001\253\001\078\001\ +\025\006\102\001\001\002\085\006\110\006\064\001\005\002\113\006\ +\109\001\008\002\035\006\015\006\064\001\022\001\053\001\097\001\ +\055\001\123\006\017\002\018\002\064\001\127\006\027\001\105\006\ +\108\000\064\001\065\001\109\001\134\006\135\006\109\001\040\001\ +\033\001\032\002\033\002\064\001\064\001\119\006\120\006\066\001\ +\109\001\125\000\000\000\042\002\095\001\000\001\064\001\065\001\ +\132\000\048\002\075\006\000\001\064\001\071\001\055\001\095\001\ +\066\001\109\001\059\001\013\001\031\006\060\002\063\001\064\001\ +\065\001\109\001\084\001\000\001\093\006\066\001\109\001\042\006\ +\090\001\083\001\028\001\029\001\073\001\078\001\064\001\091\001\ +\109\001\109\001\037\001\016\002\088\006\022\001\019\001\041\001\ +\037\001\075\001\023\002\109\001\110\001\026\001\027\001\066\006\ +\067\006\094\001\108\001\066\001\000\000\072\006\073\006\128\006\ +\103\002\091\001\060\001\000\001\109\001\063\001\047\001\082\006\ +\079\001\040\001\068\001\048\001\049\001\022\001\115\001\000\001\ +\074\001\055\001\000\001\094\006\066\001\059\001\080\001\060\001\ +\000\001\063\001\064\001\130\002\004\001\026\001\067\001\068\001\ +\008\001\070\001\010\001\066\001\111\006\083\001\014\001\015\001\ +\078\001\026\001\018\001\094\001\026\001\000\000\121\006\094\001\ +\090\001\124\006\108\001\027\001\000\001\111\001\093\001\130\006\ +\131\006\160\002\109\001\110\001\163\002\053\001\054\001\055\001\ +\056\001\031\001\169\002\170\002\110\001\172\002\173\002\109\001\ +\064\001\065\001\111\001\000\001\093\001\055\001\026\001\000\001\ +\033\001\059\001\066\001\186\002\050\001\063\001\064\001\077\001\ +\191\002\010\001\066\001\004\001\109\001\196\002\019\001\008\001\ +\080\001\073\001\094\001\083\001\078\001\026\001\055\001\206\002\ +\207\002\018\001\059\001\071\001\064\001\065\001\063\001\064\001\ +\065\001\109\001\027\001\091\001\092\001\109\001\094\001\095\001\ +\084\001\065\001\000\001\048\001\049\001\078\001\004\001\230\002\ +\093\001\232\002\008\001\109\001\010\001\003\001\237\002\060\001\ +\014\001\113\001\093\001\242\002\018\001\073\001\067\001\068\001\ +\109\001\070\001\064\001\250\002\251\002\027\001\253\002\000\000\ +\009\000\065\001\109\001\012\000\109\001\014\000\015\000\016\000\ +\007\003\073\001\019\000\020\000\021\000\022\000\023\000\004\001\ +\025\000\064\001\065\001\008\001\014\001\065\001\066\001\017\001\ +\004\001\014\001\015\001\036\000\008\001\018\001\039\000\040\000\ +\041\000\027\001\111\001\064\001\066\001\092\001\018\001\038\003\ +\049\000\050\000\000\001\073\001\053\000\054\000\004\001\027\001\ +\066\001\008\001\008\001\014\001\010\001\052\003\053\003\073\001\ +\014\001\015\001\095\001\004\001\065\001\091\001\092\001\008\001\ +\094\001\095\001\071\001\016\001\152\001\027\001\069\003\000\001\ +\036\001\022\001\000\000\000\001\094\001\066\001\027\001\084\001\ +\073\001\010\001\027\001\113\001\014\001\094\000\095\000\096\000\ +\097\000\022\001\099\000\090\001\000\000\109\001\019\001\004\001\ +\014\001\115\001\022\001\008\001\000\001\026\001\000\001\003\001\ +\103\003\095\001\015\001\095\001\066\001\018\001\109\003\055\001\ +\010\001\013\001\092\001\073\001\103\001\017\001\027\001\118\003\ +\066\001\067\001\121\003\048\001\049\001\014\001\026\001\027\001\ +\028\001\029\001\022\001\130\003\027\001\091\001\092\001\060\001\ +\094\001\095\001\064\001\065\001\139\003\041\001\067\001\068\001\ +\092\001\070\001\145\003\173\001\174\001\000\001\092\001\091\001\ +\161\000\162\000\109\001\113\001\092\001\066\001\092\001\053\001\ +\060\001\055\001\013\001\063\001\255\001\000\002\017\001\067\001\ +\068\001\014\001\109\001\065\001\094\001\172\003\074\001\026\001\ +\027\001\028\001\029\001\094\001\080\001\053\001\010\002\055\001\ +\115\001\020\001\111\001\053\001\197\000\055\001\041\001\004\001\ +\092\001\065\001\094\001\008\001\096\001\097\001\109\001\065\001\ +\199\003\053\001\015\001\055\001\046\001\018\001\205\003\115\001\ +\108\001\060\001\209\003\111\001\063\001\065\001\062\001\066\001\ +\067\001\068\001\217\003\109\001\219\003\220\003\073\001\074\001\ +\108\001\224\003\225\003\226\003\109\001\080\001\229\003\230\003\ +\053\001\109\001\055\001\234\003\022\001\236\003\237\003\002\001\ +\073\001\092\001\100\001\094\001\065\001\096\001\097\001\013\001\ +\000\000\248\003\065\001\066\001\067\001\066\001\073\001\000\001\ +\027\001\108\001\003\001\109\001\111\001\004\004\028\001\029\001\ +\115\001\015\001\092\001\064\001\013\001\022\001\023\001\094\001\ +\017\001\000\001\064\001\041\001\064\001\022\001\008\001\022\004\ +\065\001\026\001\027\001\028\001\029\001\109\001\040\001\018\001\ +\014\001\062\001\062\001\044\001\062\001\007\000\060\001\027\001\ +\041\001\000\000\092\001\094\001\064\001\079\001\068\001\064\001\ +\014\001\058\001\134\002\014\001\074\001\006\001\063\001\094\001\ +\026\000\073\001\080\001\060\001\109\001\060\004\063\001\095\001\ +\065\001\066\001\067\001\068\001\067\004\064\001\075\001\073\001\ +\073\001\074\001\096\001\090\001\022\001\076\004\092\001\080\001\ +\027\001\094\001\014\001\082\004\073\001\040\001\108\001\013\001\ +\087\004\111\001\094\001\092\001\000\001\094\001\027\001\096\001\ +\097\001\014\001\027\001\021\001\008\001\086\001\028\001\029\001\ +\064\001\013\001\064\001\108\001\107\004\108\004\111\001\110\004\ +\062\001\062\001\115\001\041\001\014\001\116\004\026\001\062\001\ +\028\001\029\001\062\001\062\001\062\001\003\001\125\004\126\004\ +\014\001\086\001\064\001\130\004\027\001\041\001\060\001\091\001\ +\095\001\063\001\073\001\101\001\139\004\014\001\068\001\094\001\ +\027\001\027\001\094\001\014\001\074\001\094\001\000\000\088\001\ +\060\001\094\001\080\001\063\001\080\001\064\001\066\001\067\001\ +\068\001\027\001\073\001\014\001\020\001\015\001\074\001\022\001\ +\177\001\094\001\096\001\097\001\080\001\053\001\008\001\145\000\ +\065\001\176\004\177\004\073\001\179\004\062\001\108\001\062\001\ +\092\001\111\001\062\001\014\001\096\001\097\001\094\001\190\004\ +\112\001\163\000\164\000\165\000\112\001\167\000\094\001\073\001\ +\108\001\210\001\021\001\111\001\203\004\064\001\091\001\177\000\ +\178\000\037\003\073\001\053\001\054\001\055\001\056\001\214\004\ +\215\004\216\004\000\001\088\001\095\001\014\001\064\001\065\001\ +\094\001\014\001\225\004\014\001\056\003\014\001\229\004\201\000\ +\202\000\061\003\091\001\205\000\027\001\019\001\019\001\027\001\ +\112\001\088\001\241\004\022\001\026\001\244\004\014\001\014\001\ +\000\001\248\004\014\001\003\001\014\001\000\000\000\000\096\001\ +\084\003\096\001\001\005\092\001\003\005\013\001\008\001\109\001\ +\109\001\017\001\048\001\109\001\064\001\092\001\022\001\036\001\ +\090\001\036\001\026\001\027\001\028\001\029\001\060\001\036\001\ +\092\001\065\001\040\001\065\001\112\003\028\005\068\001\040\002\ +\070\001\041\001\033\005\034\005\064\001\094\001\036\001\064\001\ +\091\001\000\001\041\005\053\001\003\001\001\000\002\000\003\000\ +\004\000\005\000\006\000\007\000\060\001\052\005\013\001\063\001\ +\053\001\065\001\066\001\067\001\068\001\064\001\061\005\062\005\ +\063\005\073\001\074\001\026\001\064\001\028\001\029\001\064\001\ +\080\001\111\001\064\001\074\005\064\001\064\001\077\005\127\000\ +\099\003\040\001\041\001\210\005\092\001\000\000\094\001\008\005\ +\096\001\097\001\060\001\129\005\082\006\199\005\072\002\248\002\ +\190\003\145\001\145\005\183\003\108\001\060\001\101\005\111\001\ +\063\001\122\001\103\002\115\001\067\001\068\001\109\005\199\003\ +\230\001\165\000\190\002\074\001\064\001\065\001\117\005\018\005\ +\027\004\080\001\121\005\071\001\123\005\137\001\125\005\226\001\ +\103\004\077\001\232\002\130\005\188\001\092\001\133\005\133\005\ +\084\001\096\001\097\001\099\005\171\005\221\004\090\001\255\255\ +\143\005\115\001\145\005\255\255\255\255\108\001\149\005\255\255\ +\111\001\255\255\238\003\239\003\255\255\255\255\255\255\255\255\ +\255\255\109\001\110\001\013\001\255\255\255\255\255\255\255\255\ +\167\005\255\255\255\255\255\003\255\255\255\255\255\255\145\001\ +\255\255\255\255\028\001\029\001\255\255\255\255\255\255\255\255\ +\012\004\255\255\255\255\255\255\187\005\255\255\189\005\041\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\028\004\255\255\255\255\202\005\255\255\255\255\205\005\206\005\ +\255\255\000\001\060\001\210\005\255\255\063\001\255\255\255\255\ +\215\005\255\255\068\001\255\255\255\255\255\255\221\005\193\001\ +\074\001\255\255\196\001\197\001\019\001\255\255\080\001\255\255\ +\255\255\232\005\062\004\026\001\000\001\255\255\000\000\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\096\001\097\001\ +\255\255\255\255\255\255\221\001\222\001\223\001\255\255\019\001\ +\255\255\048\001\108\001\229\001\255\255\111\001\026\001\255\255\ +\255\255\008\006\236\001\255\255\255\255\060\001\255\255\255\255\ +\015\006\255\255\007\000\255\255\067\001\068\001\011\000\070\001\ +\255\255\109\004\252\001\253\001\048\001\049\001\255\255\001\002\ +\031\006\255\255\118\004\005\002\255\255\026\000\008\002\255\255\ +\060\001\255\255\255\255\042\006\255\255\255\255\016\002\067\001\ +\068\001\255\255\070\001\255\255\255\255\023\002\255\255\255\255\ +\045\000\255\255\255\255\058\006\255\255\255\255\255\255\033\002\ +\111\001\255\255\255\255\066\006\067\006\255\255\255\255\080\003\ +\042\002\072\006\073\006\255\255\255\255\255\255\048\002\255\255\ +\255\255\255\255\081\006\082\006\083\006\000\001\255\255\255\255\ +\003\001\088\006\060\002\111\001\255\255\063\002\083\000\094\006\ +\085\000\086\000\013\001\183\004\255\255\185\004\072\002\255\255\ +\019\001\000\001\255\255\255\255\255\255\255\255\255\255\026\001\ +\111\006\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\121\006\255\255\255\255\124\006\041\001\255\255\ +\255\255\255\255\255\255\130\006\131\006\103\002\255\255\255\255\ +\255\255\255\255\222\004\255\255\255\255\255\255\255\255\227\004\ +\255\255\060\001\255\255\255\255\063\001\255\255\000\000\255\255\ +\067\001\068\001\255\255\255\255\255\255\255\255\255\255\074\001\ +\055\001\255\255\057\001\058\001\059\001\080\001\061\001\255\255\ +\255\255\064\001\065\001\086\001\255\255\255\255\255\255\164\000\ +\165\000\092\001\167\000\255\255\255\255\096\001\097\001\255\255\ +\255\255\255\255\081\001\255\255\177\000\178\000\255\255\019\005\ +\255\255\108\001\089\001\090\001\111\001\255\255\255\255\255\255\ +\189\000\255\255\097\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\201\000\202\000\109\001\110\001\ +\255\255\206\000\255\255\255\255\190\002\191\002\255\255\051\005\ +\255\255\053\005\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\206\002\207\002\000\001\255\255\ +\002\001\003\001\004\001\071\005\255\255\255\255\008\001\075\005\ +\076\005\255\255\255\255\013\001\255\255\255\255\255\255\017\001\ +\018\001\019\001\255\255\255\255\255\255\231\002\090\005\255\255\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\255\255\ +\242\002\255\255\036\001\255\255\000\000\255\255\255\255\041\001\ +\255\255\251\002\255\255\253\002\112\005\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\007\003\255\255\255\255\ +\029\001\255\255\060\001\255\255\255\255\063\001\064\001\255\255\ +\066\001\067\001\068\001\255\255\070\001\255\255\255\255\073\001\ +\074\001\255\255\255\255\255\255\255\255\050\001\080\001\255\255\ +\255\255\255\255\036\003\255\255\038\003\255\255\255\255\255\255\ +\255\255\091\001\092\001\255\255\094\001\095\001\096\001\097\001\ +\255\255\255\255\100\001\053\003\255\255\255\255\255\255\171\005\ +\255\255\000\001\108\001\109\001\000\000\111\001\255\255\255\255\ +\180\005\115\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\019\001\193\005\255\255\255\255\ +\196\005\255\255\255\255\026\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\000\001\007\000\255\255\ +\117\001\118\001\255\255\255\255\121\001\255\255\123\001\255\255\ +\255\255\048\001\049\001\255\255\110\003\255\255\255\255\255\255\ +\019\001\229\005\255\255\255\255\000\000\060\001\000\001\026\001\ +\002\001\003\001\004\001\255\255\067\001\068\001\008\001\070\001\ +\255\255\255\255\255\255\013\001\134\003\255\255\255\255\017\001\ +\018\001\019\001\255\255\255\255\255\255\048\001\255\255\145\003\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\255\255\ +\255\255\060\001\036\001\255\255\255\255\255\255\255\255\041\001\ +\067\001\068\001\255\255\070\001\255\255\255\255\048\001\049\001\ +\111\001\255\255\172\003\255\255\255\255\255\255\255\255\196\001\ +\197\001\255\255\060\001\255\255\255\255\063\001\255\255\255\255\ +\066\001\067\001\068\001\255\255\070\001\255\255\255\255\073\001\ +\074\001\255\255\255\255\055\006\255\255\199\003\080\001\255\255\ +\221\001\222\001\223\001\255\255\111\001\255\255\255\255\255\255\ +\229\001\091\001\092\001\255\255\094\001\095\001\096\001\097\001\ +\255\255\219\003\220\003\255\255\255\255\255\255\224\003\225\003\ +\226\003\255\255\108\001\255\255\230\003\111\001\255\255\252\001\ +\253\001\115\001\236\003\255\255\001\002\255\255\255\255\255\255\ +\005\002\101\006\102\006\255\255\000\001\255\255\255\255\255\255\ +\255\255\109\006\255\255\164\000\165\000\255\255\167\000\255\255\ +\255\255\013\001\004\004\255\255\255\255\255\255\255\255\255\255\ +\177\000\178\000\255\255\255\255\033\002\129\006\026\001\255\255\ +\028\001\029\001\255\255\255\255\022\004\042\002\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\041\001\255\255\200\000\ +\201\000\202\000\007\000\255\255\255\255\255\255\011\000\060\002\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\060\001\255\255\255\255\072\002\054\004\026\000\066\001\067\001\ +\068\001\255\255\255\255\255\255\000\001\255\255\074\001\003\001\ +\255\255\255\255\255\255\255\255\080\001\255\255\255\255\255\255\ +\045\000\013\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\092\001\255\255\103\002\255\255\096\001\255\255\026\001\027\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\041\001\255\255\255\255\ +\255\255\000\000\108\004\255\255\110\004\255\255\083\000\255\255\ +\085\000\086\000\255\255\255\255\000\001\255\255\255\255\003\001\ +\060\001\255\255\255\255\125\004\008\001\255\255\255\255\067\001\ +\068\001\013\001\014\001\255\255\255\255\255\255\074\001\019\001\ +\255\255\139\004\022\001\255\255\080\001\255\255\026\001\007\000\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\092\001\255\255\094\001\068\001\096\001\041\001\255\255\255\255\ +\255\255\255\255\255\255\136\000\077\001\255\255\255\255\255\255\ +\108\001\255\255\191\002\111\001\255\255\255\255\176\004\255\255\ +\060\001\255\255\255\255\063\001\255\255\065\001\066\001\067\001\ +\068\001\206\002\207\002\006\001\255\255\008\001\074\001\164\000\ +\165\000\255\255\167\000\079\001\080\001\255\255\255\255\255\255\ +\255\255\203\004\255\255\255\255\177\000\178\000\255\255\255\255\ +\092\001\255\255\231\002\255\255\096\001\097\001\216\004\255\255\ +\189\000\255\255\220\004\255\255\255\255\242\002\255\255\255\255\ +\108\001\255\255\255\255\111\001\201\000\202\000\251\002\255\255\ +\253\002\206\000\255\255\255\255\055\001\255\255\057\001\058\001\ +\059\001\255\255\061\001\255\255\255\255\064\001\065\001\255\255\ +\255\255\255\255\255\255\000\001\255\255\255\255\255\255\255\255\ +\255\255\003\005\255\255\255\255\255\255\255\255\081\001\255\255\ +\013\001\255\255\255\255\255\255\255\255\006\001\089\001\090\001\ +\255\255\038\003\255\255\255\255\000\000\026\001\097\001\028\001\ +\029\001\255\255\028\005\196\001\197\001\255\255\255\255\255\255\ +\255\255\255\255\109\001\110\001\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\164\000\165\000\255\255\167\000\ +\255\255\255\255\052\005\220\001\221\001\222\001\223\001\060\001\ +\029\001\177\000\178\000\255\255\229\001\255\255\055\001\068\001\ +\057\001\058\001\059\001\255\255\061\001\074\001\015\001\064\001\ +\065\001\255\255\255\255\080\001\255\255\050\001\255\255\255\255\ +\255\255\201\000\202\000\252\001\253\001\255\255\255\255\255\255\ +\001\002\255\255\255\255\096\001\005\002\028\000\029\000\255\255\ +\255\255\090\001\043\001\044\001\045\001\046\001\015\002\108\001\ +\097\001\000\001\111\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\008\001\255\255\255\255\109\001\110\001\013\001\121\005\ +\033\002\066\001\255\255\125\005\145\003\255\255\071\001\072\001\ +\130\005\042\002\255\255\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\083\001\084\001\085\001\086\001\255\255\145\005\ +\117\001\118\001\041\001\060\002\121\001\255\255\123\001\172\003\ +\087\000\088\000\255\255\100\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\255\255\ +\255\255\255\255\199\003\074\001\255\255\255\255\255\255\255\255\ +\157\001\080\001\000\000\255\255\000\000\255\255\103\002\164\001\ +\255\255\166\001\255\255\255\255\255\255\092\001\219\003\220\003\ +\255\255\096\001\097\001\224\003\225\003\226\003\255\255\255\255\ +\210\005\230\003\212\005\255\255\255\255\108\001\255\255\236\003\ +\111\001\255\255\255\255\255\255\255\255\255\255\255\255\196\001\ +\197\001\255\255\255\255\255\255\255\255\255\255\232\005\255\255\ +\023\001\255\255\255\255\255\255\255\255\255\255\255\255\004\004\ +\134\001\243\005\255\255\255\255\255\255\036\001\255\255\255\255\ +\221\001\222\001\223\001\255\255\015\001\255\255\255\255\255\255\ +\229\001\255\255\255\255\255\255\255\255\007\006\255\255\255\255\ +\055\001\255\255\057\001\058\001\059\001\015\006\061\001\255\255\ +\018\006\064\001\065\001\255\255\000\001\255\255\191\002\252\001\ +\253\001\044\001\045\001\046\001\001\002\255\255\255\255\255\255\ +\005\002\013\001\255\255\255\255\255\255\206\002\207\002\255\255\ +\190\001\043\006\255\255\090\001\255\255\255\255\026\001\255\255\ +\028\001\029\001\097\001\255\255\071\001\072\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\033\002\041\001\109\001\110\001\ +\083\001\084\001\085\001\086\001\255\255\042\002\255\255\255\255\ +\255\255\242\002\255\255\255\255\196\001\197\001\255\255\255\255\ +\060\001\100\001\251\002\063\001\253\002\255\255\088\006\060\002\ +\068\001\110\004\255\255\255\255\255\255\255\255\074\001\255\255\ +\255\255\255\255\255\255\072\002\080\001\221\001\222\001\223\001\ +\125\004\255\255\255\255\255\255\255\255\229\001\230\001\255\255\ +\092\001\255\255\255\255\255\255\096\001\097\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\038\003\255\255\255\255\ +\108\001\255\255\103\002\111\001\252\001\253\001\255\255\255\255\ +\255\255\001\002\255\255\255\255\255\255\005\002\255\255\078\001\ +\079\001\080\001\081\001\082\001\083\001\084\001\085\001\086\001\ +\087\001\088\001\089\001\090\001\091\001\092\001\093\001\094\001\ +\095\001\096\001\097\001\098\001\000\000\100\001\255\255\255\255\ +\102\001\033\002\255\255\105\001\255\255\107\001\255\255\109\001\ +\255\255\111\001\042\002\114\001\255\255\255\255\203\004\255\255\ +\255\255\255\255\255\255\160\002\255\255\255\255\255\255\255\255\ +\127\001\255\255\255\255\255\255\060\002\255\255\255\255\013\001\ +\255\255\013\001\255\255\116\003\255\255\255\255\255\255\141\001\ +\255\255\143\001\255\255\255\255\255\255\255\255\028\001\029\001\ +\028\001\029\001\191\002\255\255\255\255\255\255\255\255\255\255\ +\255\255\159\001\255\255\041\001\255\255\041\001\255\255\255\255\ +\145\003\206\002\207\002\255\255\130\002\255\255\255\255\103\002\ +\255\255\000\000\255\255\008\005\255\255\255\255\060\001\255\255\ +\060\001\063\001\255\255\063\001\255\255\255\255\068\001\255\255\ +\068\001\255\255\255\255\172\003\074\001\255\255\074\001\028\005\ +\255\255\255\255\080\001\006\001\080\001\242\002\255\255\255\255\ +\255\255\255\255\255\255\169\002\255\255\255\255\251\002\255\255\ +\253\002\255\255\096\001\097\001\096\001\097\001\199\003\255\255\ +\255\255\255\255\015\001\255\255\255\255\255\255\108\001\255\255\ +\108\001\111\001\232\001\111\001\234\001\255\255\255\255\255\255\ +\255\255\255\255\219\003\220\003\255\255\255\255\223\003\224\003\ +\225\003\226\003\255\255\255\255\055\001\230\003\057\001\058\001\ +\059\001\038\003\061\001\236\003\255\255\064\001\065\001\191\002\ +\255\255\007\002\055\001\009\002\057\001\058\001\059\001\255\255\ +\061\001\255\255\255\255\064\001\065\001\255\255\206\002\207\002\ +\255\255\024\002\255\255\004\004\255\255\074\001\029\002\090\001\ +\255\255\255\255\255\255\255\255\081\001\255\255\097\001\255\255\ +\125\005\255\255\255\255\255\255\089\001\090\001\255\255\132\005\ +\255\255\094\001\109\001\110\001\097\001\255\255\255\255\255\255\ +\255\255\255\255\242\002\255\255\145\005\255\255\255\255\255\255\ +\109\001\110\001\255\255\251\002\255\255\253\002\255\255\255\255\ +\255\255\255\255\255\255\074\002\075\002\255\255\255\255\255\255\ +\255\255\118\003\255\255\255\255\255\255\255\255\123\003\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\052\003\255\255\ +\255\255\000\000\255\255\255\255\000\001\255\255\255\255\003\001\ +\255\255\255\255\255\255\255\255\145\003\255\255\038\003\110\002\ +\255\255\013\001\255\255\255\255\115\002\116\002\117\002\255\255\ +\255\255\255\255\255\255\255\255\255\255\210\005\026\001\027\001\ +\028\001\029\001\255\255\129\002\255\255\110\004\132\002\172\003\ +\255\255\255\255\255\255\255\255\255\255\041\001\255\255\255\255\ +\255\255\103\003\255\255\232\005\125\004\255\255\255\255\109\003\ +\255\255\255\255\255\255\255\255\255\255\255\255\243\005\255\255\ +\060\001\255\255\199\003\255\255\064\001\255\255\066\001\067\001\ +\068\001\255\255\255\255\255\255\255\255\073\001\074\001\255\255\ +\255\255\000\001\255\255\255\255\080\001\255\255\219\003\220\003\ +\255\255\255\255\255\255\224\003\225\003\226\003\013\001\255\255\ +\092\001\230\003\094\001\255\255\096\001\097\001\255\255\236\003\ +\100\001\255\255\255\255\026\001\255\255\028\001\029\001\255\255\ +\108\001\109\001\000\000\111\001\255\255\255\255\043\006\214\002\ +\255\255\145\003\041\001\255\255\219\002\220\002\221\002\004\004\ +\255\255\000\001\203\004\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\233\002\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\172\003\068\001\255\255\205\003\ +\255\255\255\255\255\255\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\002\003\255\255\255\255\004\003\255\255\ +\255\255\255\255\255\255\255\255\255\255\092\001\255\255\199\003\ +\255\255\096\001\097\001\018\003\234\003\255\255\255\255\237\003\ +\055\001\255\255\057\001\058\001\059\001\108\001\061\001\255\255\ +\111\001\064\001\065\001\219\003\220\003\074\004\255\255\255\255\ +\224\003\225\003\226\003\255\255\255\255\255\255\230\003\255\255\ +\255\255\255\255\081\001\028\005\236\003\255\255\255\255\255\255\ +\255\255\255\255\089\001\090\001\255\255\255\255\255\255\255\255\ +\000\000\255\255\097\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\110\004\255\255\255\255\004\004\108\001\109\001\110\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\125\004\255\255\255\255\255\255\255\255\255\255\255\255\094\003\ +\255\255\000\001\001\001\002\001\003\001\255\255\060\004\255\255\ +\255\255\008\001\009\001\010\001\255\255\067\004\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\255\255\ +\255\255\087\004\128\003\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\043\001\255\255\000\000\255\255\ +\255\255\048\001\049\001\255\255\125\005\107\004\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\061\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\203\004\070\001\ +\145\005\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\255\255\255\255\110\004\181\003\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\125\004\255\255\255\255\ +\103\001\255\255\105\001\255\255\203\003\108\001\255\255\244\004\ +\111\001\255\255\000\001\255\255\115\001\003\001\255\255\213\003\ +\255\255\255\255\008\001\177\004\255\255\255\255\255\255\013\001\ +\255\255\255\255\255\255\008\005\255\255\019\001\023\001\255\255\ +\255\255\210\005\255\255\255\255\026\001\255\255\028\001\029\001\ +\255\255\255\255\255\255\036\001\255\255\255\255\255\255\028\005\ +\255\255\255\255\255\255\041\001\250\003\255\255\252\003\232\005\ +\214\004\215\004\255\255\255\255\255\255\255\255\055\001\255\255\ +\057\001\058\001\059\001\225\004\061\001\255\255\060\001\064\001\ +\065\001\063\001\255\255\203\004\066\001\067\001\068\001\255\255\ +\061\005\255\255\255\255\241\004\074\001\255\255\255\255\255\255\ +\255\255\255\255\080\001\255\255\255\255\255\255\037\004\038\004\ +\039\004\090\001\255\255\255\255\000\000\255\255\092\001\255\255\ +\097\001\255\255\096\001\097\001\255\255\051\004\255\255\255\255\ +\255\255\255\255\255\255\255\255\109\001\110\001\108\001\255\255\ +\000\001\111\001\255\255\003\001\255\255\255\255\255\255\255\255\ +\255\255\071\004\255\255\033\005\034\005\013\001\014\001\255\255\ +\255\255\017\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\125\005\255\255\026\001\027\001\028\001\029\001\255\255\132\005\ +\255\255\096\004\097\004\098\004\028\005\255\255\255\255\255\255\ +\040\001\041\001\255\255\255\255\145\005\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\074\005\255\255\255\255\077\005\ +\255\255\255\255\255\255\255\255\060\001\255\255\255\255\063\001\ +\255\255\255\255\255\255\067\001\068\001\255\255\255\255\093\005\ +\094\005\073\001\074\001\138\004\255\255\255\255\000\001\101\005\ +\080\001\003\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\013\001\092\001\255\255\094\001\017\001\ +\096\001\097\001\255\255\255\255\255\255\123\005\255\255\255\255\ +\026\001\027\001\028\001\029\001\108\001\210\005\255\255\111\001\ +\255\255\000\000\255\255\115\001\255\255\255\255\180\004\041\001\ +\182\004\255\255\184\004\000\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\232\005\255\255\125\005\255\255\255\255\ +\255\255\255\255\060\001\255\255\255\255\063\001\205\004\206\004\ +\207\004\067\001\068\001\255\255\211\004\212\004\213\004\255\255\ +\074\001\145\005\255\255\255\255\255\255\255\255\080\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\092\001\255\255\094\001\235\004\096\001\097\001\ +\255\255\199\005\055\001\255\255\057\001\058\001\059\001\205\005\ +\061\001\247\004\108\001\064\001\065\001\111\001\255\255\255\255\ +\255\255\215\005\000\005\255\255\255\255\255\255\004\005\221\005\ +\255\255\255\255\255\255\255\255\081\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\089\001\090\001\255\255\255\255\ +\255\255\255\255\210\005\255\255\097\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\109\001\110\001\255\255\255\255\000\001\001\001\002\001\003\001\ +\232\005\255\255\008\006\255\255\008\001\009\001\010\001\255\255\ +\255\255\013\001\014\001\015\001\016\001\017\001\018\001\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\255\255\000\000\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\043\001\ +\044\001\045\001\046\001\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\058\006\255\255\255\255\255\255\ +\060\001\061\001\255\255\063\001\255\255\255\255\066\001\067\001\ +\068\001\255\255\070\001\071\001\072\001\073\001\074\001\255\255\ +\255\255\255\255\255\255\081\006\080\001\083\006\082\001\083\001\ +\084\001\085\001\086\001\255\255\255\255\255\255\255\255\091\001\ +\092\001\255\255\094\001\095\001\096\001\097\001\255\255\255\255\ +\100\001\255\255\255\255\103\001\255\255\105\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\115\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\166\005\255\255\255\255\255\255\013\001\255\255\255\255\255\255\ +\255\255\000\001\255\255\002\001\003\001\004\001\181\005\182\005\ +\183\005\008\001\255\255\028\001\029\001\255\255\013\001\000\000\ +\255\255\255\255\017\001\018\001\019\001\255\255\255\255\255\255\ +\041\001\255\255\200\005\026\001\027\001\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\036\001\255\255\213\005\ +\255\255\040\001\041\001\060\001\255\255\219\005\063\001\255\255\ +\255\255\048\001\049\001\068\001\255\255\255\255\255\255\255\255\ +\255\255\074\001\255\255\255\255\255\255\060\001\236\005\080\001\ +\063\001\255\255\255\255\066\001\067\001\068\001\244\005\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\096\001\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\108\001\091\001\092\001\111\001\094\001\ +\095\001\096\001\255\255\255\255\255\255\100\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\115\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\044\006\045\006\ +\255\255\255\255\255\255\000\000\255\255\051\006\052\006\053\006\ +\054\006\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\063\006\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\000\001\001\001\002\001\003\001\255\255\ +\078\006\006\001\007\001\008\001\009\001\010\001\011\001\012\001\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\022\001\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\030\001\031\001\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\046\001\047\001\048\001\049\001\050\001\051\001\255\255\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\060\001\ +\061\001\062\001\063\001\064\001\065\001\066\001\067\001\068\001\ +\255\255\070\001\071\001\072\001\073\001\074\001\255\255\076\001\ +\255\255\255\255\255\255\080\001\081\001\082\001\083\001\084\001\ +\085\001\086\001\087\001\255\255\089\001\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\097\001\098\001\255\255\100\001\ +\101\001\255\255\103\001\104\001\105\001\106\001\255\255\108\001\ +\109\001\255\255\111\001\255\255\255\255\255\255\115\001\000\001\ +\001\001\002\001\003\001\004\001\255\255\006\001\007\001\008\001\ +\009\001\010\001\011\001\012\001\013\001\014\001\015\001\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\030\001\031\001\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\043\001\044\001\045\001\046\001\047\001\048\001\ +\049\001\050\001\051\001\255\255\053\001\054\001\055\001\056\001\ +\255\255\255\255\059\001\060\001\061\001\255\255\063\001\064\001\ +\065\001\066\001\067\001\068\001\255\255\070\001\071\001\072\001\ +\073\001\074\001\255\255\076\001\255\255\255\255\255\255\080\001\ +\081\001\082\001\083\001\084\001\085\001\086\001\087\001\255\255\ +\089\001\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\097\001\098\001\255\255\100\001\101\001\255\255\103\001\104\001\ +\105\001\106\001\255\255\108\001\109\001\255\255\111\001\255\255\ +\255\255\255\255\115\001\000\001\001\001\002\001\003\001\255\255\ +\255\255\006\001\007\001\008\001\009\001\010\001\011\001\012\001\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\022\001\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\030\001\031\001\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\046\001\047\001\048\001\049\001\050\001\051\001\255\255\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\060\001\ +\061\001\255\255\063\001\064\001\065\001\066\001\067\001\068\001\ +\255\255\070\001\071\001\072\001\073\001\074\001\255\255\076\001\ +\255\255\255\255\255\255\080\001\081\001\082\001\083\001\084\001\ +\085\001\086\001\087\001\255\255\089\001\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\097\001\098\001\255\255\100\001\ +\101\001\255\255\103\001\104\001\105\001\106\001\255\255\108\001\ +\109\001\255\255\111\001\255\255\255\255\255\255\115\001\255\255\ +\000\001\001\001\002\001\003\001\255\255\255\255\006\001\007\001\ +\008\001\009\001\010\001\011\001\012\001\013\001\014\001\015\001\ +\016\001\017\001\018\001\019\001\020\001\021\001\022\001\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\030\001\031\001\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\043\001\044\001\045\001\046\001\047\001\ +\048\001\049\001\050\001\051\001\255\255\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\060\001\061\001\255\255\063\001\ +\064\001\065\001\066\001\067\001\068\001\255\255\070\001\071\001\ +\072\001\073\001\074\001\255\255\076\001\255\255\255\255\255\255\ +\080\001\081\001\082\001\083\001\084\001\085\001\086\001\087\001\ +\255\255\089\001\255\255\091\001\092\001\000\000\094\001\095\001\ +\096\001\097\001\098\001\255\255\100\001\101\001\255\255\103\001\ +\104\001\105\001\106\001\255\255\108\001\109\001\255\255\111\001\ +\255\255\255\255\255\255\115\001\000\001\001\001\002\001\003\001\ +\255\255\255\255\006\001\007\001\008\001\009\001\010\001\011\001\ +\012\001\013\001\014\001\015\001\016\001\017\001\018\001\019\001\ +\020\001\021\001\022\001\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\030\001\031\001\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\043\001\ +\044\001\045\001\046\001\047\001\048\001\049\001\050\001\051\001\ +\255\255\053\001\054\001\055\001\056\001\255\255\255\255\059\001\ +\060\001\061\001\255\255\063\001\064\001\065\001\066\001\067\001\ +\068\001\255\255\070\001\071\001\072\001\073\001\074\001\255\255\ +\076\001\255\255\255\255\255\255\080\001\081\001\082\001\083\001\ +\084\001\085\001\086\001\087\001\255\255\089\001\255\255\091\001\ +\092\001\000\000\094\001\095\001\096\001\097\001\098\001\255\255\ +\100\001\101\001\255\255\103\001\104\001\105\001\106\001\255\255\ +\108\001\109\001\255\255\111\001\255\255\255\255\255\255\115\001\ +\000\001\001\001\002\001\003\001\255\255\255\255\006\001\007\001\ +\008\001\009\001\010\001\011\001\012\001\013\001\014\001\015\001\ +\016\001\017\001\018\001\019\001\020\001\021\001\022\001\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\030\001\031\001\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\043\001\044\001\045\001\046\001\047\001\ +\048\001\049\001\050\001\051\001\255\255\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\060\001\061\001\255\255\063\001\ +\064\001\065\001\066\001\067\001\068\001\255\255\070\001\071\001\ +\072\001\073\001\074\001\255\255\076\001\255\255\255\255\255\255\ +\080\001\081\001\082\001\083\001\084\001\085\001\086\001\087\001\ +\255\255\089\001\255\255\091\001\092\001\000\000\094\001\095\001\ +\096\001\097\001\098\001\255\255\100\001\101\001\255\255\103\001\ +\104\001\105\001\106\001\255\255\108\001\109\001\255\255\111\001\ +\255\255\255\255\255\255\115\001\255\255\000\001\001\001\002\001\ +\003\001\255\255\255\255\006\001\007\001\008\001\009\001\010\001\ +\011\001\012\001\013\001\014\001\015\001\016\001\017\001\018\001\ +\019\001\020\001\021\001\022\001\255\255\024\001\025\001\026\001\ +\027\001\028\001\029\001\030\001\031\001\255\255\255\255\255\255\ +\255\255\036\001\037\001\255\255\255\255\040\001\041\001\042\001\ +\043\001\044\001\045\001\046\001\047\001\048\001\049\001\050\001\ +\051\001\255\255\053\001\054\001\055\001\056\001\255\255\255\255\ +\059\001\060\001\061\001\255\255\063\001\064\001\065\001\066\001\ +\067\001\068\001\255\255\070\001\071\001\072\001\073\001\074\001\ +\255\255\076\001\255\255\255\255\255\255\080\001\081\001\082\001\ +\083\001\084\001\085\001\086\001\087\001\255\255\089\001\255\255\ +\091\001\092\001\000\000\094\001\095\001\096\001\097\001\098\001\ +\255\255\100\001\101\001\255\255\103\001\104\001\105\001\106\001\ +\255\255\108\001\109\001\255\255\111\001\255\255\255\255\255\255\ +\115\001\000\001\001\001\002\001\003\001\255\255\255\255\006\001\ +\007\001\008\001\009\001\010\001\011\001\012\001\013\001\014\001\ +\015\001\016\001\017\001\018\001\019\001\020\001\021\001\022\001\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\030\001\ +\031\001\255\255\255\255\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\043\001\044\001\045\001\046\001\ +\047\001\048\001\049\001\050\001\051\001\255\255\053\001\054\001\ +\055\001\056\001\255\255\255\255\059\001\060\001\061\001\255\255\ +\063\001\064\001\065\001\066\001\067\001\068\001\255\255\070\001\ +\071\001\072\001\073\001\074\001\255\255\076\001\255\255\255\255\ +\255\255\080\001\081\001\082\001\083\001\084\001\085\001\086\001\ +\087\001\255\255\089\001\255\255\091\001\092\001\000\000\094\001\ +\095\001\096\001\097\001\098\001\255\255\100\001\101\001\255\255\ +\103\001\104\001\105\001\106\001\255\255\108\001\109\001\255\255\ +\111\001\255\255\255\255\255\255\115\001\000\001\001\001\002\001\ +\003\001\255\255\255\255\006\001\007\001\008\001\009\001\010\001\ +\011\001\012\001\013\001\014\001\015\001\016\001\017\001\018\001\ +\019\001\020\001\021\001\022\001\255\255\024\001\025\001\026\001\ +\027\001\028\001\029\001\030\001\031\001\255\255\255\255\255\255\ +\255\255\036\001\037\001\255\255\255\255\040\001\041\001\042\001\ +\043\001\044\001\045\001\046\001\047\001\048\001\049\001\050\001\ +\051\001\255\255\053\001\054\001\055\001\056\001\255\255\255\255\ +\059\001\060\001\061\001\255\255\063\001\064\001\065\001\066\001\ +\067\001\068\001\255\255\070\001\071\001\072\001\073\001\074\001\ +\255\255\076\001\255\255\255\255\255\255\080\001\081\001\082\001\ +\083\001\084\001\085\001\086\001\087\001\255\255\089\001\255\255\ +\091\001\092\001\000\000\094\001\095\001\096\001\097\001\098\001\ +\255\255\100\001\101\001\255\255\103\001\104\001\105\001\106\001\ +\255\255\108\001\109\001\255\255\111\001\255\255\255\255\255\255\ +\115\001\255\255\000\001\001\001\002\001\003\001\255\255\255\255\ +\006\001\007\001\008\001\009\001\010\001\011\001\012\001\013\001\ +\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\ +\022\001\255\255\024\001\025\001\026\001\027\001\028\001\029\001\ +\030\001\031\001\255\255\255\255\255\255\255\255\036\001\037\001\ +\255\255\255\255\040\001\041\001\042\001\043\001\044\001\045\001\ +\046\001\047\001\048\001\049\001\050\001\051\001\255\255\053\001\ +\054\001\055\001\056\001\255\255\255\255\059\001\060\001\061\001\ +\255\255\063\001\064\001\065\001\066\001\067\001\068\001\255\255\ +\070\001\071\001\072\001\073\001\074\001\255\255\076\001\255\255\ +\255\255\255\255\080\001\081\001\082\001\083\001\084\001\085\001\ +\086\001\087\001\255\255\089\001\255\255\091\001\092\001\000\000\ +\094\001\095\001\096\001\097\001\098\001\255\255\100\001\101\001\ +\255\255\103\001\104\001\105\001\106\001\255\255\108\001\109\001\ +\255\255\111\001\255\255\255\255\255\255\115\001\000\001\001\001\ +\002\001\003\001\255\255\255\255\006\001\007\001\008\001\009\001\ +\010\001\011\001\012\001\013\001\014\001\015\001\016\001\017\001\ +\018\001\019\001\020\001\021\001\022\001\255\255\024\001\025\001\ +\026\001\027\001\028\001\029\001\030\001\031\001\255\255\255\255\ +\255\255\255\255\036\001\037\001\255\255\255\255\040\001\041\001\ +\042\001\043\001\044\001\045\001\046\001\047\001\048\001\049\001\ +\050\001\051\001\255\255\053\001\054\001\055\001\056\001\255\255\ +\255\255\059\001\060\001\061\001\255\255\063\001\064\001\065\001\ +\066\001\067\001\068\001\255\255\070\001\071\001\072\001\073\001\ +\074\001\255\255\076\001\255\255\255\255\255\255\080\001\081\001\ +\082\001\083\001\084\001\085\001\086\001\087\001\255\255\089\001\ +\255\255\091\001\092\001\000\000\094\001\095\001\096\001\097\001\ +\098\001\255\255\100\001\101\001\255\255\103\001\104\001\105\001\ +\106\001\255\255\108\001\109\001\255\255\111\001\255\255\255\255\ +\255\255\115\001\000\001\001\001\002\001\003\001\255\255\255\255\ +\006\001\007\001\008\001\009\001\010\001\011\001\012\001\013\001\ +\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\ +\022\001\255\255\024\001\025\001\026\001\027\001\028\001\029\001\ +\030\001\031\001\255\255\255\255\255\255\255\255\036\001\037\001\ +\255\255\255\255\040\001\041\001\042\001\043\001\044\001\045\001\ +\046\001\047\001\048\001\049\001\050\001\051\001\255\255\053\001\ +\054\001\055\001\056\001\255\255\255\255\059\001\060\001\061\001\ +\255\255\063\001\064\001\065\001\066\001\067\001\068\001\255\255\ +\070\001\071\001\072\001\073\001\074\001\255\255\076\001\255\255\ +\255\255\255\255\080\001\081\001\082\001\083\001\084\001\085\001\ +\086\001\087\001\255\255\089\001\255\255\091\001\092\001\000\000\ +\094\001\095\001\096\001\097\001\098\001\255\255\100\001\101\001\ +\255\255\103\001\104\001\105\001\106\001\255\255\108\001\109\001\ +\255\255\111\001\255\255\255\255\255\255\115\001\255\255\000\001\ +\001\001\002\001\003\001\004\001\255\255\006\001\007\001\008\001\ +\009\001\010\001\011\001\012\001\013\001\014\001\015\001\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\030\001\031\001\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\043\001\044\001\045\001\046\001\255\255\048\001\ +\049\001\050\001\051\001\255\255\053\001\054\001\055\001\056\001\ +\255\255\255\255\059\001\060\001\061\001\255\255\063\001\064\001\ +\065\001\066\001\067\001\068\001\255\255\070\001\071\001\072\001\ +\073\001\074\001\255\255\076\001\255\255\255\255\255\255\080\001\ +\081\001\082\001\083\001\084\001\085\001\086\001\087\001\255\255\ +\089\001\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\097\001\098\001\255\255\100\001\101\001\255\255\103\001\104\001\ +\105\001\106\001\255\255\108\001\109\001\255\255\111\001\255\255\ +\255\255\255\255\115\001\000\001\001\001\002\001\003\001\004\001\ +\255\255\006\001\007\001\008\001\009\001\010\001\011\001\012\001\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\255\255\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\030\001\031\001\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\046\001\255\255\048\001\049\001\050\001\051\001\255\255\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\060\001\ +\061\001\255\255\063\001\064\001\065\001\066\001\067\001\068\001\ +\255\255\070\001\071\001\072\001\073\001\074\001\255\255\076\001\ +\255\255\255\255\255\255\080\001\081\001\082\001\083\001\084\001\ +\085\001\086\001\087\001\255\255\089\001\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\255\255\255\255\255\255\100\001\ +\101\001\255\255\103\001\104\001\105\001\106\001\255\255\108\001\ +\109\001\255\255\111\001\255\255\255\255\255\255\115\001\000\001\ +\001\001\002\001\003\001\004\001\255\255\006\001\007\001\008\001\ +\009\001\010\001\011\001\012\001\013\001\014\001\015\001\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\030\001\031\001\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\043\001\044\001\045\001\046\001\255\255\048\001\ +\049\001\050\001\051\001\255\255\053\001\054\001\055\001\056\001\ +\255\255\255\255\059\001\060\001\061\001\255\255\063\001\064\001\ +\065\001\066\001\067\001\068\001\255\255\070\001\071\001\072\001\ +\073\001\074\001\255\255\076\001\255\255\255\255\255\255\080\001\ +\081\001\082\001\083\001\084\001\085\001\086\001\087\001\255\255\ +\089\001\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\255\255\255\255\255\255\100\001\101\001\255\255\103\001\104\001\ +\105\001\106\001\255\255\108\001\109\001\255\255\111\001\255\255\ +\255\255\255\255\115\001\255\255\000\001\001\001\002\001\003\001\ +\004\001\255\255\006\001\007\001\008\001\009\001\010\001\011\001\ +\012\001\013\001\014\001\015\001\016\001\017\001\018\001\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\030\001\031\001\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\043\001\ +\044\001\045\001\046\001\255\255\048\001\049\001\050\001\051\001\ +\255\255\053\001\054\001\055\001\056\001\255\255\255\255\059\001\ +\060\001\061\001\255\255\063\001\064\001\065\001\066\001\067\001\ +\068\001\255\255\070\001\071\001\072\001\073\001\074\001\255\255\ +\076\001\255\255\255\255\255\255\080\001\081\001\082\001\083\001\ +\084\001\085\001\086\001\087\001\255\255\089\001\255\255\091\001\ +\092\001\000\000\094\001\095\001\096\001\255\255\255\255\255\255\ +\100\001\101\001\255\255\103\001\104\001\105\001\106\001\255\255\ +\108\001\109\001\255\255\111\001\255\255\255\255\255\255\115\001\ +\000\001\001\001\002\001\003\001\255\255\255\255\255\255\255\255\ +\008\001\009\001\010\001\255\255\255\255\013\001\014\001\015\001\ +\016\001\017\001\018\001\019\001\020\001\021\001\022\001\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\043\001\044\001\045\001\046\001\047\001\ +\048\001\049\001\255\255\051\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\061\001\255\255\063\001\ +\255\255\255\255\066\001\067\001\068\001\255\255\070\001\071\001\ +\072\001\073\001\074\001\255\255\255\255\255\255\255\255\255\255\ +\080\001\081\001\082\001\083\001\084\001\085\001\086\001\255\255\ +\255\255\089\001\255\255\091\001\092\001\000\000\094\001\095\001\ +\096\001\097\001\098\001\255\255\100\001\255\255\255\255\103\001\ +\104\001\105\001\255\255\255\255\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\115\001\000\001\001\001\002\001\003\001\ +\255\255\255\255\255\255\255\255\008\001\009\001\010\001\255\255\ +\255\255\013\001\014\001\015\001\016\001\017\001\018\001\019\001\ +\020\001\021\001\022\001\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\043\001\ +\044\001\045\001\046\001\047\001\048\001\049\001\255\255\051\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\060\001\061\001\255\255\063\001\255\255\255\255\066\001\067\001\ +\068\001\255\255\070\001\071\001\072\001\073\001\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\081\001\082\001\083\001\ +\084\001\085\001\086\001\255\255\255\255\089\001\255\255\091\001\ +\092\001\000\000\094\001\095\001\096\001\097\001\098\001\255\255\ +\100\001\255\255\255\255\103\001\104\001\105\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\115\001\ +\255\255\000\001\001\001\002\001\003\001\255\255\255\255\255\255\ +\255\255\008\001\009\001\010\001\255\255\255\255\013\001\014\001\ +\015\001\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\043\001\044\001\045\001\046\001\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\061\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\070\001\ +\071\001\072\001\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\083\001\084\001\085\001\086\001\ +\255\255\255\255\255\255\255\255\091\001\092\001\000\000\094\001\ +\095\001\096\001\255\255\255\255\255\255\100\001\255\255\255\255\ +\103\001\255\255\105\001\255\255\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\115\001\000\001\001\001\002\001\ +\003\001\255\255\255\255\255\255\255\255\008\001\009\001\010\001\ +\255\255\255\255\013\001\014\001\015\001\016\001\017\001\255\255\ +\019\001\020\001\021\001\255\255\255\255\024\001\025\001\026\001\ +\027\001\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\036\001\037\001\255\255\255\255\040\001\041\001\042\001\ +\043\001\044\001\045\001\046\001\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\061\001\255\255\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\071\001\072\001\073\001\074\001\ +\255\255\255\255\255\255\255\255\255\255\080\001\255\255\082\001\ +\083\001\084\001\085\001\086\001\255\255\255\255\255\255\255\255\ +\091\001\092\001\000\000\094\001\095\001\096\001\097\001\255\255\ +\255\255\100\001\255\255\255\255\103\001\255\255\105\001\255\255\ +\255\255\108\001\255\255\255\255\111\001\255\255\255\255\255\255\ +\115\001\000\001\001\001\002\001\003\001\255\255\255\255\255\255\ +\255\255\008\001\009\001\010\001\255\255\255\255\013\001\014\001\ +\015\001\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\043\001\044\001\045\001\046\001\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\061\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\070\001\ +\071\001\072\001\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\083\001\084\001\085\001\086\001\ +\255\255\255\255\255\255\255\255\091\001\092\001\000\000\094\001\ +\095\001\096\001\255\255\255\255\255\255\100\001\255\255\255\255\ +\103\001\255\255\105\001\255\255\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\115\001\255\255\000\001\001\001\ +\002\001\003\001\255\255\255\255\255\255\255\255\008\001\009\001\ +\010\001\255\255\255\255\013\001\014\001\015\001\016\001\017\001\ +\018\001\019\001\020\001\021\001\255\255\255\255\024\001\025\001\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\036\001\037\001\255\255\255\255\040\001\041\001\ +\042\001\043\001\044\001\045\001\046\001\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\061\001\255\255\063\001\255\255\255\255\ +\066\001\067\001\068\001\255\255\070\001\071\001\072\001\073\001\ +\074\001\255\255\255\255\255\255\255\255\255\255\080\001\255\255\ +\082\001\083\001\084\001\085\001\086\001\255\255\255\255\255\255\ +\255\255\091\001\092\001\000\000\094\001\095\001\096\001\255\255\ +\255\255\255\255\100\001\255\255\255\255\103\001\255\255\105\001\ +\255\255\255\255\108\001\255\255\255\255\111\001\255\255\255\255\ +\255\255\115\001\000\001\001\001\002\001\003\001\255\255\255\255\ +\255\255\255\255\008\001\009\001\010\001\255\255\255\255\013\001\ +\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\ +\255\255\255\255\024\001\025\001\026\001\027\001\028\001\029\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\036\001\037\001\ +\255\255\255\255\040\001\041\001\042\001\043\001\044\001\045\001\ +\046\001\255\255\048\001\049\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\060\001\061\001\ +\255\255\063\001\255\255\255\255\066\001\067\001\068\001\255\255\ +\070\001\071\001\072\001\073\001\074\001\255\255\255\255\255\255\ +\255\255\255\255\080\001\255\255\082\001\083\001\084\001\085\001\ +\086\001\255\255\255\255\255\255\255\255\091\001\092\001\000\000\ +\094\001\095\001\096\001\255\255\255\255\255\255\100\001\255\255\ +\255\255\103\001\255\255\105\001\255\255\255\255\108\001\255\255\ +\255\255\111\001\255\255\255\255\255\255\115\001\000\001\001\001\ +\002\001\003\001\255\255\255\255\255\255\255\255\008\001\009\001\ +\010\001\255\255\255\255\013\001\014\001\015\001\016\001\017\001\ +\018\001\019\001\020\001\021\001\255\255\255\255\024\001\025\001\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\036\001\037\001\255\255\255\255\040\001\041\001\ +\042\001\043\001\044\001\045\001\046\001\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\061\001\255\255\063\001\255\255\255\255\ +\066\001\067\001\068\001\255\255\070\001\071\001\072\001\073\001\ +\074\001\255\255\255\255\255\255\255\255\255\255\080\001\255\255\ +\082\001\083\001\084\001\085\001\086\001\255\255\255\255\255\255\ +\255\255\091\001\092\001\000\000\094\001\095\001\096\001\255\255\ +\255\255\255\255\100\001\255\255\255\255\103\001\255\255\105\001\ +\255\255\255\255\108\001\255\255\255\255\111\001\255\255\255\255\ +\255\255\115\001\255\255\000\001\001\001\002\001\003\001\255\255\ +\255\255\255\255\255\255\008\001\009\001\010\001\255\255\255\255\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\255\255\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\255\255\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\061\001\255\255\063\001\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\071\001\072\001\073\001\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\082\001\083\001\084\001\ +\085\001\086\001\255\255\255\255\255\255\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\097\001\255\255\255\255\100\001\ +\255\255\255\255\103\001\255\255\105\001\255\255\255\255\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\115\001\000\001\ +\001\001\002\001\003\001\255\255\255\255\255\255\255\255\008\001\ +\009\001\010\001\255\255\255\255\013\001\014\001\015\001\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\043\001\044\001\045\001\255\255\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\060\001\061\001\255\255\063\001\255\255\ +\255\255\066\001\067\001\068\001\255\255\070\001\071\001\072\001\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\082\001\083\001\084\001\085\001\086\001\255\255\255\255\ +\255\255\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\097\001\255\255\255\255\100\001\255\255\255\255\103\001\255\255\ +\105\001\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\255\255\255\255\115\001\000\001\001\001\002\001\003\001\255\255\ +\255\255\255\255\255\255\008\001\009\001\010\001\255\255\255\255\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\255\255\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\255\255\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\061\001\255\255\063\001\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\071\001\072\001\073\001\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\082\001\083\001\084\001\ +\085\001\086\001\255\255\255\255\255\255\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\097\001\255\255\255\255\100\001\ +\255\255\255\255\103\001\255\255\105\001\255\255\255\255\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\115\001\255\255\ +\000\001\001\001\002\001\003\001\255\255\255\255\255\255\255\255\ +\008\001\009\001\010\001\255\255\255\255\013\001\014\001\015\001\ +\016\001\017\001\018\001\019\001\020\001\021\001\255\255\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\043\001\044\001\045\001\255\255\255\255\ +\048\001\049\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\061\001\255\255\063\001\ +\255\255\255\255\066\001\067\001\068\001\255\255\070\001\071\001\ +\072\001\073\001\074\001\255\255\255\255\255\255\255\255\255\255\ +\080\001\255\255\082\001\083\001\084\001\085\001\086\001\255\255\ +\255\255\255\255\255\255\091\001\092\001\000\000\094\001\095\001\ +\096\001\097\001\255\255\255\255\100\001\255\255\255\255\103\001\ +\255\255\105\001\255\255\255\255\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\115\001\000\001\001\001\002\001\003\001\ +\255\255\255\255\255\255\255\255\255\255\009\001\010\001\255\255\ +\255\255\013\001\014\001\015\001\016\001\017\001\018\001\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\043\001\ +\044\001\045\001\046\001\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\060\001\061\001\255\255\063\001\255\255\255\255\066\001\067\001\ +\068\001\255\255\070\001\071\001\072\001\073\001\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\255\255\082\001\083\001\ +\084\001\085\001\086\001\255\255\255\255\255\255\255\255\091\001\ +\092\001\000\000\094\001\095\001\096\001\097\001\255\255\255\255\ +\100\001\255\255\255\255\103\001\255\255\105\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\115\001\ +\000\001\001\001\002\001\003\001\255\255\255\255\255\255\255\255\ +\255\255\009\001\010\001\255\255\255\255\013\001\014\001\015\001\ +\016\001\017\001\018\001\019\001\020\001\021\001\255\255\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\043\001\044\001\045\001\046\001\255\255\ +\048\001\049\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\061\001\255\255\063\001\ +\255\255\255\255\066\001\067\001\068\001\255\255\070\001\071\001\ +\072\001\073\001\074\001\255\255\255\255\255\255\255\255\255\255\ +\080\001\255\255\082\001\083\001\084\001\085\001\086\001\255\255\ +\255\255\255\255\255\255\091\001\092\001\000\000\094\001\095\001\ +\096\001\097\001\255\255\255\255\100\001\255\255\255\255\103\001\ +\255\255\105\001\255\255\255\255\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\115\001\255\255\000\001\001\001\002\001\ +\003\001\255\255\255\255\255\255\255\255\255\255\009\001\010\001\ +\255\255\255\255\013\001\014\001\015\001\016\001\017\001\018\001\ +\019\001\020\001\021\001\255\255\255\255\024\001\025\001\026\001\ +\027\001\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\036\001\037\001\255\255\255\255\040\001\041\001\042\001\ +\043\001\044\001\045\001\046\001\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\061\001\255\255\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\071\001\072\001\073\001\074\001\ +\255\255\255\255\255\255\255\255\255\255\080\001\255\255\082\001\ +\083\001\084\001\085\001\086\001\255\255\255\255\255\255\255\255\ +\091\001\092\001\000\000\094\001\095\001\096\001\097\001\255\255\ +\255\255\100\001\255\255\255\255\103\001\255\255\105\001\255\255\ +\255\255\108\001\255\255\255\255\111\001\255\255\255\255\255\255\ +\115\001\000\001\001\001\002\001\003\001\255\255\255\255\255\255\ +\255\255\008\001\009\001\010\001\255\255\255\255\013\001\014\001\ +\015\001\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\043\001\044\001\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\061\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\070\001\ +\071\001\072\001\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\255\255\084\001\085\001\086\001\ +\255\255\255\255\255\255\255\255\091\001\092\001\000\000\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\255\255\105\001\255\255\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\115\001\000\001\001\001\002\001\ +\003\001\255\255\255\255\255\255\255\255\008\001\009\001\010\001\ +\255\255\255\255\013\001\014\001\015\001\016\001\017\001\018\001\ +\019\001\020\001\021\001\255\255\255\255\024\001\025\001\026\001\ +\027\001\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\036\001\037\001\255\255\255\255\040\001\041\001\042\001\ +\043\001\044\001\255\255\255\255\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\061\001\255\255\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\071\001\072\001\073\001\074\001\ +\255\255\255\255\255\255\255\255\255\255\080\001\255\255\082\001\ +\255\255\084\001\085\001\086\001\255\255\255\255\255\255\255\255\ +\091\001\092\001\000\000\094\001\095\001\096\001\097\001\255\255\ +\255\255\255\255\255\255\255\255\103\001\255\255\105\001\255\255\ +\255\255\108\001\255\255\255\255\111\001\255\255\255\255\255\255\ +\115\001\255\255\000\001\001\001\002\001\003\001\255\255\255\255\ +\255\255\255\255\008\001\009\001\010\001\255\255\255\255\013\001\ +\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\ +\255\255\255\255\024\001\025\001\026\001\027\001\028\001\029\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\036\001\037\001\ +\255\255\255\255\040\001\041\001\042\001\043\001\044\001\255\255\ +\255\255\255\255\048\001\049\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\060\001\061\001\ +\255\255\063\001\255\255\255\255\066\001\067\001\068\001\255\255\ +\070\001\071\001\072\001\073\001\074\001\255\255\255\255\255\255\ +\255\255\255\255\080\001\255\255\082\001\255\255\084\001\085\001\ +\086\001\255\255\255\255\255\255\255\255\091\001\092\001\000\000\ +\094\001\095\001\096\001\097\001\255\255\255\255\255\255\255\255\ +\255\255\103\001\255\255\105\001\255\255\255\255\108\001\255\255\ +\255\255\111\001\255\255\255\255\255\255\115\001\000\001\001\001\ +\002\001\003\001\255\255\255\255\255\255\255\255\008\001\009\001\ +\010\001\255\255\255\255\013\001\014\001\015\001\016\001\017\001\ +\018\001\019\001\020\001\021\001\255\255\255\255\024\001\025\001\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\036\001\037\001\255\255\255\255\040\001\041\001\ +\042\001\043\001\044\001\255\255\255\255\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\061\001\255\255\063\001\255\255\255\255\ +\066\001\067\001\068\001\255\255\070\001\071\001\072\001\073\001\ +\074\001\255\255\255\255\255\255\255\255\255\255\080\001\255\255\ +\082\001\255\255\084\001\085\001\086\001\255\255\255\255\255\255\ +\255\255\091\001\092\001\000\000\094\001\095\001\096\001\097\001\ +\255\255\255\255\255\255\255\255\255\255\103\001\255\255\105\001\ +\255\255\255\255\108\001\255\255\255\255\111\001\255\255\255\255\ +\255\255\115\001\000\001\001\001\002\001\003\001\255\255\255\255\ +\255\255\255\255\008\001\009\001\010\001\255\255\255\255\013\001\ +\014\001\015\001\016\001\017\001\018\001\019\001\020\001\021\001\ +\255\255\255\255\024\001\025\001\026\001\027\001\028\001\029\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\036\001\037\001\ +\255\255\255\255\040\001\041\001\042\001\043\001\044\001\255\255\ +\255\255\255\255\048\001\049\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\060\001\061\001\ +\255\255\063\001\255\255\255\255\066\001\067\001\068\001\255\255\ +\070\001\071\001\072\001\073\001\074\001\255\255\255\255\255\255\ +\255\255\255\255\080\001\255\255\082\001\255\255\084\001\085\001\ +\086\001\255\255\255\255\255\255\255\255\091\001\092\001\000\000\ +\094\001\095\001\096\001\097\001\255\255\255\255\255\255\255\255\ +\255\255\103\001\255\255\105\001\255\255\255\255\108\001\255\255\ +\255\255\111\001\255\255\255\255\255\255\115\001\255\255\000\001\ +\001\001\002\001\003\001\255\255\255\255\255\255\255\255\008\001\ +\009\001\010\001\255\255\255\255\013\001\014\001\015\001\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\043\001\044\001\255\255\255\255\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\060\001\061\001\255\255\063\001\255\255\ +\255\255\066\001\067\001\068\001\255\255\070\001\071\001\072\001\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\082\001\255\255\084\001\085\001\086\001\255\255\255\255\ +\255\255\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\103\001\255\255\ +\105\001\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\255\255\255\255\115\001\000\001\001\001\002\001\003\001\255\255\ +\255\255\255\255\255\255\008\001\009\001\010\001\255\255\255\255\ +\013\001\014\001\015\001\016\001\017\001\018\001\019\001\020\001\ +\021\001\255\255\255\255\024\001\025\001\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\037\001\255\255\255\255\040\001\041\001\042\001\043\001\044\001\ +\045\001\046\001\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\061\001\255\255\255\255\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\255\255\255\255\073\001\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\082\001\255\255\255\255\ +\255\255\086\001\255\255\255\255\255\255\255\255\091\001\092\001\ +\000\000\094\001\095\001\096\001\097\001\255\255\255\255\100\001\ +\255\255\255\255\103\001\255\255\105\001\255\255\255\255\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\115\001\000\001\ +\001\001\002\001\003\001\255\255\255\255\255\255\255\255\008\001\ +\009\001\010\001\255\255\255\255\013\001\014\001\255\255\016\001\ +\017\001\018\001\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\027\001\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\036\001\037\001\255\255\255\255\040\001\ +\041\001\042\001\255\255\255\255\255\255\255\255\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\060\001\061\001\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\255\255\255\255\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\082\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\091\001\092\001\000\000\094\001\095\001\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\103\001\255\255\ +\105\001\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\255\255\255\255\115\001\255\255\000\001\001\001\002\001\003\001\ +\255\255\255\255\255\255\255\255\008\001\009\001\010\001\255\255\ +\255\255\013\001\014\001\255\255\016\001\017\001\018\001\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\255\255\ +\255\255\255\255\255\255\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\060\001\061\001\255\255\063\001\255\255\255\255\255\255\067\001\ +\068\001\255\255\070\001\255\255\255\255\073\001\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\255\255\082\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\091\001\ +\092\001\000\000\094\001\095\001\096\001\097\001\255\255\255\255\ +\255\255\255\255\255\255\103\001\255\255\105\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\115\001\ +\000\001\001\001\002\001\003\001\255\255\255\255\255\255\255\255\ +\008\001\009\001\010\001\255\255\255\255\013\001\014\001\255\255\ +\016\001\017\001\018\001\019\001\020\001\021\001\255\255\255\255\ +\024\001\025\001\026\001\027\001\028\001\029\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\036\001\037\001\255\255\255\255\ +\040\001\041\001\042\001\255\255\255\255\255\255\255\255\255\255\ +\048\001\049\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\061\001\255\255\063\001\ +\255\255\255\255\255\255\067\001\068\001\255\255\070\001\255\255\ +\255\255\073\001\074\001\255\255\255\255\255\255\255\255\255\255\ +\080\001\000\000\082\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\091\001\092\001\255\255\094\001\095\001\ +\096\001\097\001\255\255\255\255\255\255\255\255\255\255\103\001\ +\255\255\105\001\255\255\255\255\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\115\001\000\001\001\001\002\001\003\001\ +\255\255\255\255\255\255\255\255\008\001\009\001\010\001\255\255\ +\255\255\013\001\014\001\255\255\016\001\017\001\018\001\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\027\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\036\001\037\001\255\255\255\255\040\001\041\001\042\001\255\255\ +\255\255\255\255\255\255\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\060\001\061\001\255\255\063\001\255\255\255\255\255\255\067\001\ +\068\001\000\000\070\001\255\255\255\255\073\001\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\255\255\082\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\091\001\ +\092\001\255\255\094\001\095\001\096\001\097\001\255\255\255\255\ +\255\255\255\255\255\255\103\001\255\255\105\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\115\001\ +\255\255\000\001\001\001\002\001\003\001\255\255\255\255\255\255\ +\255\255\008\001\009\001\010\001\255\255\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\027\001\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\036\001\037\001\255\255\ +\255\255\040\001\041\001\042\001\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\000\000\255\255\255\255\255\255\060\001\061\001\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\009\001\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\000\000\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\009\001\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\000\000\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\082\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\255\255\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\000\000\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\000\000\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\255\255\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\000\000\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\000\000\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\255\255\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\000\000\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\255\255\010\001\115\001\255\255\013\001\014\001\ +\255\255\016\001\017\001\018\001\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\000\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\013\001\255\255\255\255\000\000\ +\023\001\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\026\001\255\255\028\001\029\001\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\041\001\255\255\073\001\074\001\255\255\000\000\255\255\255\255\ +\055\001\080\001\057\001\058\001\059\001\255\255\061\001\255\255\ +\255\255\064\001\065\001\060\001\091\001\092\001\063\001\094\001\ +\095\001\096\001\097\001\068\001\000\001\255\255\255\255\003\001\ +\103\001\074\001\105\001\255\255\008\001\108\001\010\001\080\001\ +\111\001\013\001\014\001\090\001\115\001\017\001\255\255\019\001\ +\020\001\021\001\097\001\092\001\024\001\025\001\026\001\096\001\ +\028\001\029\001\000\001\255\255\255\255\003\001\109\001\110\001\ +\255\255\037\001\255\255\108\001\040\001\041\001\111\001\013\001\ +\255\255\255\255\000\000\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\026\001\255\255\028\001\029\001\ +\060\001\255\255\255\255\063\001\255\255\255\255\255\255\067\001\ +\068\001\255\255\070\001\041\001\255\255\073\001\074\001\255\255\ +\000\000\053\001\255\255\055\001\080\001\057\001\058\001\059\001\ +\255\255\061\001\255\255\255\255\064\001\065\001\060\001\091\001\ +\092\001\255\255\094\001\095\001\096\001\097\001\068\001\000\001\ +\255\255\255\255\003\001\103\001\074\001\105\001\255\255\008\001\ +\108\001\010\001\080\001\111\001\013\001\014\001\090\001\115\001\ +\017\001\255\255\019\001\020\001\021\001\097\001\092\001\024\001\ +\025\001\026\001\096\001\028\001\029\001\255\255\255\255\255\255\ +\255\255\109\001\110\001\255\255\037\001\255\255\108\001\040\001\ +\041\001\111\001\255\255\255\255\255\255\000\000\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\060\001\255\255\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\255\255\255\255\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\091\001\092\001\255\255\094\001\095\001\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\103\001\000\001\ +\105\001\255\255\003\001\108\001\255\255\255\255\111\001\008\001\ +\255\255\010\001\115\001\255\255\013\001\014\001\255\255\255\255\ +\017\001\255\255\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\255\255\028\001\029\001\000\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\037\001\255\255\255\255\040\001\ +\041\001\255\255\013\001\255\255\255\255\000\000\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\026\001\ +\255\255\028\001\029\001\060\001\255\255\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\041\001\255\255\ +\073\001\074\001\255\255\000\000\255\255\255\255\055\001\080\001\ +\057\001\058\001\059\001\255\255\061\001\255\255\255\255\064\001\ +\065\001\060\001\091\001\092\001\255\255\094\001\095\001\096\001\ +\097\001\068\001\000\001\255\255\255\255\003\001\103\001\074\001\ +\105\001\255\255\008\001\108\001\010\001\080\001\111\001\013\001\ +\014\001\090\001\115\001\017\001\255\255\019\001\020\001\021\001\ +\097\001\092\001\024\001\025\001\026\001\096\001\028\001\029\001\ +\000\001\255\255\255\255\255\255\109\001\110\001\255\255\037\001\ +\255\255\108\001\040\001\041\001\111\001\013\001\255\255\255\255\ +\000\000\255\255\048\001\049\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\026\001\255\255\028\001\029\001\060\001\255\255\ +\255\255\063\001\255\255\255\255\255\255\067\001\068\001\255\255\ +\070\001\041\001\255\255\073\001\074\001\255\255\000\000\255\255\ +\255\255\255\255\080\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\091\001\092\001\255\255\ +\094\001\095\001\096\001\097\001\068\001\000\001\255\255\255\255\ +\003\001\103\001\074\001\105\001\255\255\008\001\108\001\010\001\ +\080\001\111\001\013\001\014\001\255\255\115\001\017\001\255\255\ +\019\001\020\001\021\001\255\255\092\001\024\001\025\001\026\001\ +\096\001\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\037\001\255\255\108\001\040\001\041\001\111\001\ +\255\255\255\255\255\255\000\000\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\255\255\255\255\063\001\255\255\255\255\255\255\ +\067\001\068\001\255\255\070\001\255\255\255\255\073\001\074\001\ +\255\255\255\255\255\255\255\255\255\255\080\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\091\001\092\001\255\255\094\001\095\001\096\001\097\001\255\255\ +\255\255\255\255\255\255\255\255\103\001\000\001\105\001\255\255\ +\003\001\108\001\255\255\255\255\111\001\008\001\255\255\010\001\ +\115\001\255\255\013\001\014\001\255\255\255\255\017\001\255\255\ +\019\001\020\001\021\001\255\255\255\255\024\001\025\001\026\001\ +\255\255\028\001\029\001\000\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\037\001\255\255\255\255\040\001\041\001\255\255\ +\013\001\255\255\255\255\000\000\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\026\001\255\255\028\001\ +\029\001\060\001\255\255\255\255\063\001\255\255\255\255\255\255\ +\067\001\068\001\255\255\070\001\041\001\255\255\073\001\074\001\ +\255\255\000\000\255\255\255\255\255\255\080\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\091\001\092\001\255\255\094\001\095\001\096\001\097\001\068\001\ +\000\001\255\255\255\255\003\001\103\001\074\001\105\001\255\255\ +\008\001\108\001\010\001\080\001\111\001\013\001\014\001\255\255\ +\115\001\017\001\255\255\019\001\020\001\021\001\255\255\092\001\ +\024\001\025\001\026\001\096\001\028\001\029\001\000\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\037\001\255\255\108\001\ +\040\001\041\001\111\001\013\001\255\255\255\255\000\000\255\255\ +\048\001\049\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\026\001\255\255\028\001\029\001\060\001\255\255\255\255\063\001\ +\255\255\255\255\255\255\067\001\068\001\255\255\070\001\041\001\ +\255\255\073\001\074\001\255\255\255\255\255\255\255\255\255\255\ +\080\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\091\001\092\001\255\255\094\001\095\001\ +\096\001\097\001\068\001\000\001\255\255\255\255\003\001\103\001\ +\074\001\105\001\255\255\008\001\108\001\010\001\080\001\111\001\ +\013\001\014\001\255\255\115\001\017\001\255\255\019\001\020\001\ +\021\001\255\255\092\001\024\001\025\001\026\001\096\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\037\001\255\255\108\001\040\001\041\001\111\001\255\255\255\255\ +\255\255\000\000\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\255\255\255\255\063\001\255\255\255\255\255\255\067\001\068\001\ +\255\255\070\001\255\255\255\255\073\001\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\091\001\092\001\ +\255\255\094\001\095\001\096\001\097\001\255\255\255\255\255\255\ +\255\255\255\255\103\001\000\001\105\001\255\255\003\001\108\001\ +\255\255\255\255\111\001\008\001\255\255\010\001\115\001\255\255\ +\013\001\014\001\255\255\255\255\017\001\255\255\019\001\020\001\ +\021\001\255\255\255\255\024\001\025\001\026\001\255\255\028\001\ +\029\001\000\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\037\001\255\255\255\255\040\001\041\001\255\255\013\001\255\255\ +\255\255\000\000\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\026\001\255\255\028\001\029\001\060\001\ +\255\255\255\255\063\001\255\255\255\255\255\255\067\001\068\001\ +\255\255\070\001\041\001\255\255\073\001\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\091\001\092\001\ +\255\255\094\001\095\001\096\001\097\001\068\001\000\001\255\255\ +\255\255\003\001\103\001\074\001\105\001\255\255\008\001\108\001\ +\010\001\080\001\111\001\013\001\014\001\255\255\115\001\017\001\ +\255\255\019\001\020\001\021\001\255\255\092\001\024\001\025\001\ +\026\001\096\001\028\001\029\001\006\001\255\255\008\001\255\255\ +\255\255\255\255\255\255\037\001\255\255\108\001\040\001\041\001\ +\111\001\255\255\255\255\255\255\000\000\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\255\255\255\255\063\001\255\255\255\255\ +\255\255\067\001\068\001\255\255\070\001\255\255\255\255\073\001\ +\074\001\255\255\255\255\255\255\255\255\055\001\080\001\057\001\ +\058\001\059\001\255\255\061\001\255\255\255\255\064\001\065\001\ +\255\255\091\001\092\001\255\255\094\001\095\001\096\001\097\001\ +\255\255\000\001\255\255\255\255\003\001\103\001\255\255\105\001\ +\255\255\008\001\108\001\010\001\255\255\111\001\013\001\014\001\ +\090\001\115\001\017\001\255\255\019\001\020\001\021\001\097\001\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\109\001\110\001\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\000\000\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\255\255\255\255\255\255\255\255\ +\103\001\000\001\105\001\255\255\003\001\108\001\255\255\255\255\ +\111\001\008\001\255\255\010\001\115\001\255\255\013\001\014\001\ +\255\255\255\255\017\001\255\255\019\001\020\001\021\001\255\255\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\037\001\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\000\000\ +\255\255\048\001\049\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\070\001\ +\255\255\255\255\073\001\074\001\255\255\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\091\001\092\001\255\255\094\001\ +\095\001\096\001\097\001\255\255\000\001\255\255\255\255\003\001\ +\103\001\255\255\105\001\255\255\008\001\108\001\010\001\255\255\ +\111\001\013\001\014\001\255\255\115\001\017\001\255\255\019\001\ +\020\001\021\001\255\255\255\255\024\001\025\001\026\001\255\255\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\037\001\255\255\255\255\040\001\041\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\048\001\049\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\000\000\255\255\255\255\ +\060\001\255\255\255\255\063\001\255\255\255\255\255\255\067\001\ +\068\001\255\255\070\001\255\255\255\255\073\001\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\091\001\ +\092\001\255\255\094\001\095\001\096\001\097\001\255\255\000\001\ +\255\255\255\255\003\001\103\001\255\255\105\001\255\255\008\001\ +\108\001\010\001\255\255\111\001\013\001\014\001\255\255\115\001\ +\017\001\255\255\019\001\020\001\021\001\255\255\255\255\024\001\ +\025\001\026\001\255\255\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\037\001\255\255\255\255\040\001\ +\041\001\255\255\255\255\255\255\255\255\255\255\255\255\048\001\ +\049\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\000\000\255\255\255\255\060\001\255\255\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\255\255\255\255\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\091\001\092\001\255\255\094\001\255\255\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\103\001\000\001\ +\105\001\255\255\003\001\108\001\255\255\255\255\111\001\008\001\ +\255\255\010\001\115\001\255\255\013\001\014\001\255\255\255\255\ +\017\001\255\255\019\001\020\001\021\001\255\255\255\255\024\001\ +\255\255\026\001\255\255\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\037\001\255\255\255\255\040\001\ +\041\001\255\255\255\255\255\255\255\255\255\255\255\255\048\001\ +\049\001\255\255\255\255\000\000\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\060\001\255\255\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\255\255\255\255\ +\073\001\074\001\255\255\255\255\255\255\255\255\255\255\080\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\091\001\092\001\255\255\094\001\095\001\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\103\001\255\255\ +\105\001\255\255\255\255\108\001\255\255\000\001\111\001\002\001\ +\003\001\004\001\115\001\255\255\255\255\008\001\255\255\255\255\ +\255\255\255\255\013\001\255\255\255\255\255\255\017\001\018\001\ +\019\001\255\255\255\255\255\255\255\255\000\001\255\255\026\001\ +\027\001\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\036\001\255\255\255\255\255\255\040\001\041\001\255\255\ +\000\000\255\255\255\255\255\255\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\255\255\255\255\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\255\255\255\255\073\001\074\001\ +\255\255\255\255\255\255\255\255\055\001\080\001\057\001\058\001\ +\059\001\255\255\061\001\255\255\255\255\064\001\065\001\255\255\ +\091\001\092\001\255\255\094\001\095\001\096\001\255\255\255\255\ +\000\001\100\001\002\001\003\001\004\001\255\255\081\001\255\255\ +\008\001\108\001\255\255\255\255\111\001\013\001\089\001\090\001\ +\115\001\017\001\018\001\019\001\255\255\255\255\097\001\255\255\ +\255\255\255\255\026\001\027\001\028\001\029\001\255\255\255\255\ +\008\001\255\255\109\001\110\001\036\001\255\255\255\255\255\255\ +\255\255\041\001\255\255\000\000\255\255\255\255\255\255\023\001\ +\048\001\049\001\255\255\255\255\255\255\255\255\030\001\255\255\ +\255\255\255\255\255\255\255\255\060\001\255\255\255\255\063\001\ +\255\255\255\255\066\001\067\001\068\001\255\255\070\001\255\255\ +\255\255\073\001\074\001\255\255\255\255\255\255\255\255\055\001\ +\080\001\057\001\058\001\059\001\255\255\061\001\255\255\255\255\ +\064\001\065\001\255\255\091\001\092\001\255\255\094\001\095\001\ +\096\001\097\001\255\255\000\001\255\255\002\001\003\001\004\001\ +\255\255\081\001\255\255\008\001\108\001\255\255\255\255\111\001\ +\013\001\089\001\090\001\115\001\017\001\018\001\019\001\255\255\ +\255\255\097\001\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\106\001\255\255\255\255\109\001\110\001\036\001\ +\255\255\255\255\255\255\255\255\041\001\255\255\000\000\255\255\ +\255\255\255\255\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\255\255\255\255\063\001\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\255\255\255\255\255\255\074\001\255\255\255\255\ +\255\255\255\255\255\255\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\091\001\092\001\ +\255\255\094\001\095\001\096\001\097\001\255\255\255\255\255\255\ +\000\001\255\255\002\001\003\001\004\001\255\255\255\255\108\001\ +\008\001\255\255\111\001\255\255\255\255\013\001\115\001\255\255\ +\255\255\017\001\018\001\019\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\026\001\027\001\028\001\029\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\036\001\255\255\255\255\255\255\ +\255\255\041\001\255\255\000\000\255\255\255\255\255\255\255\255\ +\048\001\049\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\060\001\255\255\255\255\063\001\ +\255\255\255\255\066\001\067\001\068\001\255\255\070\001\255\255\ +\255\255\255\255\074\001\255\255\255\255\255\255\255\255\055\001\ +\080\001\057\001\058\001\059\001\255\255\061\001\255\255\255\255\ +\064\001\065\001\255\255\091\001\092\001\255\255\094\001\095\001\ +\096\001\097\001\074\001\000\001\255\255\002\001\003\001\004\001\ +\255\255\081\001\255\255\008\001\108\001\255\255\255\255\111\001\ +\013\001\089\001\090\001\115\001\017\001\018\001\019\001\000\000\ +\255\255\097\001\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\109\001\110\001\036\001\ +\255\255\255\255\255\255\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\255\255\255\255\063\001\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\255\255\255\255\255\255\074\001\255\255\255\255\ +\255\255\000\000\055\001\080\001\057\001\058\001\059\001\255\255\ +\061\001\255\255\255\255\064\001\065\001\255\255\091\001\092\001\ +\255\255\094\001\095\001\096\001\097\001\255\255\000\001\255\255\ +\002\001\003\001\004\001\255\255\081\001\255\255\008\001\108\001\ +\255\255\255\255\111\001\013\001\089\001\090\001\115\001\017\001\ +\018\001\019\001\255\255\255\255\097\001\255\255\255\255\255\255\ +\026\001\027\001\028\001\029\001\255\255\255\255\255\255\108\001\ +\109\001\110\001\036\001\000\000\255\255\255\255\255\255\041\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\048\001\049\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\255\255\255\255\063\001\255\255\255\255\ +\066\001\067\001\068\001\255\255\070\001\255\255\255\255\255\255\ +\074\001\255\255\255\255\255\255\255\255\255\255\080\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\091\001\092\001\255\255\094\001\095\001\096\001\097\001\ +\255\255\000\000\255\255\000\001\255\255\002\001\003\001\255\255\ +\255\255\255\255\108\001\008\001\255\255\111\001\255\255\255\255\ +\013\001\115\001\255\255\255\255\017\001\018\001\019\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\255\255\255\255\255\255\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\048\001\049\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\000\000\255\255\255\255\255\255\060\001\ +\255\255\255\255\063\001\255\255\255\255\066\001\067\001\068\001\ +\255\255\070\001\255\255\255\255\006\001\074\001\008\001\000\001\ +\255\255\255\255\003\001\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\013\001\255\255\091\001\092\001\ +\017\001\094\001\095\001\096\001\097\001\255\255\255\255\255\255\ +\255\255\026\001\027\001\028\001\029\001\255\255\255\255\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\115\001\255\255\ +\041\001\255\255\255\255\255\255\255\255\055\001\255\255\057\001\ +\058\001\059\001\255\255\061\001\255\255\255\255\064\001\065\001\ +\255\255\000\001\255\255\060\001\003\001\255\255\063\001\255\255\ +\255\255\066\001\067\001\068\001\255\255\255\255\013\001\255\255\ +\073\001\074\001\017\001\255\255\255\255\255\255\255\255\080\001\ +\090\001\255\255\092\001\026\001\027\001\028\001\029\001\097\001\ +\255\255\255\255\255\255\092\001\000\000\094\001\255\255\096\001\ +\097\001\255\255\041\001\109\001\110\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\255\255\255\255\115\001\000\001\255\255\060\001\003\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\255\255\ +\013\001\255\255\073\001\074\001\017\001\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\092\001\255\255\094\001\ +\255\255\096\001\097\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\115\001\255\255\255\255\060\001\ +\255\255\000\001\063\001\255\255\003\001\066\001\067\001\068\001\ +\255\255\255\255\255\255\255\255\073\001\074\001\013\001\255\255\ +\255\255\255\255\017\001\080\001\019\001\255\255\255\255\255\255\ +\255\255\255\255\000\000\026\001\027\001\028\001\029\001\092\001\ +\255\255\094\001\255\255\096\001\097\001\255\255\255\255\255\255\ +\255\255\255\255\041\001\255\255\255\255\255\255\255\255\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\115\001\255\255\ +\255\255\255\255\255\255\000\001\255\255\060\001\003\001\255\255\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\255\255\ +\013\001\255\255\073\001\074\001\017\001\255\255\255\255\255\255\ +\255\255\080\001\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\092\001\255\255\094\001\ +\255\255\096\001\097\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\108\001\255\255\255\255\ +\111\001\000\000\255\255\255\255\115\001\255\255\255\255\060\001\ +\255\255\255\255\063\001\255\255\255\255\255\255\067\001\068\001\ +\255\255\255\255\255\255\255\255\073\001\074\001\055\001\255\255\ +\057\001\058\001\059\001\080\001\061\001\255\255\063\001\064\001\ +\065\001\255\255\255\255\255\255\255\255\255\255\255\255\092\001\ +\255\255\094\001\255\255\096\001\097\001\078\001\255\255\255\255\ +\081\001\255\255\255\255\255\255\255\255\255\255\255\255\108\001\ +\089\001\090\001\111\001\255\255\000\001\255\255\115\001\003\001\ +\097\001\005\001\006\001\007\001\008\001\255\255\255\255\011\001\ +\012\001\013\001\255\255\255\255\109\001\110\001\255\255\019\001\ +\255\255\255\255\255\255\023\001\255\255\255\255\026\001\255\255\ +\028\001\029\001\030\001\031\001\032\001\033\001\034\001\035\001\ +\036\001\255\255\255\255\039\001\040\001\041\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\048\001\049\001\050\001\051\001\ +\052\001\053\001\054\001\055\001\056\001\057\001\058\001\059\001\ +\060\001\061\001\000\000\063\001\064\001\065\001\255\255\067\001\ +\068\001\069\001\070\001\071\001\072\001\255\255\074\001\075\001\ +\076\001\077\001\078\001\255\255\080\001\081\001\255\255\255\255\ +\084\001\085\001\255\255\087\001\088\001\089\001\090\001\091\001\ +\092\001\093\001\255\255\095\001\096\001\097\001\255\255\099\001\ +\255\255\101\001\102\001\255\255\104\001\255\255\106\001\107\001\ +\108\001\109\001\110\001\111\001\112\001\255\255\114\001\005\001\ +\006\001\007\001\255\255\255\255\255\255\011\001\012\001\013\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\028\001\029\001\ +\030\001\031\001\032\001\033\001\034\001\255\255\255\255\255\255\ +\255\255\039\001\255\255\041\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\050\001\255\255\052\001\053\001\ +\054\001\055\001\056\001\255\255\255\255\059\001\060\001\255\255\ +\255\255\063\001\064\001\065\001\255\255\000\000\068\001\069\001\ +\255\255\071\001\072\001\255\255\074\001\255\255\076\001\255\255\ +\078\001\255\255\080\001\255\255\255\255\255\255\084\001\085\001\ +\255\255\087\001\255\255\255\255\255\255\255\255\005\001\006\001\ +\007\001\255\255\096\001\097\001\011\001\012\001\013\001\101\001\ +\255\255\255\255\255\255\255\255\106\001\107\001\108\001\109\001\ +\110\001\111\001\255\255\255\255\114\001\028\001\029\001\030\001\ +\031\001\032\001\033\001\034\001\255\255\255\255\255\255\255\255\ +\039\001\255\255\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\255\255\052\001\053\001\054\001\ +\055\001\056\001\255\255\255\255\059\001\060\001\255\255\255\255\ +\063\001\064\001\065\001\255\255\255\255\068\001\069\001\255\255\ +\071\001\072\001\255\255\074\001\255\255\076\001\255\255\078\001\ +\255\255\080\001\255\255\000\000\255\255\084\001\085\001\255\255\ +\087\001\000\000\055\001\255\255\057\001\058\001\059\001\255\255\ +\061\001\255\255\097\001\064\001\065\001\255\255\101\001\255\255\ +\255\255\255\255\255\255\106\001\107\001\108\001\109\001\110\001\ +\111\001\255\255\255\255\114\001\081\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\089\001\090\001\255\255\005\001\ +\006\001\007\001\255\255\255\255\097\001\011\001\012\001\013\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\109\001\110\001\255\255\255\255\255\255\255\255\028\001\029\001\ +\030\001\031\001\032\001\033\001\034\001\255\255\255\255\255\255\ +\255\255\039\001\255\255\041\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\050\001\255\255\052\001\053\001\ +\054\001\055\001\056\001\255\255\255\255\059\001\060\001\255\255\ +\255\255\063\001\064\001\065\001\255\255\255\255\068\001\069\001\ +\255\255\071\001\072\001\255\255\074\001\000\000\076\001\255\255\ +\078\001\255\255\080\001\255\255\255\255\255\255\084\001\085\001\ +\255\255\087\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\097\001\255\255\255\255\255\255\101\001\ +\255\255\255\255\255\255\255\255\106\001\107\001\108\001\109\001\ +\110\001\111\001\255\255\255\255\114\001\000\001\255\255\255\255\ +\255\255\004\001\255\255\006\001\255\255\008\001\255\255\010\001\ +\255\255\012\001\255\255\014\001\015\001\255\255\017\001\018\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\027\001\028\001\255\255\030\001\031\001\000\000\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\050\001\ +\051\001\052\001\053\001\255\255\055\001\056\001\255\255\255\255\ +\059\001\255\255\255\255\255\255\255\255\064\001\065\001\066\001\ +\255\255\255\255\255\255\255\255\071\001\255\255\073\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\081\001\255\255\ +\255\255\084\001\255\255\255\255\255\255\255\255\089\001\000\000\ +\091\001\092\001\255\255\094\001\095\001\255\255\097\001\255\255\ +\255\255\255\255\101\001\000\001\255\255\104\001\255\255\106\001\ +\255\255\000\001\109\001\110\001\255\255\004\001\113\001\006\001\ +\013\001\008\001\255\255\010\001\255\255\012\001\255\255\014\001\ +\015\001\255\255\017\001\018\001\255\255\026\001\255\255\028\001\ +\029\001\255\255\255\255\255\255\027\001\255\255\255\255\030\001\ +\031\001\255\255\255\255\255\255\041\001\255\255\255\255\255\255\ +\255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\051\001\255\255\053\001\060\001\ +\055\001\056\001\255\255\255\255\059\001\255\255\067\001\068\001\ +\255\255\064\001\065\001\066\001\255\255\074\001\255\255\255\255\ +\071\001\255\255\073\001\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\081\001\255\255\255\255\084\001\255\255\092\001\ +\255\255\255\255\089\001\096\001\091\001\092\001\255\255\094\001\ +\095\001\255\255\097\001\000\000\255\255\255\255\101\001\108\001\ +\255\255\104\001\111\001\106\001\255\255\000\001\109\001\110\001\ +\003\001\004\001\113\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\013\001\014\001\255\255\255\255\255\255\255\255\ +\019\001\255\255\255\255\255\255\255\255\255\255\255\255\026\001\ +\255\255\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\041\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\255\255\255\255\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\255\255\000\001\255\255\074\001\ +\003\001\004\001\000\000\255\255\255\255\080\001\255\255\255\255\ +\255\255\255\255\013\001\014\001\255\255\255\255\255\255\255\255\ +\019\001\092\001\255\255\094\001\255\255\096\001\097\001\026\001\ +\255\255\028\001\029\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\108\001\255\255\255\255\111\001\255\255\041\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\048\001\049\001\255\255\ +\255\255\255\255\255\255\000\000\255\255\255\255\255\255\000\001\ +\255\255\060\001\003\001\004\001\063\001\255\255\255\255\066\001\ +\067\001\068\001\255\255\070\001\013\001\014\001\255\255\074\001\ +\255\255\255\255\019\001\255\255\255\255\080\001\255\255\255\255\ +\255\255\026\001\255\255\028\001\029\001\255\255\255\255\255\255\ +\255\255\092\001\255\255\094\001\255\255\096\001\097\001\255\255\ +\041\001\255\255\255\255\255\255\255\255\000\000\255\255\048\001\ +\049\001\108\001\255\255\255\255\111\001\255\255\255\255\255\255\ +\255\255\000\001\255\255\060\001\003\001\004\001\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\070\001\013\001\014\001\ +\255\255\074\001\255\255\255\255\019\001\255\255\255\255\080\001\ +\255\255\255\255\255\255\026\001\255\255\028\001\029\001\255\255\ +\255\255\255\255\255\255\092\001\255\255\094\001\255\255\096\001\ +\097\001\255\255\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\108\001\255\255\255\255\111\001\255\255\ +\255\255\255\255\255\255\000\001\255\255\060\001\003\001\004\001\ +\063\001\000\000\255\255\255\255\067\001\068\001\255\255\070\001\ +\013\001\014\001\255\255\074\001\255\255\255\255\019\001\255\255\ +\255\255\080\001\255\255\255\255\255\255\026\001\255\255\028\001\ +\029\001\255\255\255\255\255\255\255\255\092\001\255\255\094\001\ +\255\255\096\001\097\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\048\001\049\001\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\255\255\255\255\255\255\060\001\ +\255\255\255\255\063\001\000\000\255\255\255\255\067\001\068\001\ +\255\255\070\001\255\255\255\255\255\255\074\001\055\001\255\255\ +\057\001\058\001\059\001\080\001\061\001\255\255\255\255\064\001\ +\065\001\255\255\000\001\255\255\255\255\003\001\255\255\092\001\ +\255\255\094\001\008\001\096\001\097\001\255\255\255\255\013\001\ +\081\001\255\255\255\255\255\255\255\255\019\001\255\255\108\001\ +\089\001\090\001\111\001\255\255\026\001\255\255\028\001\029\001\ +\097\001\255\255\255\255\255\255\255\255\000\000\255\255\255\255\ +\255\255\255\255\040\001\041\001\109\001\110\001\255\255\255\255\ +\255\255\255\255\255\255\000\001\255\255\255\255\003\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\060\001\255\255\ +\013\001\063\001\255\255\255\255\066\001\067\001\068\001\255\255\ +\255\255\255\255\255\255\073\001\074\001\026\001\027\001\028\001\ +\029\001\255\255\080\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\041\001\255\255\092\001\000\000\ +\255\255\255\255\096\001\097\001\255\255\000\001\100\001\255\255\ +\003\001\255\255\255\255\255\255\255\255\255\255\108\001\060\001\ +\255\255\111\001\013\001\064\001\255\255\066\001\067\001\068\001\ +\255\255\255\255\255\255\255\255\073\001\074\001\255\255\026\001\ +\027\001\028\001\029\001\080\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\041\001\092\001\ +\255\255\094\001\255\255\096\001\097\001\255\255\255\255\100\001\ +\255\255\000\000\255\255\255\255\255\255\255\255\255\255\108\001\ +\109\001\060\001\111\001\255\255\255\255\064\001\255\255\066\001\ +\067\001\068\001\255\255\255\255\255\255\255\255\073\001\074\001\ +\255\255\000\001\255\255\255\255\003\001\080\001\255\255\255\255\ +\255\255\008\001\255\255\255\255\255\255\255\255\013\001\255\255\ +\255\255\092\001\255\255\094\001\019\001\096\001\097\001\255\255\ +\255\255\100\001\000\000\026\001\255\255\028\001\029\001\255\255\ +\255\255\108\001\109\001\255\255\111\001\255\255\255\255\255\255\ +\255\255\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\000\001\255\255\060\001\003\001\255\255\ +\063\001\255\255\255\255\066\001\067\001\068\001\255\255\255\255\ +\013\001\255\255\073\001\074\001\255\255\255\255\019\001\000\000\ +\255\255\080\001\255\255\255\255\255\255\026\001\027\001\028\001\ +\029\001\255\255\255\255\255\255\255\255\092\001\255\255\255\255\ +\255\255\096\001\097\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\048\001\255\255\108\001\255\255\255\255\ +\111\001\255\255\255\255\255\255\255\255\000\001\255\255\060\001\ +\003\001\255\255\063\001\255\255\255\255\255\255\067\001\068\001\ +\255\255\070\001\013\001\255\255\000\000\074\001\255\255\255\255\ +\019\001\255\255\255\255\080\001\255\255\255\255\255\255\026\001\ +\255\255\028\001\029\001\255\255\255\255\255\255\255\255\092\001\ +\255\255\094\001\255\255\096\001\097\001\040\001\041\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\048\001\049\001\108\001\ +\255\255\255\255\111\001\255\255\255\255\255\255\255\255\000\001\ +\255\255\060\001\003\001\255\255\063\001\255\255\255\255\008\001\ +\255\255\068\001\255\255\070\001\013\001\255\255\255\255\074\001\ +\255\255\255\255\019\001\255\255\255\255\080\001\255\255\255\255\ +\255\255\026\001\255\255\028\001\029\001\255\255\255\255\000\000\ +\255\255\092\001\255\255\255\255\255\255\096\001\097\001\255\255\ +\041\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\108\001\255\255\255\255\111\001\255\255\255\255\255\255\ +\255\255\000\001\255\255\060\001\003\001\255\255\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\255\255\013\001\255\255\ +\255\255\074\001\255\255\255\255\019\001\255\255\255\255\080\001\ +\255\255\255\255\255\255\026\001\000\000\028\001\029\001\255\255\ +\255\255\255\255\255\255\092\001\255\255\000\000\255\255\096\001\ +\097\001\255\255\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\000\001\108\001\255\255\003\001\111\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\060\001\255\255\013\001\ +\063\001\255\255\255\255\255\255\067\001\068\001\255\255\255\255\ +\255\255\255\255\255\255\074\001\026\001\255\255\028\001\029\001\ +\255\255\080\001\255\255\255\255\255\255\255\255\255\255\000\000\ +\255\255\255\255\040\001\041\001\255\255\092\001\255\255\255\255\ +\255\255\096\001\097\001\255\255\255\255\255\255\255\255\000\001\ +\255\255\255\255\003\001\255\255\255\255\108\001\060\001\255\255\ +\111\001\063\001\255\255\255\255\013\001\067\001\068\001\255\255\ +\255\255\255\255\019\001\255\255\074\001\255\255\255\255\255\255\ +\255\255\026\001\080\001\028\001\029\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\000\000\255\255\092\001\255\255\ +\041\001\255\255\096\001\097\001\255\255\000\000\255\255\255\255\ +\255\255\255\255\255\255\255\255\000\001\255\255\108\001\003\001\ +\255\255\111\001\255\255\060\001\255\255\255\255\063\001\255\255\ +\255\255\013\001\067\001\068\001\255\255\255\255\255\255\019\001\ +\255\255\074\001\255\255\255\255\255\255\255\255\026\001\080\001\ +\028\001\029\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\092\001\255\255\041\001\255\255\096\001\ +\097\001\255\255\000\000\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\060\001\255\255\255\255\063\001\255\255\255\255\255\255\067\001\ +\068\001\255\255\255\255\255\255\255\255\255\255\074\001\000\001\ +\255\255\255\255\003\001\255\255\080\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\013\001\255\255\255\255\255\255\ +\092\001\255\255\019\001\255\255\096\001\097\001\255\255\000\000\ +\255\255\026\001\255\255\028\001\029\001\255\255\255\255\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\255\255\ +\041\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\000\001\255\255\255\255\003\001\ +\255\255\255\255\255\255\060\001\255\255\000\001\063\001\255\255\ +\255\255\013\001\067\001\068\001\255\255\008\001\255\255\019\001\ +\000\000\074\001\013\001\255\255\255\255\255\255\026\001\080\001\ +\028\001\029\001\000\000\255\255\255\255\255\255\255\255\026\001\ +\255\255\028\001\029\001\092\001\255\255\041\001\255\255\096\001\ +\097\001\255\255\255\255\255\255\255\255\255\255\041\001\255\255\ +\255\255\255\255\255\255\108\001\255\255\255\255\111\001\000\001\ +\060\001\255\255\003\001\063\001\255\255\255\255\255\255\067\001\ +\068\001\060\001\255\255\255\255\013\001\255\255\074\001\066\001\ +\067\001\068\001\019\001\255\255\080\001\255\255\255\255\074\001\ +\255\255\026\001\255\255\028\001\029\001\080\001\255\255\255\255\ +\092\001\255\255\255\255\000\000\096\001\097\001\255\255\255\255\ +\041\001\092\001\255\255\255\255\255\255\096\001\255\255\255\255\ +\108\001\255\255\255\255\111\001\000\001\255\255\255\255\255\255\ +\255\255\108\001\255\255\060\001\111\001\000\001\063\001\255\255\ +\003\001\013\001\067\001\068\001\255\255\255\255\255\255\255\255\ +\255\255\074\001\013\001\255\255\255\255\255\255\026\001\080\001\ +\028\001\029\001\255\255\255\255\000\000\255\255\255\255\026\001\ +\255\255\028\001\029\001\092\001\255\255\041\001\000\000\096\001\ +\097\001\255\255\255\255\255\255\255\255\040\001\041\001\255\255\ +\255\255\255\255\255\255\108\001\255\255\255\255\111\001\255\255\ +\060\001\255\255\000\001\063\001\255\255\003\001\066\001\067\001\ +\068\001\060\001\255\255\255\255\063\001\255\255\074\001\013\001\ +\255\255\068\001\255\255\255\255\080\001\255\255\255\255\074\001\ +\255\255\255\255\255\255\255\255\026\001\080\001\028\001\029\001\ +\092\001\255\255\255\255\255\255\096\001\097\001\255\255\255\255\ +\255\255\092\001\255\255\041\001\000\000\096\001\097\001\255\255\ +\108\001\255\255\255\255\111\001\255\255\255\255\255\255\000\001\ +\255\255\108\001\003\001\255\255\111\001\255\255\060\001\255\255\ +\255\255\063\001\255\255\255\255\013\001\067\001\068\001\255\255\ +\255\255\255\255\255\255\255\255\074\001\255\255\255\255\255\255\ +\255\255\026\001\080\001\028\001\029\001\255\255\255\255\255\255\ +\000\000\255\255\255\255\255\255\255\255\255\255\092\001\255\255\ +\041\001\000\000\096\001\097\001\255\255\255\255\255\255\255\255\ +\000\001\255\255\255\255\255\255\255\255\255\255\108\001\255\255\ +\008\001\111\001\000\001\060\001\255\255\013\001\063\001\255\255\ +\255\255\255\255\067\001\068\001\255\255\255\255\255\255\013\001\ +\255\255\074\001\026\001\255\255\028\001\029\001\255\255\080\001\ +\255\255\255\255\255\255\255\255\026\001\255\255\028\001\029\001\ +\255\255\041\001\000\000\092\001\255\255\255\255\255\255\096\001\ +\097\001\255\255\255\255\041\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\108\001\060\001\255\255\111\001\063\001\ +\255\255\255\255\255\255\067\001\068\001\255\255\060\001\255\255\ +\255\255\063\001\074\001\000\001\255\255\067\001\068\001\255\255\ +\080\001\255\255\255\255\255\255\074\001\255\255\000\000\255\255\ +\013\001\255\255\080\001\255\255\092\001\255\255\255\255\255\255\ +\096\001\097\001\255\255\255\255\255\255\026\001\092\001\028\001\ +\029\001\255\255\096\001\097\001\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\255\255\041\001\255\255\108\001\255\255\ +\255\255\111\001\255\255\255\255\000\001\255\255\255\255\003\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\000\001\060\001\ +\255\255\013\001\063\001\255\255\255\255\255\255\067\001\068\001\ +\255\255\255\255\255\255\013\001\255\255\074\001\026\001\255\255\ +\028\001\029\001\255\255\080\001\255\255\255\255\255\255\255\255\ +\026\001\255\255\028\001\029\001\255\255\041\001\255\255\092\001\ +\255\255\255\255\255\255\096\001\097\001\255\255\255\255\041\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\108\001\ +\060\001\255\255\111\001\063\001\255\255\255\255\255\255\255\255\ +\068\001\255\255\060\001\255\255\000\001\063\001\074\001\255\255\ +\255\255\067\001\068\001\255\255\080\001\255\255\255\255\255\255\ +\074\001\013\001\255\255\255\255\255\255\255\255\080\001\255\255\ +\092\001\255\255\255\255\255\255\096\001\097\001\026\001\255\255\ +\028\001\029\001\092\001\255\255\255\255\255\255\096\001\097\001\ +\108\001\255\255\255\255\111\001\255\255\041\001\255\255\255\255\ +\000\001\255\255\108\001\255\255\255\255\111\001\255\255\255\255\ +\255\255\000\001\255\255\255\255\255\255\013\001\255\255\255\255\ +\060\001\255\255\255\255\063\001\255\255\255\255\013\001\067\001\ +\068\001\255\255\026\001\255\255\028\001\029\001\074\001\255\255\ +\255\255\255\255\255\255\026\001\080\001\028\001\029\001\255\255\ +\255\255\041\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\092\001\255\255\041\001\255\255\096\001\097\001\255\255\255\255\ +\255\255\255\255\000\001\255\255\060\001\255\255\255\255\063\001\ +\108\001\255\255\255\255\111\001\068\001\060\001\255\255\013\001\ +\063\001\255\255\074\001\255\255\255\255\068\001\255\255\255\255\ +\080\001\255\255\255\255\074\001\026\001\255\255\028\001\029\001\ +\255\255\080\001\255\255\255\255\092\001\255\255\255\255\255\255\ +\096\001\097\001\255\255\041\001\255\255\092\001\000\001\255\255\ +\255\255\096\001\097\001\255\255\108\001\255\255\255\255\111\001\ +\255\255\255\255\255\255\013\001\255\255\108\001\060\001\255\255\ +\111\001\063\001\255\255\255\255\255\255\255\255\068\001\255\255\ +\026\001\255\255\028\001\029\001\074\001\255\255\255\255\255\255\ +\255\255\255\255\080\001\255\255\255\255\255\255\255\255\041\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\092\001\255\255\ +\255\255\255\255\096\001\097\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\060\001\255\255\255\255\063\001\108\001\255\255\ +\255\255\111\001\068\001\255\255\255\255\255\255\255\255\255\255\ +\074\001\255\255\255\255\255\255\255\255\255\255\080\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\092\001\000\001\255\255\255\255\096\001\097\001\ +\005\001\006\001\007\001\008\001\255\255\255\255\011\001\012\001\ +\013\001\014\001\108\001\255\255\255\255\111\001\019\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\026\001\255\255\028\001\ +\029\001\030\001\031\001\032\001\033\001\034\001\035\001\255\255\ +\255\255\255\255\039\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\048\001\049\001\050\001\051\001\052\001\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\060\001\ +\255\255\255\255\063\001\064\001\065\001\066\001\255\255\068\001\ +\069\001\070\001\071\001\072\001\255\255\074\001\255\255\076\001\ +\077\001\078\001\255\255\080\001\081\001\255\255\255\255\084\001\ +\085\001\255\255\087\001\255\255\089\001\090\001\255\255\092\001\ +\093\001\255\255\255\255\096\001\097\001\255\255\099\001\255\255\ +\101\001\102\001\255\255\104\001\255\255\106\001\107\001\108\001\ +\109\001\110\001\111\001\112\001\000\001\114\001\255\255\255\255\ +\255\255\005\001\006\001\007\001\008\001\255\255\255\255\011\001\ +\012\001\255\255\255\255\255\255\255\255\255\255\255\255\019\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\026\001\255\255\ +\028\001\255\255\030\001\031\001\032\001\033\001\034\001\035\001\ +\255\255\255\255\255\255\039\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\048\001\049\001\050\001\051\001\ +\052\001\053\001\054\001\055\001\056\001\255\255\255\255\059\001\ +\060\001\255\255\255\255\063\001\064\001\065\001\255\255\255\255\ +\068\001\069\001\070\001\071\001\072\001\255\255\074\001\255\255\ +\076\001\077\001\078\001\255\255\255\255\081\001\255\255\255\255\ +\084\001\085\001\255\255\087\001\255\255\089\001\090\001\255\255\ +\255\255\093\001\255\255\255\255\255\255\097\001\255\255\099\001\ +\255\255\101\001\102\001\255\255\104\001\255\255\106\001\107\001\ +\255\255\109\001\110\001\111\001\112\001\255\255\114\001\000\001\ +\001\001\002\001\255\255\255\255\005\001\006\001\007\001\255\255\ +\009\001\255\255\011\001\012\001\255\255\255\255\015\001\016\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\027\001\255\255\255\255\030\001\031\001\032\001\ +\033\001\034\001\255\255\036\001\255\255\255\255\039\001\255\255\ +\255\255\042\001\043\001\044\001\045\001\046\001\047\001\255\255\ +\255\255\050\001\255\255\052\001\053\001\054\001\055\001\056\001\ +\255\255\255\255\059\001\255\255\061\001\255\255\063\001\064\001\ +\065\001\255\255\255\255\255\255\069\001\255\255\071\001\072\001\ +\255\255\074\001\255\255\076\001\255\255\078\001\255\255\255\255\ +\255\255\082\001\083\001\084\001\085\001\086\001\087\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\094\001\255\255\255\255\ +\255\255\098\001\255\255\100\001\101\001\255\255\255\255\255\255\ +\255\255\106\001\107\001\255\255\109\001\110\001\000\001\001\001\ +\002\001\114\001\255\255\005\001\006\001\007\001\255\255\009\001\ +\255\255\011\001\012\001\255\255\255\255\015\001\016\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\027\001\255\255\255\255\030\001\031\001\032\001\033\001\ +\034\001\255\255\036\001\255\255\255\255\039\001\255\255\255\255\ +\042\001\043\001\044\001\045\001\046\001\047\001\255\255\255\255\ +\050\001\255\255\052\001\053\001\054\001\055\001\056\001\255\255\ +\255\255\059\001\255\255\061\001\255\255\063\001\064\001\065\001\ +\255\255\255\255\255\255\069\001\255\255\071\001\072\001\255\255\ +\074\001\255\255\076\001\255\255\078\001\255\255\255\255\255\255\ +\082\001\083\001\084\001\085\001\086\001\087\001\255\255\255\255\ +\255\255\255\255\255\255\055\001\094\001\057\001\058\001\059\001\ +\098\001\061\001\100\001\101\001\064\001\065\001\255\255\255\255\ +\106\001\107\001\255\255\109\001\110\001\000\001\255\255\255\255\ +\114\001\255\255\005\001\006\001\007\001\081\001\255\255\255\255\ +\011\001\012\001\013\001\255\255\255\255\089\001\090\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\097\001\255\255\026\001\ +\255\255\028\001\029\001\030\001\031\001\032\001\033\001\034\001\ +\255\255\109\001\110\001\255\255\039\001\255\255\041\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\050\001\ +\255\255\052\001\053\001\054\001\055\001\056\001\255\255\255\255\ +\059\001\060\001\255\255\255\255\063\001\064\001\065\001\255\255\ +\255\255\068\001\069\001\255\255\071\001\072\001\255\255\074\001\ +\255\255\076\001\255\255\078\001\255\255\080\001\255\255\255\255\ +\255\255\084\001\085\001\000\001\087\001\255\255\255\255\255\255\ +\005\001\006\001\007\001\255\255\255\255\096\001\011\001\012\001\ +\255\255\255\255\101\001\255\255\255\255\255\255\255\255\106\001\ +\107\001\108\001\109\001\110\001\111\001\255\255\255\255\114\001\ +\255\255\030\001\031\001\032\001\033\001\034\001\255\255\255\255\ +\255\255\255\255\039\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\255\255\ +\255\255\255\255\063\001\064\001\065\001\255\255\255\255\255\255\ +\069\001\255\255\071\001\072\001\255\255\255\255\255\255\076\001\ +\255\255\078\001\255\255\255\255\255\255\255\255\255\255\084\001\ +\085\001\000\001\087\001\255\255\255\255\255\255\005\001\006\001\ +\007\001\094\001\255\255\255\255\011\001\012\001\255\255\255\255\ +\101\001\255\255\255\255\255\255\255\255\106\001\107\001\255\255\ +\109\001\110\001\255\255\255\255\255\255\114\001\255\255\030\001\ +\031\001\032\001\033\001\034\001\255\255\255\255\255\255\255\255\ +\039\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\255\255\052\001\053\001\054\001\ +\055\001\056\001\255\255\255\255\059\001\255\255\255\255\255\255\ +\063\001\064\001\065\001\255\255\255\255\255\255\069\001\255\255\ +\071\001\072\001\255\255\255\255\255\255\076\001\255\255\078\001\ +\255\255\255\255\255\255\255\255\255\255\084\001\085\001\000\001\ +\087\001\255\255\255\255\255\255\005\001\006\001\007\001\094\001\ +\255\255\255\255\011\001\012\001\255\255\255\255\101\001\255\255\ +\255\255\255\255\255\255\106\001\107\001\255\255\109\001\110\001\ +\255\255\255\255\255\255\114\001\255\255\030\001\031\001\032\001\ +\033\001\034\001\255\255\255\255\255\255\255\255\039\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\050\001\255\255\052\001\053\001\054\001\055\001\056\001\ +\255\255\255\255\059\001\255\255\255\255\255\255\063\001\064\001\ +\065\001\255\255\255\255\255\255\069\001\255\255\071\001\072\001\ +\255\255\255\255\255\255\076\001\255\255\078\001\255\255\255\255\ +\255\255\255\255\255\255\084\001\085\001\000\001\087\001\255\255\ +\255\255\255\255\005\001\006\001\007\001\094\001\255\255\255\255\ +\011\001\012\001\255\255\255\255\101\001\255\255\255\255\255\255\ +\255\255\106\001\107\001\255\255\109\001\110\001\255\255\255\255\ +\255\255\114\001\255\255\030\001\031\001\032\001\033\001\034\001\ +\255\255\255\255\255\255\255\255\039\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\050\001\ +\255\255\052\001\053\001\054\001\055\001\056\001\255\255\255\255\ +\059\001\255\255\255\255\255\255\063\001\064\001\065\001\255\255\ +\255\255\255\255\069\001\255\255\071\001\072\001\255\255\255\255\ +\255\255\076\001\255\255\078\001\255\255\255\255\255\255\255\255\ +\255\255\084\001\085\001\255\255\087\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\094\001\003\001\004\001\005\001\255\255\ +\255\255\255\255\101\001\255\255\011\001\255\255\013\001\106\001\ +\107\001\255\255\109\001\110\001\019\001\020\001\021\001\114\001\ +\255\255\024\001\025\001\026\001\255\255\028\001\029\001\030\001\ +\255\255\032\001\033\001\034\001\035\001\255\255\255\255\255\255\ +\039\001\040\001\041\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\048\001\049\001\255\255\255\255\052\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\063\001\064\001\255\255\255\255\255\255\000\001\069\001\070\001\ +\255\255\004\001\255\255\074\001\075\001\076\001\077\001\078\001\ +\079\001\080\001\255\255\082\001\255\255\255\255\017\001\255\255\ +\019\001\088\001\255\255\022\001\255\255\255\255\093\001\026\001\ +\027\001\255\255\255\255\255\255\099\001\255\255\255\255\102\001\ +\103\001\036\001\105\001\106\001\107\001\108\001\109\001\255\255\ +\111\001\112\001\113\001\114\001\115\001\048\001\049\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\060\001\255\255\255\255\255\255\064\001\255\255\066\001\ +\067\001\068\001\255\255\070\001\255\255\255\255\073\001\255\255\ +\255\255\255\255\000\001\001\001\002\001\255\255\255\255\255\255\ +\006\001\007\001\255\255\009\001\255\255\255\255\012\001\090\001\ +\091\001\015\001\016\001\255\255\095\001\255\255\097\001\255\255\ +\255\255\100\001\255\255\255\255\255\255\027\001\028\001\255\255\ +\030\001\031\001\109\001\255\255\111\001\255\255\036\001\255\255\ +\255\255\255\255\255\255\255\255\042\001\043\001\044\001\045\001\ +\046\001\047\001\255\255\255\255\050\001\255\255\052\001\053\001\ +\255\255\055\001\056\001\255\255\255\255\059\001\255\255\061\001\ +\255\255\255\255\064\001\065\001\255\255\255\255\255\255\255\255\ +\255\255\071\001\072\001\255\255\074\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\082\001\083\001\084\001\085\001\ +\086\001\087\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\094\001\255\255\255\255\097\001\098\001\255\255\100\001\101\001\ +\255\255\255\255\255\255\255\255\106\001\255\255\108\001\109\001\ +\110\001\000\001\001\001\002\001\255\255\255\255\255\255\006\001\ +\007\001\255\255\009\001\255\255\255\255\012\001\255\255\255\255\ +\015\001\016\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\027\001\028\001\255\255\030\001\ +\031\001\255\255\255\255\255\255\255\255\036\001\255\255\255\255\ +\255\255\255\255\255\255\042\001\043\001\044\001\045\001\046\001\ +\047\001\255\255\255\255\050\001\255\255\052\001\053\001\255\255\ +\055\001\056\001\255\255\255\255\059\001\255\255\061\001\255\255\ +\255\255\064\001\065\001\255\255\255\255\255\255\255\255\255\255\ +\071\001\072\001\255\255\074\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\082\001\083\001\084\001\085\001\086\001\ +\087\001\255\255\255\255\255\255\255\255\255\255\255\255\094\001\ +\255\255\255\255\097\001\098\001\255\255\100\001\101\001\255\255\ +\255\255\255\255\255\255\106\001\255\255\108\001\109\001\110\001\ +\000\001\001\001\002\001\255\255\255\255\255\255\006\001\007\001\ +\255\255\009\001\255\255\255\255\012\001\255\255\255\255\015\001\ +\016\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\027\001\028\001\255\255\030\001\031\001\ +\255\255\255\255\255\255\255\255\036\001\255\255\255\255\255\255\ +\255\255\255\255\042\001\043\001\044\001\045\001\046\001\047\001\ +\255\255\255\255\050\001\255\255\052\001\053\001\255\255\055\001\ +\056\001\255\255\255\255\059\001\255\255\061\001\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\072\001\255\255\074\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\082\001\083\001\084\001\085\001\086\001\087\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\094\001\255\255\ +\255\255\097\001\098\001\255\255\100\001\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\108\001\109\001\110\001\000\001\ +\001\001\002\001\255\255\255\255\255\255\006\001\007\001\255\255\ +\009\001\255\255\255\255\012\001\255\255\255\255\015\001\016\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\027\001\028\001\255\255\030\001\031\001\255\255\ +\255\255\255\255\255\255\036\001\255\255\255\255\255\255\255\255\ +\255\255\042\001\043\001\044\001\045\001\046\001\047\001\255\255\ +\255\255\050\001\255\255\052\001\053\001\255\255\055\001\056\001\ +\255\255\255\255\059\001\255\255\061\001\255\255\255\255\064\001\ +\065\001\255\255\255\255\255\255\255\255\255\255\071\001\072\001\ +\255\255\074\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\082\001\083\001\084\001\085\001\086\001\087\001\255\255\ +\255\255\000\001\255\255\255\255\255\255\094\001\255\255\006\001\ +\097\001\098\001\255\255\100\001\101\001\012\001\255\255\255\255\ +\015\001\106\001\255\255\255\255\109\001\110\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\028\001\255\255\030\001\ +\031\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\255\255\052\001\053\001\255\255\ +\055\001\056\001\255\255\255\255\059\001\255\255\000\001\255\255\ +\255\255\064\001\065\001\255\255\006\001\255\255\255\255\255\255\ +\071\001\255\255\012\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\084\001\255\255\255\255\ +\255\255\255\255\028\001\255\255\030\001\031\001\255\255\094\001\ +\255\255\255\255\097\001\255\255\255\255\255\255\101\001\255\255\ +\255\255\255\255\255\255\106\001\255\255\255\255\109\001\110\001\ +\050\001\255\255\052\001\053\001\255\255\055\001\056\001\255\255\ +\255\255\059\001\255\255\000\001\255\255\255\255\064\001\065\001\ +\255\255\006\001\255\255\255\255\255\255\071\001\255\255\012\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\084\001\255\255\255\255\255\255\255\255\028\001\ +\255\255\030\001\031\001\255\255\255\255\255\255\255\255\097\001\ +\255\255\255\255\255\255\101\001\255\255\255\255\255\255\255\255\ +\106\001\255\255\255\255\109\001\110\001\050\001\255\255\052\001\ +\053\001\255\255\055\001\056\001\255\255\255\255\059\001\255\255\ +\000\001\255\255\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\255\255\071\001\255\255\012\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\084\001\ +\255\255\255\255\255\255\255\255\028\001\255\255\030\001\031\001\ +\255\255\255\255\255\255\255\255\097\001\255\255\255\255\255\255\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\255\255\052\001\053\001\255\255\055\001\ +\056\001\255\255\255\255\059\001\255\255\000\001\255\255\255\255\ +\064\001\065\001\255\255\006\001\255\255\255\255\255\255\071\001\ +\255\255\012\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\084\001\255\255\255\255\255\255\ +\255\255\028\001\255\255\030\001\031\001\255\255\255\255\255\255\ +\255\255\097\001\255\255\255\255\255\255\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\255\255\109\001\110\001\050\001\ +\255\255\052\001\053\001\255\255\055\001\056\001\255\255\255\255\ +\059\001\255\255\000\001\255\255\255\255\064\001\065\001\255\255\ +\006\001\255\255\255\255\255\255\071\001\255\255\012\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\084\001\255\255\255\255\255\255\255\255\028\001\255\255\ +\030\001\031\001\255\255\255\255\255\255\255\255\097\001\255\255\ +\255\255\255\255\101\001\255\255\255\255\255\255\255\255\106\001\ +\255\255\255\255\109\001\110\001\050\001\255\255\052\001\053\001\ +\255\255\055\001\056\001\255\255\255\255\059\001\255\255\000\001\ +\255\255\255\255\064\001\065\001\255\255\006\001\255\255\255\255\ +\255\255\071\001\255\255\012\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\084\001\255\255\ +\255\255\255\255\255\255\028\001\255\255\030\001\031\001\255\255\ +\255\255\255\255\255\255\097\001\255\255\255\255\255\255\101\001\ +\255\255\255\255\255\255\255\255\106\001\255\255\255\255\109\001\ +\110\001\050\001\255\255\052\001\053\001\255\255\055\001\056\001\ +\255\255\255\255\059\001\255\255\255\255\255\255\255\255\064\001\ +\065\001\005\001\006\001\007\001\255\255\255\255\071\001\011\001\ +\012\001\013\001\014\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\084\001\255\255\255\255\255\255\255\255\ +\028\001\029\001\030\001\031\001\032\001\033\001\034\001\255\255\ +\097\001\255\255\255\255\039\001\101\001\041\001\255\255\255\255\ +\255\255\106\001\255\255\255\255\109\001\110\001\050\001\255\255\ +\052\001\053\001\054\001\055\001\056\001\255\255\255\255\059\001\ +\060\001\255\255\255\255\063\001\064\001\065\001\255\255\255\255\ +\068\001\069\001\255\255\071\001\072\001\255\255\074\001\255\255\ +\076\001\255\255\078\001\255\255\080\001\255\255\255\255\255\255\ +\084\001\085\001\255\255\087\001\255\255\089\001\255\255\255\255\ +\005\001\006\001\007\001\255\255\096\001\255\255\011\001\012\001\ +\013\001\101\001\255\255\255\255\255\255\255\255\106\001\107\001\ +\108\001\109\001\110\001\111\001\255\255\255\255\114\001\028\001\ +\029\001\030\001\031\001\032\001\033\001\034\001\255\255\255\255\ +\255\255\255\255\039\001\255\255\041\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\060\001\ +\255\255\255\255\063\001\064\001\065\001\255\255\255\255\068\001\ +\069\001\255\255\071\001\072\001\255\255\074\001\255\255\076\001\ +\255\255\078\001\255\255\080\001\255\255\255\255\255\255\084\001\ +\085\001\255\255\087\001\255\255\255\255\255\255\005\001\006\001\ +\007\001\255\255\255\255\096\001\011\001\012\001\255\255\255\255\ +\101\001\255\255\255\255\255\255\255\255\106\001\107\001\108\001\ +\109\001\110\001\111\001\255\255\255\255\114\001\255\255\030\001\ +\031\001\032\001\033\001\034\001\255\255\255\255\255\255\255\255\ +\039\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\255\255\052\001\053\001\054\001\ +\055\001\056\001\255\255\255\255\059\001\255\255\255\255\255\255\ +\063\001\064\001\065\001\255\255\255\255\255\255\069\001\255\255\ +\071\001\072\001\255\255\255\255\255\255\076\001\255\255\078\001\ +\255\255\255\255\255\255\255\255\255\255\084\001\085\001\255\255\ +\087\001\255\255\255\255\255\255\255\255\092\001\005\001\006\001\ +\007\001\255\255\255\255\010\001\011\001\012\001\101\001\255\255\ +\255\255\255\255\255\255\106\001\107\001\255\255\109\001\110\001\ +\255\255\255\255\255\255\114\001\255\255\255\255\255\255\030\001\ +\031\001\032\001\033\001\034\001\255\255\255\255\255\255\255\255\ +\039\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\050\001\255\255\052\001\053\001\054\001\ +\055\001\056\001\255\255\255\255\059\001\255\255\255\255\255\255\ +\063\001\064\001\065\001\255\255\255\255\255\255\069\001\255\255\ +\071\001\072\001\255\255\255\255\255\255\076\001\255\255\078\001\ +\255\255\255\255\255\255\255\255\255\255\084\001\085\001\255\255\ +\087\001\255\255\255\255\005\001\006\001\007\001\255\255\255\255\ +\255\255\011\001\012\001\255\255\255\255\255\255\101\001\255\255\ +\255\255\255\255\255\255\106\001\107\001\255\255\109\001\110\001\ +\026\001\255\255\255\255\114\001\030\001\031\001\032\001\033\001\ +\034\001\255\255\255\255\255\255\255\255\039\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\050\001\255\255\052\001\053\001\054\001\055\001\056\001\255\255\ +\255\255\059\001\255\255\255\255\255\255\063\001\064\001\065\001\ +\255\255\255\255\255\255\069\001\255\255\071\001\072\001\255\255\ +\255\255\255\255\076\001\255\255\078\001\255\255\255\255\255\255\ +\255\255\255\255\084\001\085\001\255\255\087\001\255\255\255\255\ +\005\001\006\001\007\001\255\255\255\255\255\255\011\001\012\001\ +\255\255\255\255\255\255\101\001\255\255\255\255\255\255\255\255\ +\106\001\107\001\255\255\109\001\110\001\255\255\255\255\255\255\ +\114\001\030\001\031\001\032\001\033\001\034\001\255\255\255\255\ +\255\255\255\255\039\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\255\255\ +\255\255\255\255\063\001\064\001\065\001\255\255\255\255\255\255\ +\069\001\255\255\071\001\072\001\255\255\255\255\255\255\076\001\ +\255\255\078\001\255\255\255\255\255\255\255\255\083\001\084\001\ +\085\001\255\255\087\001\255\255\255\255\005\001\006\001\007\001\ +\255\255\255\255\255\255\011\001\012\001\255\255\255\255\255\255\ +\101\001\255\255\255\255\255\255\255\255\106\001\107\001\255\255\ +\109\001\110\001\255\255\255\255\255\255\114\001\030\001\031\001\ +\032\001\033\001\034\001\255\255\255\255\255\255\255\255\039\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\050\001\255\255\052\001\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\255\255\255\255\255\255\063\001\ +\064\001\065\001\255\255\255\255\255\255\069\001\255\255\071\001\ +\072\001\255\255\255\255\255\255\076\001\255\255\078\001\255\255\ +\255\255\255\255\255\255\255\255\084\001\085\001\255\255\087\001\ +\255\255\255\255\255\255\255\255\092\001\005\001\006\001\007\001\ +\255\255\255\255\010\001\011\001\012\001\101\001\255\255\255\255\ +\255\255\255\255\106\001\107\001\255\255\109\001\110\001\255\255\ +\255\255\255\255\114\001\255\255\255\255\255\255\030\001\031\001\ +\032\001\033\001\034\001\255\255\255\255\255\255\255\255\039\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\050\001\255\255\052\001\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\255\255\255\255\255\255\063\001\ +\064\001\065\001\255\255\255\255\255\255\069\001\255\255\071\001\ +\072\001\255\255\255\255\255\255\076\001\255\255\078\001\255\255\ +\255\255\255\255\255\255\255\255\084\001\085\001\255\255\087\001\ +\255\255\255\255\255\255\005\001\006\001\007\001\255\255\255\255\ +\255\255\011\001\012\001\255\255\255\255\101\001\255\255\255\255\ +\255\255\255\255\106\001\107\001\022\001\109\001\110\001\255\255\ +\255\255\255\255\114\001\255\255\030\001\031\001\032\001\033\001\ +\034\001\255\255\255\255\255\255\255\255\039\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\050\001\255\255\052\001\053\001\054\001\055\001\056\001\255\255\ +\255\255\059\001\255\255\255\255\255\255\063\001\064\001\065\001\ +\255\255\255\255\255\255\069\001\255\255\071\001\072\001\255\255\ +\255\255\255\255\076\001\255\255\078\001\255\255\255\255\255\255\ +\255\255\255\255\084\001\085\001\255\255\087\001\255\255\255\255\ +\005\001\006\001\007\001\255\255\255\255\255\255\011\001\012\001\ +\255\255\255\255\255\255\101\001\255\255\255\255\255\255\255\255\ +\106\001\107\001\255\255\109\001\110\001\026\001\255\255\255\255\ +\114\001\030\001\031\001\032\001\033\001\034\001\255\255\255\255\ +\255\255\255\255\039\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\054\001\055\001\056\001\255\255\255\255\059\001\255\255\ +\255\255\255\255\063\001\064\001\065\001\255\255\255\255\255\255\ +\069\001\255\255\071\001\072\001\255\255\255\255\255\255\076\001\ +\255\255\078\001\255\255\255\255\255\255\255\255\255\255\084\001\ +\085\001\255\255\087\001\255\255\255\255\005\001\006\001\007\001\ +\255\255\255\255\255\255\011\001\012\001\255\255\255\255\255\255\ +\101\001\255\255\255\255\255\255\255\255\106\001\107\001\255\255\ +\109\001\110\001\255\255\255\255\255\255\114\001\030\001\031\001\ +\032\001\033\001\034\001\255\255\255\255\255\255\255\255\039\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\050\001\255\255\052\001\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\255\255\255\255\255\255\063\001\ +\064\001\065\001\255\255\255\255\255\255\069\001\255\255\071\001\ +\072\001\255\255\255\255\255\255\076\001\255\255\078\001\255\255\ +\255\255\255\255\255\255\255\255\084\001\085\001\255\255\087\001\ +\255\255\255\255\005\001\006\001\007\001\255\255\255\255\255\255\ +\011\001\012\001\255\255\255\255\255\255\101\001\255\255\255\255\ +\255\255\255\255\106\001\107\001\255\255\109\001\110\001\255\255\ +\255\255\255\255\114\001\030\001\031\001\032\001\033\001\034\001\ +\255\255\255\255\255\255\255\255\039\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\050\001\ +\255\255\052\001\053\001\054\001\055\001\056\001\255\255\255\255\ +\059\001\255\255\255\255\255\255\063\001\064\001\065\001\255\255\ +\255\255\255\255\069\001\255\255\071\001\072\001\255\255\255\255\ +\255\255\076\001\255\255\078\001\255\255\255\255\255\255\255\255\ +\255\255\084\001\085\001\255\255\087\001\255\255\255\255\005\001\ +\006\001\007\001\255\255\255\255\255\255\011\001\012\001\255\255\ +\255\255\255\255\101\001\255\255\255\255\255\255\255\255\106\001\ +\107\001\255\255\109\001\110\001\255\255\255\255\255\255\114\001\ +\030\001\031\001\032\001\033\001\034\001\255\255\255\255\255\255\ +\255\255\039\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\050\001\255\255\052\001\053\001\ +\054\001\055\001\056\001\255\255\255\255\059\001\255\255\255\255\ +\255\255\063\001\064\001\065\001\255\255\255\255\255\255\069\001\ +\255\255\071\001\072\001\255\255\255\255\006\001\076\001\255\255\ +\078\001\255\255\255\255\012\001\255\255\014\001\084\001\085\001\ +\017\001\087\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\027\001\255\255\255\255\030\001\031\001\101\001\ +\255\255\255\255\255\255\255\255\106\001\107\001\255\255\109\001\ +\110\001\255\255\255\255\255\255\114\001\255\255\255\255\255\255\ +\255\255\050\001\051\001\255\255\053\001\255\255\055\001\056\001\ +\255\255\255\255\059\001\255\255\255\255\255\255\255\255\064\001\ +\065\001\255\255\006\001\255\255\255\255\255\255\071\001\255\255\ +\012\001\255\255\014\001\255\255\255\255\017\001\255\255\255\255\ +\081\001\255\255\255\255\084\001\255\255\255\255\255\255\027\001\ +\089\001\255\255\030\001\031\001\255\255\006\001\255\255\255\255\ +\097\001\255\255\255\255\012\001\101\001\014\001\255\255\104\001\ +\255\255\106\001\255\255\255\255\109\001\110\001\050\001\051\001\ +\255\255\053\001\255\255\055\001\056\001\030\001\031\001\059\001\ +\255\255\255\255\255\255\255\255\064\001\065\001\255\255\255\255\ +\255\255\255\255\255\255\071\001\255\255\255\255\255\255\255\255\ +\255\255\050\001\051\001\255\255\053\001\081\001\055\001\056\001\ +\084\001\255\255\059\001\255\255\255\255\089\001\255\255\064\001\ +\065\001\255\255\255\255\255\255\255\255\097\001\071\001\255\255\ +\073\001\101\001\255\255\255\255\104\001\255\255\106\001\255\255\ +\081\001\109\001\110\001\084\001\255\255\255\255\006\001\255\255\ +\089\001\255\255\255\255\255\255\012\001\255\255\014\001\255\255\ +\097\001\255\255\255\255\255\255\101\001\255\255\255\255\104\001\ +\255\255\106\001\255\255\027\001\109\001\110\001\030\001\031\001\ +\255\255\006\001\255\255\255\255\255\255\255\255\255\255\012\001\ +\255\255\014\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\050\001\051\001\255\255\053\001\027\001\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\051\001\255\255\ +\053\001\081\001\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\089\001\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\104\001\255\255\106\001\255\255\081\001\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\089\001\255\255\030\001\031\001\ +\255\255\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\104\001\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\051\001\255\255\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\073\001\255\255\255\255\255\255\050\001\051\001\255\255\ +\053\001\081\001\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\089\001\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\104\001\255\255\106\001\255\255\081\001\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\089\001\255\255\030\001\031\001\ +\255\255\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\104\001\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\051\001\255\255\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\051\001\255\255\ +\053\001\081\001\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\089\001\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\104\001\255\255\106\001\255\255\081\001\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\089\001\255\255\030\001\031\001\ +\255\255\255\255\255\255\255\255\097\001\255\255\255\255\255\255\ +\101\001\255\255\255\255\104\001\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\051\001\255\255\053\001\255\255\055\001\ +\056\001\255\255\255\255\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\006\001\255\255\255\255\071\001\ +\255\255\255\255\012\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\081\001\255\255\255\255\084\001\255\255\255\255\255\255\ +\255\255\089\001\028\001\255\255\030\001\031\001\255\255\255\255\ +\255\255\097\001\255\255\255\255\255\255\101\001\255\255\255\255\ +\104\001\255\255\106\001\255\255\255\255\109\001\110\001\255\255\ +\050\001\255\255\052\001\053\001\255\255\055\001\056\001\255\255\ +\255\255\059\001\255\255\255\255\255\255\255\255\064\001\065\001\ +\255\255\255\255\255\255\006\001\255\255\071\001\255\255\010\001\ +\255\255\012\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\084\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\028\001\092\001\030\001\031\001\255\255\255\255\097\001\ +\255\255\255\255\255\255\101\001\255\255\255\255\255\255\255\255\ +\106\001\255\255\255\255\109\001\110\001\255\255\255\255\050\001\ +\255\255\052\001\053\001\255\255\055\001\056\001\255\255\255\255\ +\059\001\255\255\255\255\255\255\255\255\064\001\065\001\255\255\ +\006\001\255\255\255\255\255\255\071\001\255\255\012\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\006\001\007\001\255\255\ +\255\255\084\001\011\001\012\001\255\255\255\255\028\001\255\255\ +\030\001\031\001\255\255\255\255\255\255\255\255\097\001\255\255\ +\255\255\255\255\101\001\255\255\255\255\030\001\031\001\106\001\ +\255\255\255\255\109\001\110\001\050\001\255\255\052\001\053\001\ +\255\255\055\001\056\001\255\255\255\255\059\001\255\255\255\255\ +\255\255\050\001\064\001\065\001\053\001\054\001\055\001\056\001\ +\255\255\071\001\059\001\255\255\006\001\255\255\008\001\064\001\ +\065\001\255\255\012\001\255\255\255\255\255\255\084\001\255\255\ +\255\255\255\255\255\255\076\001\255\255\255\255\092\001\255\255\ +\255\255\255\255\028\001\097\001\030\001\031\001\087\001\101\001\ +\255\255\255\255\255\255\255\255\106\001\255\255\255\255\109\001\ +\110\001\255\255\255\255\255\255\101\001\255\255\255\255\255\255\ +\050\001\106\001\052\001\053\001\109\001\055\001\056\001\255\255\ +\255\255\059\001\255\255\255\255\255\255\255\255\064\001\065\001\ +\255\255\006\001\255\255\255\255\255\255\071\001\255\255\012\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\084\001\255\255\255\255\255\255\255\255\028\001\ +\255\255\030\001\031\001\255\255\255\255\255\255\255\255\097\001\ +\255\255\255\255\255\255\101\001\255\255\255\255\255\255\255\255\ +\106\001\255\255\255\255\109\001\110\001\050\001\255\255\052\001\ +\053\001\255\255\055\001\056\001\255\255\255\255\059\001\255\255\ +\255\255\255\255\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\255\255\071\001\255\255\012\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\084\001\ +\255\255\255\255\255\255\255\255\028\001\255\255\030\001\031\001\ +\255\255\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\255\255\052\001\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\255\255\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\255\255\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\255\255\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\028\001\255\255\030\001\031\001\ +\093\001\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\255\255\052\001\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\255\255\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\255\255\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\255\255\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\030\001\031\001\ +\255\255\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\255\255\052\001\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\052\001\ +\053\001\255\255\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\255\255\255\255\064\001\065\001\255\255\006\001\255\255\ +\255\255\097\001\071\001\255\255\012\001\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\255\255\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\030\001\031\001\ +\255\255\006\001\255\255\255\255\097\001\255\255\255\255\012\001\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\050\001\255\255\255\255\053\001\255\255\055\001\ +\056\001\030\001\031\001\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\255\255\255\255\255\255\255\255\255\255\071\001\ +\255\255\255\255\255\255\255\255\255\255\050\001\255\255\255\255\ +\053\001\255\255\055\001\056\001\084\001\255\255\059\001\255\255\ +\255\255\255\255\255\255\064\001\065\001\255\255\255\255\255\255\ +\255\255\097\001\071\001\255\255\255\255\101\001\006\001\007\001\ +\255\255\255\255\106\001\011\001\012\001\109\001\110\001\084\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\022\001\255\255\ +\255\255\255\255\255\255\255\255\097\001\255\255\030\001\031\001\ +\101\001\255\255\255\255\255\255\255\255\106\001\255\255\255\255\ +\109\001\110\001\255\255\255\255\255\255\255\255\255\255\047\001\ +\255\255\255\255\050\001\051\001\255\255\053\001\054\001\055\001\ +\056\001\255\255\255\255\059\001\255\255\255\255\255\255\255\255\ +\064\001\065\001\006\001\007\001\255\255\255\255\255\255\011\001\ +\012\001\255\255\255\255\255\255\076\001\255\255\255\255\255\255\ +\255\255\081\001\255\255\255\255\255\255\255\255\255\255\087\001\ +\255\255\089\001\030\001\031\001\255\255\255\255\255\255\255\255\ +\255\255\097\001\098\001\255\255\255\255\101\001\255\255\255\255\ +\104\001\255\255\106\001\255\255\255\255\109\001\050\001\051\001\ +\255\255\053\001\054\001\055\001\056\001\255\255\255\255\059\001\ +\255\255\255\255\255\255\255\255\064\001\065\001\006\001\007\001\ +\255\255\255\255\255\255\011\001\012\001\006\001\007\001\255\255\ +\076\001\255\255\011\001\012\001\255\255\081\001\255\255\255\255\ +\255\255\255\255\255\255\087\001\255\255\089\001\030\001\031\001\ +\255\255\255\255\255\255\255\255\255\255\030\001\031\001\255\255\ +\255\255\101\001\255\255\255\255\104\001\255\255\106\001\255\255\ +\255\255\109\001\050\001\255\255\255\255\053\001\054\001\055\001\ +\056\001\050\001\255\255\059\001\053\001\054\001\055\001\056\001\ +\064\001\065\001\059\001\255\255\255\255\255\255\008\001\064\001\ +\065\001\255\255\255\255\255\255\076\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\076\001\255\255\023\001\255\255\087\001\ +\255\255\255\255\255\255\255\255\030\001\255\255\087\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\101\001\255\255\255\255\ +\255\255\255\255\106\001\255\255\101\001\109\001\255\255\255\255\ +\255\255\106\001\255\255\255\255\109\001\055\001\255\255\057\001\ +\058\001\059\001\255\255\061\001\255\255\255\255\064\001\065\001\ +\255\255\255\255\255\255\000\001\001\001\002\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\009\001\255\255\255\255\081\001\ +\255\255\014\001\015\001\016\001\017\001\018\001\088\001\089\001\ +\090\001\255\255\255\255\255\255\255\255\255\255\027\001\097\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\106\001\255\255\255\255\109\001\110\001\042\001\043\001\044\001\ +\045\001\046\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\061\001\255\255\255\255\255\255\255\255\066\001\255\255\255\255\ +\255\255\255\255\071\001\072\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\082\001\083\001\084\001\ +\085\001\086\001\255\255\000\001\001\001\002\001\255\255\255\255\ +\255\255\094\001\007\001\255\255\009\001\255\255\255\255\100\001\ +\255\255\255\255\055\001\016\001\057\001\058\001\059\001\255\255\ +\061\001\255\255\255\255\064\001\065\001\255\255\027\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\036\001\ +\255\255\255\255\255\255\255\255\081\001\042\001\043\001\044\001\ +\045\001\046\001\047\001\255\255\089\001\090\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\097\001\255\255\255\255\255\255\ +\061\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\109\001\110\001\071\001\072\001\255\255\074\001\255\255\255\255\ +\255\255\255\255\000\001\001\001\002\001\082\001\083\001\084\001\ +\085\001\086\001\087\001\009\001\255\255\255\255\255\255\255\255\ +\255\255\015\001\016\001\255\255\018\001\098\001\255\255\100\001\ +\255\255\255\255\255\255\255\255\255\255\027\001\255\255\255\255\ +\255\255\255\255\000\001\001\001\002\001\255\255\036\001\255\255\ +\255\255\255\255\255\255\009\001\042\001\043\001\044\001\045\001\ +\046\001\015\001\016\001\255\255\018\001\255\255\255\255\255\255\ +\055\001\255\255\057\001\058\001\059\001\027\001\061\001\061\001\ +\255\255\064\001\065\001\255\255\066\001\255\255\036\001\255\255\ +\255\255\071\001\072\001\255\255\042\001\043\001\044\001\045\001\ +\046\001\255\255\081\001\255\255\082\001\083\001\084\001\085\001\ +\086\001\255\255\089\001\090\001\255\255\091\001\255\255\061\001\ +\255\255\255\255\097\001\255\255\066\001\255\255\100\001\255\255\ +\255\255\071\001\072\001\255\255\255\255\255\255\109\001\110\001\ +\000\001\001\001\002\001\255\255\082\001\083\001\084\001\085\001\ +\086\001\009\001\255\255\255\255\255\255\255\255\092\001\015\001\ +\016\001\255\255\018\001\255\255\255\255\255\255\100\001\255\255\ +\255\255\255\255\255\255\027\001\255\255\255\255\255\255\255\255\ +\000\001\001\001\002\001\255\255\036\001\255\255\255\255\255\255\ +\255\255\009\001\042\001\043\001\044\001\045\001\046\001\015\001\ +\016\001\255\255\018\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\027\001\255\255\061\001\255\255\255\255\ +\255\255\255\255\066\001\255\255\036\001\255\255\255\255\071\001\ +\072\001\255\255\042\001\043\001\044\001\045\001\046\001\255\255\ +\255\255\255\255\082\001\083\001\084\001\085\001\086\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\061\001\094\001\255\255\ +\255\255\255\255\066\001\255\255\100\001\255\255\255\255\071\001\ +\072\001\255\255\255\255\255\255\255\255\255\255\000\001\001\001\ +\002\001\255\255\082\001\083\001\084\001\085\001\086\001\009\001\ +\255\255\255\255\255\255\091\001\255\255\015\001\016\001\255\255\ +\018\001\255\255\255\255\255\255\100\001\255\255\255\255\255\255\ +\255\255\027\001\255\255\255\255\255\255\255\255\000\001\001\001\ +\002\001\255\255\036\001\255\255\255\255\255\255\255\255\009\001\ +\042\001\043\001\044\001\045\001\046\001\015\001\016\001\255\255\ +\018\001\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\027\001\255\255\061\001\255\255\255\255\255\255\255\255\ +\066\001\255\255\036\001\255\255\255\255\071\001\072\001\255\255\ +\042\001\043\001\044\001\045\001\046\001\255\255\255\255\255\255\ +\082\001\083\001\084\001\085\001\086\001\255\255\255\255\255\255\ +\255\255\255\255\092\001\061\001\255\255\255\255\255\255\255\255\ +\066\001\255\255\100\001\255\255\255\255\071\001\072\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\082\001\083\001\084\001\085\001\086\001\000\001\001\001\002\001\ +\255\255\255\255\255\255\255\255\094\001\255\255\009\001\255\255\ +\255\255\255\255\100\001\255\255\015\001\016\001\255\255\018\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\027\001\255\255\255\255\255\255\255\255\000\001\001\001\002\001\ +\255\255\036\001\255\255\255\255\255\255\255\255\009\001\042\001\ +\043\001\044\001\045\001\046\001\015\001\016\001\255\255\018\001\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\027\001\255\255\061\001\255\255\255\255\255\255\255\255\066\001\ +\255\255\036\001\255\255\255\255\071\001\072\001\255\255\042\001\ +\043\001\044\001\045\001\046\001\255\255\255\255\255\255\082\001\ +\083\001\084\001\085\001\086\001\255\255\255\255\255\255\255\255\ +\091\001\255\255\061\001\255\255\255\255\255\255\255\255\066\001\ +\255\255\100\001\255\255\255\255\071\001\072\001\255\255\255\255\ +\255\255\255\255\255\255\000\001\001\001\002\001\255\255\082\001\ +\083\001\084\001\085\001\086\001\009\001\255\255\255\255\255\255\ +\255\255\092\001\015\001\016\001\255\255\018\001\255\255\255\255\ +\255\255\100\001\255\255\255\255\255\255\255\255\027\001\255\255\ +\255\255\255\255\255\255\000\001\001\001\002\001\255\255\036\001\ +\255\255\255\255\255\255\255\255\009\001\042\001\043\001\044\001\ +\045\001\046\001\015\001\016\001\255\255\018\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\027\001\255\255\ +\061\001\255\255\255\255\255\255\255\255\066\001\255\255\036\001\ +\255\255\255\255\071\001\072\001\255\255\042\001\043\001\044\001\ +\045\001\046\001\255\255\255\255\255\255\082\001\083\001\084\001\ +\085\001\086\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\061\001\094\001\255\255\255\255\255\255\066\001\255\255\100\001\ +\255\255\255\255\071\001\072\001\255\255\255\255\255\255\255\255\ +\255\255\000\001\001\001\002\001\255\255\082\001\083\001\084\001\ +\085\001\086\001\009\001\255\255\255\255\255\255\091\001\255\255\ +\015\001\016\001\255\255\018\001\255\255\255\255\255\255\100\001\ +\255\255\255\255\255\255\255\255\027\001\255\255\255\255\255\255\ +\255\255\000\001\001\001\002\001\255\255\036\001\255\255\255\255\ +\255\255\255\255\009\001\042\001\043\001\044\001\045\001\046\001\ +\015\001\016\001\255\255\018\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\027\001\255\255\061\001\255\255\ +\255\255\255\255\255\255\066\001\255\255\036\001\255\255\255\255\ +\071\001\072\001\255\255\042\001\043\001\044\001\045\001\046\001\ +\255\255\255\255\255\255\082\001\083\001\084\001\085\001\086\001\ +\255\255\255\255\255\255\255\255\255\255\092\001\061\001\001\001\ +\002\001\255\255\255\255\066\001\255\255\100\001\255\255\009\001\ +\071\001\072\001\255\255\255\255\255\255\015\001\016\001\255\255\ +\018\001\255\255\255\255\082\001\083\001\084\001\085\001\086\001\ +\255\255\027\001\255\255\255\255\255\255\255\255\255\255\094\001\ +\255\255\255\255\036\001\255\255\255\255\100\001\255\255\255\255\ +\042\001\043\001\044\001\045\001\046\001\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\061\001\001\001\002\001\255\255\255\255\ +\066\001\255\255\255\255\255\255\009\001\071\001\072\001\255\255\ +\255\255\255\255\015\001\016\001\255\255\018\001\255\255\255\255\ +\082\001\083\001\084\001\085\001\086\001\255\255\027\001\255\255\ +\255\255\255\255\255\255\255\255\255\255\095\001\255\255\036\001\ +\255\255\255\255\100\001\255\255\255\255\042\001\043\001\044\001\ +\045\001\046\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\061\001\001\001\002\001\255\255\255\255\066\001\255\255\255\255\ +\255\255\009\001\071\001\072\001\255\255\255\255\255\255\015\001\ +\016\001\255\255\018\001\255\255\255\255\082\001\083\001\084\001\ +\085\001\086\001\255\255\027\001\255\255\255\255\091\001\255\255\ +\255\255\001\001\002\001\255\255\036\001\255\255\255\255\100\001\ +\255\255\009\001\042\001\043\001\044\001\045\001\046\001\015\001\ +\016\001\255\255\018\001\255\255\255\255\255\255\255\255\255\255\ +\255\255\025\001\255\255\027\001\255\255\061\001\255\255\255\255\ +\255\255\255\255\066\001\255\255\036\001\255\255\255\255\071\001\ +\072\001\255\255\042\001\043\001\044\001\045\001\046\001\255\255\ +\255\255\255\255\082\001\083\001\084\001\085\001\086\001\255\255\ +\255\255\255\255\255\255\091\001\255\255\061\001\001\001\002\001\ +\255\255\255\255\066\001\255\255\100\001\255\255\009\001\071\001\ +\072\001\255\255\255\255\255\255\015\001\016\001\255\255\018\001\ +\255\255\255\255\082\001\083\001\084\001\085\001\086\001\255\255\ +\027\001\255\255\255\255\255\255\255\255\255\255\001\001\002\001\ +\255\255\036\001\255\255\255\255\100\001\255\255\009\001\042\001\ +\043\001\044\001\045\001\046\001\015\001\016\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\027\001\255\255\061\001\255\255\255\255\255\255\255\255\066\001\ +\255\255\036\001\255\255\255\255\071\001\072\001\255\255\042\001\ +\043\001\044\001\045\001\046\001\255\255\255\255\255\255\082\001\ +\083\001\084\001\085\001\086\001\255\255\255\255\255\255\255\255\ +\255\255\255\255\061\001\001\001\002\001\255\255\255\255\066\001\ +\255\255\100\001\255\255\009\001\071\001\072\001\255\255\255\255\ +\255\255\015\001\255\255\255\255\255\255\255\255\255\255\082\001\ +\083\001\084\001\085\001\086\001\255\255\027\001\255\255\255\255\ +\091\001\255\255\255\255\001\001\002\001\255\255\036\001\255\255\ +\255\255\100\001\255\255\255\255\042\001\043\001\044\001\045\001\ +\046\001\015\001\255\255\255\255\255\255\255\255\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\027\001\255\255\061\001\ +\255\255\255\255\255\255\255\255\066\001\255\255\036\001\255\255\ +\255\255\071\001\072\001\255\255\042\001\043\001\044\001\045\001\ +\046\001\013\001\255\255\255\255\082\001\083\001\084\001\085\001\ +\086\001\255\255\255\255\255\255\255\255\255\255\255\255\061\001\ +\028\001\029\001\255\255\255\255\066\001\255\255\100\001\255\255\ +\255\255\071\001\072\001\255\255\255\255\041\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\083\001\084\001\085\001\ +\086\001\255\255\255\255\055\001\255\255\057\001\058\001\059\001\ +\060\001\061\001\255\255\255\255\064\001\065\001\100\001\255\255\ +\068\001\255\255\255\255\255\255\255\255\255\255\074\001\255\255\ +\255\255\255\255\255\255\255\255\080\001\081\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\089\001\090\001\255\255\ +\255\255\255\255\255\255\255\255\096\001\097\001\255\255\255\255\ +\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ +\108\001\109\001\110\001\111\001" + +let yynames_const = "\ + AMPERAMPER\000\ + AMPERSAND\000\ + AND\000\ + AS\000\ + ASSERT\000\ + BACKQUOTE\000\ + BANG\000\ + BAR\000\ + BARBAR\000\ + BARRBRACKET\000\ + BEGIN\000\ + CLASS\000\ + COLON\000\ + COLONCOLON\000\ + COLONEQUAL\000\ + COLONGREATER\000\ + COMMA\000\ + CONSTRAINT\000\ + DO\000\ + DONE\000\ + DOT\000\ + DOTDOT\000\ + DOWNTO\000\ + ELSE\000\ + END\000\ + EOF\000\ + EQUAL\000\ + EXCEPTION\000\ + EXTERNAL\000\ + FALSE\000\ + FOR\000\ + FUN\000\ + FUNCTION\000\ + FUNCTOR\000\ + GREATER\000\ + GREATERRBRACE\000\ + GREATERRBRACKET\000\ + IF\000\ + IN\000\ + INCLUDE\000\ + INHERIT\000\ + INITIALIZER\000\ + LAZY\000\ + LBRACE\000\ + LBRACELESS\000\ + LBRACKET\000\ + LBRACKETBAR\000\ + LBRACKETLESS\000\ + LBRACKETGREATER\000\ + LBRACKETPERCENT\000\ + LBRACKETPERCENTPERCENT\000\ + LESS\000\ + LESSMINUS\000\ + LET\000\ + LPAREN\000\ + LBRACKETAT\000\ + LBRACKETATAT\000\ + LBRACKETATATAT\000\ + MATCH\000\ + METHOD\000\ + MINUS\000\ + MINUSDOT\000\ + MINUSGREATER\000\ + MODULE\000\ + MUTABLE\000\ + NEW\000\ + NONREC\000\ + OBJECT\000\ + OF\000\ + OPEN\000\ + OR\000\ + PERCENT\000\ + PLUS\000\ + PLUSDOT\000\ + PLUSEQ\000\ + PRIVATE\000\ + QUESTION\000\ + QUOTE\000\ + RBRACE\000\ + RBRACKET\000\ + REC\000\ + RPAREN\000\ + SEMI\000\ + SEMISEMI\000\ + HASH\000\ + SIG\000\ + STAR\000\ + STRUCT\000\ + THEN\000\ + TILDE\000\ + TO\000\ + TRUE\000\ + TRY\000\ + TYPE\000\ + UNDERSCORE\000\ + VAL\000\ + VIRTUAL\000\ + WHEN\000\ + WHILE\000\ + WITH\000\ + EOL\000\ + " + +let yynames_block = "\ + CHAR\000\ + FLOAT\000\ + INFIXOP0\000\ + INFIXOP1\000\ + INFIXOP2\000\ + INFIXOP3\000\ + INFIXOP4\000\ + DOTOP\000\ + INT\000\ + LABEL\000\ + LIDENT\000\ + OPTLABEL\000\ + PREFIXOP\000\ + HASHOP\000\ + STRING\000\ + UIDENT\000\ + COMMENT\000\ + DOCSTRING\000\ + " + +let yyact = [| + (fun _ -> failwith "parser") +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'structure) in + Obj.repr( +# 630 "parsing/parser.mly" + ( extra_str 1 _1 ) +# 7030 "parsing/parser.ml" + : Parsetree.structure)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'signature) in + Obj.repr( +# 633 "parsing/parser.mly" + ( extra_sig 1 _1 ) +# 7037 "parsing/parser.ml" + : Parsetree.signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'top_structure) in + Obj.repr( +# 636 "parsing/parser.mly" + ( Ptop_def (extra_str 1 _1) ) +# 7044 "parsing/parser.ml" + : Parsetree.toplevel_phrase)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'toplevel_directive) in + Obj.repr( +# 637 "parsing/parser.mly" + ( _1 ) +# 7051 "parsing/parser.ml" + : Parsetree.toplevel_phrase)) +; (fun __caml_parser_env -> + Obj.repr( +# 638 "parsing/parser.mly" + ( raise End_of_file ) +# 7057 "parsing/parser.ml" + : Parsetree.toplevel_phrase)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 642 "parsing/parser.mly" + ( (text_str 1) @ [mkstrexp _1 _2] ) +# 7065 "parsing/parser.ml" + : 'top_structure)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'top_structure_tail) in + Obj.repr( +# 644 "parsing/parser.mly" + ( _1 ) +# 7072 "parsing/parser.ml" + : 'top_structure)) +; (fun __caml_parser_env -> + Obj.repr( +# 647 "parsing/parser.mly" + ( [] ) +# 7078 "parsing/parser.ml" + : 'top_structure_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'structure_item) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'top_structure_tail) in + Obj.repr( +# 648 "parsing/parser.mly" + ( (text_str 1) @ _1 :: _2 ) +# 7086 "parsing/parser.ml" + : 'top_structure_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_body) in + Obj.repr( +# 651 "parsing/parser.mly" + ( extra_def 1 _1 ) +# 7093 "parsing/parser.ml" + : Parsetree.toplevel_phrase list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 654 "parsing/parser.mly" + ( _1 ) +# 7100 "parsing/parser.ml" + : 'use_file_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'post_item_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 656 "parsing/parser.mly" + ( (text_def 1) @ Ptop_def[mkstrexp _1 _2] :: _3 ) +# 7109 "parsing/parser.ml" + : 'use_file_body)) +; (fun __caml_parser_env -> + Obj.repr( +# 660 "parsing/parser.mly" + ( [] ) +# 7115 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + Obj.repr( +# 662 "parsing/parser.mly" + ( text_def 1 ) +# 7121 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'post_item_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 664 "parsing/parser.mly" + ( mark_rhs_docs 2 3; + (text_def 1) @ (text_def 2) @ Ptop_def[mkstrexp _2 _3] :: _4 ) +# 7131 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'structure_item) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 667 "parsing/parser.mly" + ( (text_def 1) @ (text_def 2) @ Ptop_def[_2] :: _3 ) +# 7139 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'toplevel_directive) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 669 "parsing/parser.mly" + ( mark_rhs_docs 2 3; + (text_def 1) @ (text_def 2) @ _2 :: _3 ) +# 7148 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'structure_item) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 672 "parsing/parser.mly" + ( (text_def 1) @ Ptop_def[_1] :: _2 ) +# 7156 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'toplevel_directive) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'use_file_tail) in + Obj.repr( +# 674 "parsing/parser.mly" + ( mark_rhs_docs 1 1; + (text_def 1) @ _1 :: _2 ) +# 7165 "parsing/parser.ml" + : 'use_file_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + Obj.repr( +# 678 "parsing/parser.mly" + ( _1 ) +# 7172 "parsing/parser.ml" + : Parsetree.core_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 681 "parsing/parser.mly" + ( _1 ) +# 7179 "parsing/parser.ml" + : Parsetree.expression)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 684 "parsing/parser.mly" + ( _1 ) +# 7186 "parsing/parser.ml" + : Parsetree.pattern)) +; (fun __caml_parser_env -> + Obj.repr( +# 691 "parsing/parser.mly" + ( mkrhs "*" 2, None ) +# 7192 "parsing/parser.ml" + : 'functor_arg)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'functor_arg_name) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + Obj.repr( +# 693 "parsing/parser.mly" + ( mkrhs _2 2, Some _4 ) +# 7200 "parsing/parser.ml" + : 'functor_arg)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 697 "parsing/parser.mly" + ( _1 ) +# 7207 "parsing/parser.ml" + : 'functor_arg_name)) +; (fun __caml_parser_env -> + Obj.repr( +# 698 "parsing/parser.mly" + ( "_" ) +# 7213 "parsing/parser.ml" + : 'functor_arg_name)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'functor_args) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'functor_arg) in + Obj.repr( +# 703 "parsing/parser.mly" + ( _2 :: _1 ) +# 7221 "parsing/parser.ml" + : 'functor_args)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'functor_arg) in + Obj.repr( +# 705 "parsing/parser.mly" + ( [ _1 ] ) +# 7228 "parsing/parser.ml" + : 'functor_args)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'mod_longident) in + Obj.repr( +# 710 "parsing/parser.mly" + ( mkmod(Pmod_ident (mkrhs _1 1)) ) +# 7235 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'structure) in + Obj.repr( +# 712 "parsing/parser.mly" + ( mkmod ~attrs:_2 (Pmod_structure(extra_str 3 _3)) ) +# 7243 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'structure) in + Obj.repr( +# 714 "parsing/parser.mly" + ( unclosed "struct" 1 "end" 4 ) +# 7251 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'functor_args) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'module_expr) in + Obj.repr( +# 716 "parsing/parser.mly" + ( let modexp = + List.fold_left + (fun acc (n, t) -> mkmod(Pmod_functor(n, t, acc))) + _5 _3 + in wrap_mod_attrs modexp _2 ) +# 7264 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'paren_module_expr) in + Obj.repr( +# 722 "parsing/parser.mly" + ( mkmod(Pmod_apply(_1, _2)) ) +# 7272 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'module_expr) in + Obj.repr( +# 724 "parsing/parser.mly" + ( mkmod(Pmod_apply(_1, mkmod (Pmod_structure []))) ) +# 7279 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'paren_module_expr) in + Obj.repr( +# 726 "parsing/parser.mly" + ( _1 ) +# 7286 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 728 "parsing/parser.mly" + ( Mod.attr _1 _2 ) +# 7294 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 730 "parsing/parser.mly" + ( mkmod(Pmod_extension _1) ) +# 7301 "parsing/parser.ml" + : 'module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'module_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + Obj.repr( +# 735 "parsing/parser.mly" + ( mkmod(Pmod_constraint(_2, _4)) ) +# 7309 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'module_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + Obj.repr( +# 737 "parsing/parser.mly" + ( unclosed "(" 1 ")" 5 ) +# 7317 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + Obj.repr( +# 739 "parsing/parser.mly" + ( _2 ) +# 7324 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + Obj.repr( +# 741 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 7331 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 743 "parsing/parser.mly" + ( mkmod ~attrs:_3 (Pmod_unpack _4)) +# 7339 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 745 "parsing/parser.mly" + ( mkmod ~attrs:_3 + (Pmod_unpack( + ghexp(Pexp_constraint(_4, ghtyp(Ptyp_package _6))))) ) +# 7350 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : 'expr) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : 'package_type) in + let _8 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 750 "parsing/parser.mly" + ( mkmod ~attrs:_3 + (Pmod_unpack( + ghexp(Pexp_coerce(_4, Some(ghtyp(Ptyp_package _6)), + ghtyp(Ptyp_package _8))))) ) +# 7363 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 755 "parsing/parser.mly" + ( mkmod ~attrs:_3 + (Pmod_unpack( + ghexp(Pexp_coerce(_4, None, ghtyp(Ptyp_package _6))))) ) +# 7374 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + Obj.repr( +# 759 "parsing/parser.mly" + ( unclosed "(" 1 ")" 6 ) +# 7382 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + Obj.repr( +# 761 "parsing/parser.mly" + ( unclosed "(" 1 ")" 6 ) +# 7390 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 763 "parsing/parser.mly" + ( unclosed "(" 1 ")" 5 ) +# 7398 "parsing/parser.ml" + : 'paren_module_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'post_item_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'structure_tail) in + Obj.repr( +# 768 "parsing/parser.mly" + ( mark_rhs_docs 1 2; + (text_str 1) @ mkstrexp _1 _2 :: _3 ) +# 7408 "parsing/parser.ml" + : 'structure)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'structure_tail) in + Obj.repr( +# 770 "parsing/parser.mly" + ( _1 ) +# 7415 "parsing/parser.ml" + : 'structure)) +; (fun __caml_parser_env -> + Obj.repr( +# 773 "parsing/parser.mly" + ( [] ) +# 7421 "parsing/parser.ml" + : 'structure_tail)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'structure) in + Obj.repr( +# 774 "parsing/parser.mly" + ( (text_str 1) @ _2 ) +# 7428 "parsing/parser.ml" + : 'structure_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'structure_item) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'structure_tail) in + Obj.repr( +# 775 "parsing/parser.mly" + ( (text_str 1) @ _1 :: _2 ) +# 7436 "parsing/parser.ml" + : 'structure_tail)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'let_bindings) in + Obj.repr( +# 779 "parsing/parser.mly" + ( val_of_let_bindings _1 ) +# 7443 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'primitive_declaration) in + Obj.repr( +# 781 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_primitive body) ext ) +# 7450 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'value_description) in + Obj.repr( +# 783 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_primitive body) ext ) +# 7457 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_declarations) in + Obj.repr( +# 785 "parsing/parser.mly" + ( let (nr, l, ext ) = _1 in mkstr_ext (Pstr_type (nr, List.rev l)) ext ) +# 7464 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'str_type_extension) in + Obj.repr( +# 787 "parsing/parser.mly" + ( let (l, ext) = _1 in mkstr_ext (Pstr_typext l) ext ) +# 7471 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'str_exception_declaration) in + Obj.repr( +# 789 "parsing/parser.mly" + ( let (l, ext) = _1 in mkstr_ext (Pstr_exception l) ext ) +# 7478 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_binding) in + Obj.repr( +# 791 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_module body) ext ) +# 7485 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'rec_module_bindings) in + Obj.repr( +# 793 "parsing/parser.mly" + ( let (l, ext) = _1 in mkstr_ext (Pstr_recmodule(List.rev l)) ext ) +# 7492 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_type_declaration) in + Obj.repr( +# 795 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_modtype body) ext ) +# 7499 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'open_statement) in + Obj.repr( +# 797 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_open body) ext ) +# 7506 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_declarations) in + Obj.repr( +# 799 "parsing/parser.mly" + ( let (l, ext) = _1 in mkstr_ext (Pstr_class (List.rev l)) ext ) +# 7513 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_type_declarations) in + Obj.repr( +# 801 "parsing/parser.mly" + ( let (l, ext) = _1 in mkstr_ext (Pstr_class_type (List.rev l)) ext ) +# 7520 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'str_include_statement) in + Obj.repr( +# 803 "parsing/parser.mly" + ( let (body, ext) = _1 in mkstr_ext (Pstr_include body) ext ) +# 7527 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'item_extension) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 805 "parsing/parser.mly" + ( mkstr(Pstr_extension (_1, (add_docs_attrs (symbol_docs ()) _2))) ) +# 7535 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'floating_attribute) in + Obj.repr( +# 807 "parsing/parser.mly" + ( mark_symbol_docs (); + mkstr(Pstr_attribute _1) ) +# 7543 "parsing/parser.ml" + : 'structure_item)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 812 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Incl.mk _3 ~attrs:(attrs@_4) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 7555 "parsing/parser.ml" + : 'str_include_statement)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'module_expr) in + Obj.repr( +# 819 "parsing/parser.mly" + ( _2 ) +# 7562 "parsing/parser.ml" + : 'module_binding_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'module_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'module_expr) in + Obj.repr( +# 821 "parsing/parser.mly" + ( mkmod(Pmod_constraint(_4, _2)) ) +# 7570 "parsing/parser.ml" + : 'module_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'functor_arg) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'module_binding_body) in + Obj.repr( +# 823 "parsing/parser.mly" + ( mkmod(Pmod_functor(fst _1, snd _1, _2)) ) +# 7578 "parsing/parser.ml" + : 'module_binding_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_binding_body) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 827 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Mb.mk (mkrhs _3 3) _4 ~attrs:(attrs@_5) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext ) +# 7591 "parsing/parser.ml" + : 'module_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'rec_module_binding) in + Obj.repr( +# 833 "parsing/parser.mly" + ( let (b, ext) = _1 in ([b], ext) ) +# 7598 "parsing/parser.ml" + : 'rec_module_bindings)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'rec_module_bindings) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_module_binding) in + Obj.repr( +# 835 "parsing/parser.mly" + ( let (l, ext) = _1 in (_2 :: l, ext) ) +# 7606 "parsing/parser.ml" + : 'rec_module_bindings)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'module_binding_body) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 839 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Mb.mk (mkrhs _4 4) _5 ~attrs:(attrs@_6) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext ) +# 7619 "parsing/parser.ml" + : 'rec_module_binding)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_binding_body) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 846 "parsing/parser.mly" + ( Mb.mk (mkrhs _3 3) _4 ~attrs:(_2@_5) ~loc:(symbol_rloc ()) + ~text:(symbol_text ()) ~docs:(symbol_docs ()) ) +# 7630 "parsing/parser.ml" + : 'and_module_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'mty_longident) in + Obj.repr( +# 854 "parsing/parser.mly" + ( mkmty(Pmty_ident (mkrhs _1 1)) ) +# 7637 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'signature) in + Obj.repr( +# 856 "parsing/parser.mly" + ( mkmty ~attrs:_2 (Pmty_signature (extra_sig 3 _3)) ) +# 7645 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'signature) in + Obj.repr( +# 858 "parsing/parser.mly" + ( unclosed "sig" 1 "end" 4 ) +# 7653 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'functor_args) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'module_type) in + Obj.repr( +# 861 "parsing/parser.mly" + ( let mty = + List.fold_left + (fun acc (n, t) -> mkmty(Pmty_functor(n, t, acc))) + _5 _3 + in wrap_mty_attrs mty _2 ) +# 7666 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'module_type) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'module_type) in + Obj.repr( +# 868 "parsing/parser.mly" + ( mkmty(Pmty_functor(mknoloc "_", Some _1, _3)) ) +# 7674 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'module_type) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'with_constraints) in + Obj.repr( +# 870 "parsing/parser.mly" + ( mkmty(Pmty_with(_1, List.rev _3)) ) +# 7682 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'module_expr) in + Obj.repr( +# 872 "parsing/parser.mly" + ( mkmty ~attrs:_4 (Pmty_typeof _5) ) +# 7690 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + Obj.repr( +# 876 "parsing/parser.mly" + ( _2 ) +# 7697 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + Obj.repr( +# 878 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 7704 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 880 "parsing/parser.mly" + ( mkmty(Pmty_extension _1) ) +# 7711 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 882 "parsing/parser.mly" + ( Mty.attr _1 _2 ) +# 7719 "parsing/parser.ml" + : 'module_type)) +; (fun __caml_parser_env -> + Obj.repr( +# 885 "parsing/parser.mly" + ( [] ) +# 7725 "parsing/parser.ml" + : 'signature)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'signature) in + Obj.repr( +# 886 "parsing/parser.mly" + ( (text_sig 1) @ _2 ) +# 7732 "parsing/parser.ml" + : 'signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'signature_item) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'signature) in + Obj.repr( +# 887 "parsing/parser.mly" + ( (text_sig 1) @ _1 :: _2 ) +# 7740 "parsing/parser.ml" + : 'signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'value_description) in + Obj.repr( +# 891 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_value body) ext ) +# 7747 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'primitive_declaration) in + Obj.repr( +# 893 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_value body) ext) +# 7754 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_declarations) in + Obj.repr( +# 895 "parsing/parser.mly" + ( let (nr, l, ext) = _1 in mksig_ext (Psig_type (nr, List.rev l)) ext ) +# 7761 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'sig_type_extension) in + Obj.repr( +# 897 "parsing/parser.mly" + ( let (l, ext) = _1 in mksig_ext (Psig_typext l) ext ) +# 7768 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'sig_exception_declaration) in + Obj.repr( +# 899 "parsing/parser.mly" + ( let (l, ext) = _1 in mksig_ext (Psig_exception l) ext ) +# 7775 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_declaration) in + Obj.repr( +# 901 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_module body) ext ) +# 7782 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_alias) in + Obj.repr( +# 903 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_module body) ext ) +# 7789 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'rec_module_declarations) in + Obj.repr( +# 905 "parsing/parser.mly" + ( let (l, ext) = _1 in mksig_ext (Psig_recmodule (List.rev l)) ext ) +# 7796 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_type_declaration) in + Obj.repr( +# 907 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_modtype body) ext ) +# 7803 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'open_statement) in + Obj.repr( +# 909 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_open body) ext ) +# 7810 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'sig_include_statement) in + Obj.repr( +# 911 "parsing/parser.mly" + ( let (body, ext) = _1 in mksig_ext (Psig_include body) ext ) +# 7817 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_descriptions) in + Obj.repr( +# 913 "parsing/parser.mly" + ( let (l, ext) = _1 in mksig_ext (Psig_class (List.rev l)) ext ) +# 7824 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_type_declarations) in + Obj.repr( +# 915 "parsing/parser.mly" + ( let (l, ext) = _1 in mksig_ext (Psig_class_type (List.rev l)) ext ) +# 7831 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'item_extension) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 917 "parsing/parser.mly" + ( mksig(Psig_extension (_1, (add_docs_attrs (symbol_docs ()) _2))) ) +# 7839 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'floating_attribute) in + Obj.repr( +# 919 "parsing/parser.mly" + ( mark_symbol_docs (); + mksig(Psig_attribute _1) ) +# 7847 "parsing/parser.ml" + : 'signature_item)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'override_flag) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'mod_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 924 "parsing/parser.mly" + ( let (ext, attrs) = _3 in + Opn.mk (mkrhs _4 4) ~override:_2 ~attrs:(attrs@_5) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext) +# 7860 "parsing/parser.ml" + : 'open_statement)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 931 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Incl.mk _3 ~attrs:(attrs@_4) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext) +# 7872 "parsing/parser.ml" + : 'sig_include_statement)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'module_type) in + Obj.repr( +# 938 "parsing/parser.mly" + ( _2 ) +# 7879 "parsing/parser.ml" + : 'module_declaration_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'module_type) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'module_declaration_body) in + Obj.repr( +# 940 "parsing/parser.mly" + ( mkmty(Pmty_functor(mkrhs _2 2, Some _4, _6)) ) +# 7888 "parsing/parser.ml" + : 'module_declaration_body)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'module_declaration_body) in + Obj.repr( +# 942 "parsing/parser.mly" + ( mkmty(Pmty_functor(mkrhs "*" 1, None, _3)) ) +# 7895 "parsing/parser.ml" + : 'module_declaration_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_declaration_body) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 946 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Md.mk (mkrhs _3 3) _4 ~attrs:(attrs@_5) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 7908 "parsing/parser.ml" + : 'module_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'mod_longident) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 953 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Md.mk (mkrhs _3 3) + (Mty.alias ~loc:(rhs_loc 5) (mkrhs _5 5)) ~attrs:(attrs@_6) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 7922 "parsing/parser.ml" + : 'module_alias)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'rec_module_declaration) in + Obj.repr( +# 961 "parsing/parser.mly" + ( let (body, ext) = _1 in ([body], ext) ) +# 7929 "parsing/parser.ml" + : 'rec_module_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'rec_module_declarations) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_module_declaration) in + Obj.repr( +# 963 "parsing/parser.mly" + ( let (l, ext) = _1 in (_2 :: l, ext) ) +# 7937 "parsing/parser.ml" + : 'rec_module_declarations)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 967 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Md.mk (mkrhs _4 4) _6 ~attrs:(attrs@_7) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext) +# 7950 "parsing/parser.ml" + : 'rec_module_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'module_type) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 974 "parsing/parser.mly" + ( Md.mk (mkrhs _3 3) _5 ~attrs:(_2@_6) ~loc:(symbol_rloc()) + ~text:(symbol_text()) ~docs:(symbol_docs()) ) +# 7961 "parsing/parser.ml" + : 'and_module_declaration)) +; (fun __caml_parser_env -> + Obj.repr( +# 978 "parsing/parser.mly" + ( None ) +# 7967 "parsing/parser.ml" + : 'module_type_declaration_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'module_type) in + Obj.repr( +# 979 "parsing/parser.mly" + ( Some _2 ) +# 7974 "parsing/parser.ml" + : 'module_type_declaration_body)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'ident) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'module_type_declaration_body) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 984 "parsing/parser.mly" + ( let (ext, attrs) = _3 in + Mtd.mk (mkrhs _4 4) ?typ:_5 ~attrs:(attrs@_6) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 7987 "parsing/parser.ml" + : 'module_type_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_declaration) in + Obj.repr( +# 993 "parsing/parser.mly" + ( let (body, ext) = _1 in ([body], ext) ) +# 7994 "parsing/parser.ml" + : 'class_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_declarations) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_class_declaration) in + Obj.repr( +# 995 "parsing/parser.mly" + ( let (l, ext) = _1 in (_2 :: l, ext) ) +# 8002 "parsing/parser.ml" + : 'class_declarations)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'virtual_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'class_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'class_fun_binding) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1000 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Ci.mk (mkrhs _5 5) _6 ~virt:_3 ~params:_4 ~attrs:(attrs@_7) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext ) +# 8017 "parsing/parser.ml" + : 'class_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'virtual_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'class_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'class_fun_binding) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1008 "parsing/parser.mly" + ( Ci.mk (mkrhs _5 5) _6 ~virt:_3 ~params:_4 + ~attrs:(_2@_7) ~loc:(symbol_rloc ()) + ~text:(symbol_text ()) ~docs:(symbol_docs ()) ) +# 8031 "parsing/parser.ml" + : 'and_class_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_expr) in + Obj.repr( +# 1014 "parsing/parser.mly" + ( _2 ) +# 8038 "parsing/parser.ml" + : 'class_fun_binding)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'class_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'class_expr) in + Obj.repr( +# 1016 "parsing/parser.mly" + ( mkclass(Pcl_constraint(_4, _2)) ) +# 8046 "parsing/parser.ml" + : 'class_fun_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'labeled_simple_pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_fun_binding) in + Obj.repr( +# 1018 "parsing/parser.mly" + ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _2)) ) +# 8054 "parsing/parser.ml" + : 'class_fun_binding)) +; (fun __caml_parser_env -> + Obj.repr( +# 1021 "parsing/parser.mly" + ( [] ) +# 8060 "parsing/parser.ml" + : 'class_type_parameters)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'type_parameter_list) in + Obj.repr( +# 1022 "parsing/parser.mly" + ( List.rev _2 ) +# 8067 "parsing/parser.ml" + : 'class_type_parameters)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'labeled_simple_pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_expr) in + Obj.repr( +# 1026 "parsing/parser.mly" + ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _3)) ) +# 8075 "parsing/parser.ml" + : 'class_fun_def)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'labeled_simple_pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_fun_def) in + Obj.repr( +# 1028 "parsing/parser.mly" + ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _2)) ) +# 8083 "parsing/parser.ml" + : 'class_fun_def)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_simple_expr) in + Obj.repr( +# 1032 "parsing/parser.mly" + ( _1 ) +# 8090 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_fun_def) in + Obj.repr( +# 1034 "parsing/parser.mly" + ( wrap_class_attrs _3 _2 ) +# 8098 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_labeled_expr_list) in + Obj.repr( +# 1036 "parsing/parser.mly" + ( mkclass(Pcl_apply(_1, List.rev _2)) ) +# 8106 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'let_bindings) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_expr) in + Obj.repr( +# 1038 "parsing/parser.mly" + ( class_of_let_bindings _1 _3 ) +# 8114 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'override_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'class_expr) in + Obj.repr( +# 1040 "parsing/parser.mly" + ( wrap_class_attrs (mkclass(Pcl_open(_3, mkrhs _5 5, _7))) _4 ) +# 8124 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 1042 "parsing/parser.mly" + ( Cl.attr _1 _2 ) +# 8132 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 1044 "parsing/parser.mly" + ( mkclass(Pcl_extension _1) ) +# 8139 "parsing/parser.ml" + : 'class_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'core_type_comma_list) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 1048 "parsing/parser.mly" + ( mkclass(Pcl_constr(mkloc _4 (rhs_loc 4), List.rev _2)) ) +# 8147 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 1050 "parsing/parser.mly" + ( mkclass(Pcl_constr(mkrhs _1 1, [])) ) +# 8154 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_structure) in + Obj.repr( +# 1052 "parsing/parser.mly" + ( mkclass ~attrs:_2 (Pcl_structure _3) ) +# 8162 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_structure) in + Obj.repr( +# 1054 "parsing/parser.mly" + ( unclosed "object" 1 "end" 4 ) +# 8170 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'class_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'class_type) in + Obj.repr( +# 1056 "parsing/parser.mly" + ( mkclass(Pcl_constraint(_2, _4)) ) +# 8178 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'class_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'class_type) in + Obj.repr( +# 1058 "parsing/parser.mly" + ( unclosed "(" 1 ")" 5 ) +# 8186 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'class_expr) in + Obj.repr( +# 1060 "parsing/parser.mly" + ( _2 ) +# 8193 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'class_expr) in + Obj.repr( +# 1062 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 8200 "parsing/parser.ml" + : 'class_simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_self_pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_fields) in + Obj.repr( +# 1066 "parsing/parser.mly" + ( Cstr.mk _1 (extra_cstr 2 (List.rev _2)) ) +# 8208 "parsing/parser.ml" + : 'class_structure)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 1070 "parsing/parser.mly" + ( reloc_pat _2 ) +# 8215 "parsing/parser.ml" + : 'class_self_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + Obj.repr( +# 1072 "parsing/parser.mly" + ( mkpat(Ppat_constraint(_2, _4)) ) +# 8223 "parsing/parser.ml" + : 'class_self_pattern)) +; (fun __caml_parser_env -> + Obj.repr( +# 1074 "parsing/parser.mly" + ( ghpat(Ppat_any) ) +# 8229 "parsing/parser.ml" + : 'class_self_pattern)) +; (fun __caml_parser_env -> + Obj.repr( +# 1078 "parsing/parser.mly" + ( [] ) +# 8235 "parsing/parser.ml" + : 'class_fields)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_fields) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_field) in + Obj.repr( +# 1080 "parsing/parser.mly" + ( _2 :: (text_cstr 2) @ _1 ) +# 8243 "parsing/parser.ml" + : 'class_fields)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'override_flag) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'class_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'parent_binder) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1085 "parsing/parser.mly" + ( mkcf (Pcf_inherit (_2, _4, _5)) ~attrs:(_3@_6) ~docs:(symbol_docs ()) ) +# 8254 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'value) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1087 "parsing/parser.mly" + ( let v, attrs = _2 in + mkcf (Pcf_val v) ~attrs:(attrs@_3) ~docs:(symbol_docs ()) ) +# 8263 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'method_) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1090 "parsing/parser.mly" + ( let meth, attrs = _2 in + mkcf (Pcf_method meth) ~attrs:(attrs@_3) ~docs:(symbol_docs ()) ) +# 8272 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'constrain_field) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1093 "parsing/parser.mly" + ( mkcf (Pcf_constraint _3) ~attrs:(_2@_4) ~docs:(symbol_docs ()) ) +# 8281 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1095 "parsing/parser.mly" + ( mkcf (Pcf_initializer _3) ~attrs:(_2@_4) ~docs:(symbol_docs ()) ) +# 8290 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'item_extension) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1097 "parsing/parser.mly" + ( mkcf (Pcf_extension _1) ~attrs:_2 ~docs:(symbol_docs ()) ) +# 8298 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'floating_attribute) in + Obj.repr( +# 1099 "parsing/parser.mly" + ( mark_symbol_docs (); + mkcf (Pcf_attribute _1) ) +# 8306 "parsing/parser.ml" + : 'class_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 1104 "parsing/parser.mly" + ( Some (mkrhs _2 2) ) +# 8313 "parsing/parser.ml" + : 'parent_binder)) +; (fun __caml_parser_env -> + Obj.repr( +# 1106 "parsing/parser.mly" + ( None ) +# 8319 "parsing/parser.ml" + : 'parent_binder)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1111 "parsing/parser.mly" + ( if _1 = Override then syntax_error (); + (mkloc _5 (rhs_loc 5), Mutable, Cfk_virtual _7), _2 ) +# 8330 "parsing/parser.ml" + : 'value)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'mutable_flag) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1114 "parsing/parser.mly" + ( if _1 = Override then syntax_error (); + (mkrhs _5 5, _4, Cfk_virtual _7), _2 ) +# 8342 "parsing/parser.ml" + : 'value)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'mutable_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1117 "parsing/parser.mly" + ( (mkrhs _4 4, _3, Cfk_concrete (_1, _6)), _2 ) +# 8353 "parsing/parser.ml" + : 'value)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mutable_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'label) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'type_constraint) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1119 "parsing/parser.mly" + ( + let e = mkexp_constraint _7 _5 in + (mkrhs _4 4, _3, Cfk_concrete (_1, e)), _2 + ) +# 8368 "parsing/parser.ml" + : 'value)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'poly_type) in + Obj.repr( +# 1127 "parsing/parser.mly" + ( if _1 = Override then syntax_error (); + (mkloc _5 (rhs_loc 5), Private, Cfk_virtual _7), _2 ) +# 8379 "parsing/parser.ml" + : 'method_)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'private_flag) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'poly_type) in + Obj.repr( +# 1130 "parsing/parser.mly" + ( if _1 = Override then syntax_error (); + (mkloc _5 (rhs_loc 5), _4, Cfk_virtual _7), _2 ) +# 8391 "parsing/parser.ml" + : 'method_)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'private_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'label) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'strict_binding) in + Obj.repr( +# 1133 "parsing/parser.mly" + ( (mkloc _4 (rhs_loc 4), _3, + Cfk_concrete (_1, ghexp(Pexp_poly (_5, None)))), _2 ) +# 8403 "parsing/parser.ml" + : 'method_)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 7 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'private_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'label) in + let _6 = (Parsing.peek_val __caml_parser_env 2 : 'poly_type) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1136 "parsing/parser.mly" + ( (mkloc _4 (rhs_loc 4), _3, + Cfk_concrete (_1, ghexp(Pexp_poly(_8, Some _6)))), _2 ) +# 8416 "parsing/parser.ml" + : 'method_)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 10 : 'override_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 9 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 8 : 'private_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 7 : 'label) in + let _7 = (Parsing.peek_val __caml_parser_env 4 : 'lident_list) in + let _9 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _11 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1140 "parsing/parser.mly" + ( let exp, poly = wrap_type_annotation _7 _9 _11 in + (mkloc _4 (rhs_loc 4), _3, + Cfk_concrete (_1, ghexp(Pexp_poly(exp, Some poly)))), _2 ) +# 8431 "parsing/parser.ml" + : 'method_)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_signature) in + Obj.repr( +# 1149 "parsing/parser.mly" + ( _1 ) +# 8438 "parsing/parser.ml" + : 'class_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type_or_tuple) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'class_type) in + Obj.repr( +# 1152 "parsing/parser.mly" + ( mkcty(Pcty_arrow(Optional _2 , _4, _6)) ) +# 8447 "parsing/parser.ml" + : 'class_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type_or_tuple) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'class_type) in + Obj.repr( +# 1154 "parsing/parser.mly" + ( mkcty(Pcty_arrow(Optional _1, _2, _4)) ) +# 8456 "parsing/parser.ml" + : 'class_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type_or_tuple) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'class_type) in + Obj.repr( +# 1156 "parsing/parser.mly" + ( mkcty(Pcty_arrow(Labelled _1, _3, _5)) ) +# 8465 "parsing/parser.ml" + : 'class_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type_or_tuple) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_type) in + Obj.repr( +# 1158 "parsing/parser.mly" + ( mkcty(Pcty_arrow(Nolabel, _1, _3)) ) +# 8473 "parsing/parser.ml" + : 'class_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'core_type_comma_list) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'clty_longident) in + Obj.repr( +# 1162 "parsing/parser.mly" + ( mkcty(Pcty_constr (mkloc _4 (rhs_loc 4), List.rev _2)) ) +# 8481 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'clty_longident) in + Obj.repr( +# 1164 "parsing/parser.mly" + ( mkcty(Pcty_constr (mkrhs _1 1, [])) ) +# 8488 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_sig_body) in + Obj.repr( +# 1166 "parsing/parser.mly" + ( mkcty ~attrs:_2 (Pcty_signature _3) ) +# 8496 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_sig_body) in + Obj.repr( +# 1168 "parsing/parser.mly" + ( unclosed "object" 1 "end" 4 ) +# 8504 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_signature) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 1170 "parsing/parser.mly" + ( Cty.attr _1 _2 ) +# 8512 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 1172 "parsing/parser.mly" + ( mkcty(Pcty_extension _1) ) +# 8519 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'override_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'class_signature) in + Obj.repr( +# 1174 "parsing/parser.mly" + ( wrap_class_type_attrs (mkcty(Pcty_open(_3, mkrhs _5 5, _7))) _4 ) +# 8529 "parsing/parser.ml" + : 'class_signature)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_self_type) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_sig_fields) in + Obj.repr( +# 1178 "parsing/parser.mly" + ( Csig.mk _1 (extra_csig 2 (List.rev _2)) ) +# 8537 "parsing/parser.ml" + : 'class_sig_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + Obj.repr( +# 1182 "parsing/parser.mly" + ( _2 ) +# 8544 "parsing/parser.ml" + : 'class_self_type)) +; (fun __caml_parser_env -> + Obj.repr( +# 1184 "parsing/parser.mly" + ( mktyp(Ptyp_any) ) +# 8550 "parsing/parser.ml" + : 'class_self_type)) +; (fun __caml_parser_env -> + Obj.repr( +# 1187 "parsing/parser.mly" + ( [] ) +# 8556 "parsing/parser.ml" + : 'class_sig_fields)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_sig_fields) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_sig_field) in + Obj.repr( +# 1188 "parsing/parser.mly" + ( _2 :: (text_csig 2) @ _1 ) +# 8564 "parsing/parser.ml" + : 'class_sig_fields)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_signature) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1192 "parsing/parser.mly" + ( mkctf (Pctf_inherit _3) ~attrs:(_2@_4) ~docs:(symbol_docs ()) ) +# 8573 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'value_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1194 "parsing/parser.mly" + ( mkctf (Pctf_val _3) ~attrs:(_2@_4) ~docs:(symbol_docs ()) ) +# 8582 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'private_virtual_flags) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'label) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'poly_type) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1197 "parsing/parser.mly" + ( + let (p, v) = _3 in + mkctf (Pctf_method (mkrhs _4 4, p, v, _6)) ~attrs:(_2@_7) ~docs:(symbol_docs ()) + ) +# 8596 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'constrain_field) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1202 "parsing/parser.mly" + ( mkctf (Pctf_constraint _3) ~attrs:(_2@_4) ~docs:(symbol_docs ()) ) +# 8605 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'item_extension) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1204 "parsing/parser.mly" + ( mkctf (Pctf_extension _1) ~attrs:_2 ~docs:(symbol_docs ()) ) +# 8613 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'floating_attribute) in + Obj.repr( +# 1206 "parsing/parser.mly" + ( mark_symbol_docs (); + mkctf(Pctf_attribute _1) ) +# 8621 "parsing/parser.ml" + : 'class_sig_field)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'mutable_flag) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1211 "parsing/parser.mly" + ( mkrhs _3 3, _2, Virtual, _5 ) +# 8630 "parsing/parser.ml" + : 'value_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'virtual_flag) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1213 "parsing/parser.mly" + ( mkrhs _3 3, Mutable, _2, _5 ) +# 8639 "parsing/parser.ml" + : 'value_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1215 "parsing/parser.mly" + ( mkrhs _1 1, Immutable, Concrete, _3 ) +# 8647 "parsing/parser.ml" + : 'value_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1218 "parsing/parser.mly" + ( _1, _3, symbol_rloc() ) +# 8655 "parsing/parser.ml" + : 'constrain)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1221 "parsing/parser.mly" + ( _1, _3 ) +# 8663 "parsing/parser.ml" + : 'constrain_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_description) in + Obj.repr( +# 1225 "parsing/parser.mly" + ( let (body, ext) = _1 in ([body],ext) ) +# 8670 "parsing/parser.ml" + : 'class_descriptions)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_descriptions) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_class_description) in + Obj.repr( +# 1227 "parsing/parser.mly" + ( let (l, ext) = _1 in (_2 :: l, ext) ) +# 8678 "parsing/parser.ml" + : 'class_descriptions)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'virtual_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'class_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _7 = (Parsing.peek_val __caml_parser_env 1 : 'class_type) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1232 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Ci.mk (mkrhs _5 5) _7 ~virt:_3 ~params:_4 ~attrs:(attrs @ _8) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext ) +# 8693 "parsing/parser.ml" + : 'class_description)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'virtual_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'class_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _7 = (Parsing.peek_val __caml_parser_env 1 : 'class_type) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1240 "parsing/parser.mly" + ( Ci.mk (mkrhs _5 5) _7 ~virt:_3 ~params:_4 + ~attrs:(_2@_8) ~loc:(symbol_rloc ()) + ~text:(symbol_text ()) ~docs:(symbol_docs ()) ) +# 8707 "parsing/parser.ml" + : 'and_class_description)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_type_declaration) in + Obj.repr( +# 1246 "parsing/parser.mly" + ( let (body, ext) = _1 in ([body],ext) ) +# 8714 "parsing/parser.ml" + : 'class_type_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'class_type_declarations) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_class_type_declaration) in + Obj.repr( +# 1248 "parsing/parser.mly" + ( let (l, ext) = _1 in (_2 :: l, ext) ) +# 8722 "parsing/parser.ml" + : 'class_type_declarations)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : 'virtual_flag) in + let _5 = (Parsing.peek_val __caml_parser_env 4 : 'class_type_parameters) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _8 = (Parsing.peek_val __caml_parser_env 1 : 'class_signature) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1253 "parsing/parser.mly" + ( let (ext, attrs) = _3 in + Ci.mk (mkrhs _6 6) _8 ~virt:_4 ~params:_5 ~attrs:(attrs@_9) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext) +# 8737 "parsing/parser.ml" + : 'class_type_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'virtual_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'class_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _7 = (Parsing.peek_val __caml_parser_env 1 : 'class_signature) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1261 "parsing/parser.mly" + ( Ci.mk (mkrhs _5 5) _7 ~virt:_3 ~params:_4 + ~attrs:(_2@_8) ~loc:(symbol_rloc ()) + ~text:(symbol_text ()) ~docs:(symbol_docs ()) ) +# 8751 "parsing/parser.ml" + : 'and_class_type_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1269 "parsing/parser.mly" + ( _1 ) +# 8758 "parsing/parser.ml" + : 'seq_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1270 "parsing/parser.mly" + ( _1 ) +# 8765 "parsing/parser.ml" + : 'seq_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1271 "parsing/parser.mly" + ( mkexp(Pexp_sequence(_1, _3)) ) +# 8773 "parsing/parser.ml" + : 'seq_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'attr_id) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1273 "parsing/parser.mly" + ( let seq = mkexp(Pexp_sequence (_1, _5)) in + let payload = PStr [mkstrexp seq []] in + mkexp (Pexp_extension (_4, payload)) ) +# 8784 "parsing/parser.ml" + : 'seq_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'label_let_pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'opt_default) in + Obj.repr( +# 1279 "parsing/parser.mly" + ( (Optional (fst _3), _4, snd _3) ) +# 8792 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'label_var) in + Obj.repr( +# 1281 "parsing/parser.mly" + ( (Optional (fst _2), None, snd _2) ) +# 8799 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'let_pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'opt_default) in + Obj.repr( +# 1283 "parsing/parser.mly" + ( (Optional _1, _4, _3) ) +# 8808 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'pattern_var) in + Obj.repr( +# 1285 "parsing/parser.mly" + ( (Optional _1, None, _2) ) +# 8816 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'label_let_pattern) in + Obj.repr( +# 1287 "parsing/parser.mly" + ( (Labelled (fst _3), None, snd _3) ) +# 8823 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'label_var) in + Obj.repr( +# 1289 "parsing/parser.mly" + ( (Labelled (fst _2), None, snd _2) ) +# 8830 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_pattern) in + Obj.repr( +# 1291 "parsing/parser.mly" + ( (Labelled _1, None, _2) ) +# 8838 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_pattern) in + Obj.repr( +# 1293 "parsing/parser.mly" + ( (Nolabel, None, _1) ) +# 8845 "parsing/parser.ml" + : 'labeled_simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 1296 "parsing/parser.mly" + ( mkpat(Ppat_var (mkrhs _1 1)) ) +# 8852 "parsing/parser.ml" + : 'pattern_var)) +; (fun __caml_parser_env -> + Obj.repr( +# 1297 "parsing/parser.mly" + ( mkpat Ppat_any ) +# 8858 "parsing/parser.ml" + : 'pattern_var)) +; (fun __caml_parser_env -> + Obj.repr( +# 1300 "parsing/parser.mly" + ( None ) +# 8864 "parsing/parser.ml" + : 'opt_default)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1301 "parsing/parser.mly" + ( Some _2 ) +# 8871 "parsing/parser.ml" + : 'opt_default)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'label_var) in + Obj.repr( +# 1305 "parsing/parser.mly" + ( _1 ) +# 8878 "parsing/parser.ml" + : 'label_let_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'label_var) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1307 "parsing/parser.mly" + ( let (lab, pat) = _1 in (lab, mkpat(Ppat_constraint(pat, _3))) ) +# 8886 "parsing/parser.ml" + : 'label_let_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 1310 "parsing/parser.mly" + ( (_1, mkpat(Ppat_var (mkrhs _1 1))) ) +# 8893 "parsing/parser.ml" + : 'label_var)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1314 "parsing/parser.mly" + ( _1 ) +# 8900 "parsing/parser.ml" + : 'let_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1316 "parsing/parser.mly" + ( mkpat(Ppat_constraint(_1, _3)) ) +# 8908 "parsing/parser.ml" + : 'let_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1320 "parsing/parser.mly" + ( _1 ) +# 8915 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_labeled_expr_list) in + Obj.repr( +# 1322 "parsing/parser.mly" + ( mkexp(Pexp_apply(_1, List.rev _2)) ) +# 8923 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'let_bindings) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1324 "parsing/parser.mly" + ( expr_of_let_bindings _1 _3 ) +# 8931 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'module_binding_body) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1326 "parsing/parser.mly" + ( mkexp_attrs (Pexp_letmodule(mkrhs _4 4, _5, _7)) _3 ) +# 8941 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'let_exception_declaration) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1328 "parsing/parser.mly" + ( mkexp_attrs (Pexp_letexception(_4, _6)) _3 ) +# 8950 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'override_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1330 "parsing/parser.mly" + ( mkexp_attrs (Pexp_open(_3, mkrhs _5 5, _7)) _4 ) +# 8960 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_bar) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'match_cases) in + Obj.repr( +# 1332 "parsing/parser.mly" + ( mkexp_attrs (Pexp_function(List.rev _4)) _2 ) +# 8969 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'labeled_simple_pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'fun_def) in + Obj.repr( +# 1334 "parsing/parser.mly" + ( let (l,o,p) = _3 in + mkexp_attrs (Pexp_fun(l, o, p, _4)) _2 ) +# 8979 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'ext_attributes) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'lident_list) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'fun_def) in + Obj.repr( +# 1337 "parsing/parser.mly" + ( mkexp_attrs (mk_newtypes _5 _7).pexp_desc _2 ) +# 8988 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_bar) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'match_cases) in + Obj.repr( +# 1339 "parsing/parser.mly" + ( mkexp_attrs (Pexp_match(_3, List.rev _6)) _2 ) +# 8998 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_bar) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'match_cases) in + Obj.repr( +# 1341 "parsing/parser.mly" + ( mkexp_attrs (Pexp_try(_3, List.rev _6)) _2 ) +# 9008 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + Obj.repr( +# 1343 "parsing/parser.mly" + ( syntax_error() ) +# 9016 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'expr_comma_list) in + Obj.repr( +# 1345 "parsing/parser.mly" + ( mkexp(Pexp_tuple(List.rev _1)) ) +# 9023 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'constr_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1347 "parsing/parser.mly" + ( mkexp(Pexp_construct(mkrhs _1 1, Some _2)) ) +# 9031 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'name_tag) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1349 "parsing/parser.mly" + ( mkexp(Pexp_variant(_1, Some _2)) ) +# 9039 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1351 "parsing/parser.mly" + ( mkexp_attrs(Pexp_ifthenelse(_3, _5, Some _7)) _2 ) +# 9049 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1353 "parsing/parser.mly" + ( mkexp_attrs (Pexp_ifthenelse(_3, _5, None)) _2 ) +# 9058 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1355 "parsing/parser.mly" + ( mkexp_attrs (Pexp_while(_3, _5)) _2 ) +# 9067 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 8 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 7 : 'pattern) in + let _5 = (Parsing.peek_val __caml_parser_env 5 : 'seq_expr) in + let _6 = (Parsing.peek_val __caml_parser_env 4 : 'direction_flag) in + let _7 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _9 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1358 "parsing/parser.mly" + ( mkexp_attrs(Pexp_for(_3, _5, _7, _6, _9)) _2 ) +# 9079 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1360 "parsing/parser.mly" + ( mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[_1;_3])) (symbol_rloc()) ) +# 9087 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1362 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9096 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1364 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9105 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1366 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9114 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1368 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9123 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1370 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9132 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1372 "parsing/parser.mly" + ( mkinfix _1 "+" _3 ) +# 9140 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1374 "parsing/parser.mly" + ( mkinfix _1 "+." _3 ) +# 9148 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1376 "parsing/parser.mly" + ( mkinfix _1 "+=" _3 ) +# 9156 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1378 "parsing/parser.mly" + ( mkinfix _1 "-" _3 ) +# 9164 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1380 "parsing/parser.mly" + ( mkinfix _1 "-." _3 ) +# 9172 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1382 "parsing/parser.mly" + ( mkinfix _1 "*" _3 ) +# 9180 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1384 "parsing/parser.mly" + ( mkinfix _1 "%" _3 ) +# 9188 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1386 "parsing/parser.mly" + ( mkinfix _1 "=" _3 ) +# 9196 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1388 "parsing/parser.mly" + ( mkinfix _1 "<" _3 ) +# 9204 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1390 "parsing/parser.mly" + ( mkinfix _1 ">" _3 ) +# 9212 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1392 "parsing/parser.mly" + ( mkinfix _1 "or" _3 ) +# 9220 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1394 "parsing/parser.mly" + ( mkinfix _1 "||" _3 ) +# 9228 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1396 "parsing/parser.mly" + ( mkinfix _1 "&" _3 ) +# 9236 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1398 "parsing/parser.mly" + ( mkinfix _1 "&&" _3 ) +# 9244 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1400 "parsing/parser.mly" + ( mkinfix _1 ":=" _3 ) +# 9252 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'subtractive) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1402 "parsing/parser.mly" + ( mkuminus _1 _2 ) +# 9260 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'additive) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1404 "parsing/parser.mly" + ( mkuplus _1 _2 ) +# 9268 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'label_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1406 "parsing/parser.mly" + ( mkexp(Pexp_setfield(_1, mkrhs _3 3, _5)) ) +# 9277 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1408 "parsing/parser.mly" + ( mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "set")), + [Nolabel,_1; Nolabel,_4; Nolabel,_7])) ) +# 9287 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'seq_expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1411 "parsing/parser.mly" + ( mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "set")), + [Nolabel,_1; Nolabel,_4; Nolabel,_7])) ) +# 9297 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1414 "parsing/parser.mly" + ( bigarray_set _1 _4 _7 ) +# 9306 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1416 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "[]<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _4; Nolabel, _7]) ) +# 9317 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1419 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "()<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _4; Nolabel, _7]) ) +# 9328 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1422 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "{}<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _4; Nolabel, _7]) ) +# 9339 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 8 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1425 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3,"." ^ _4 ^ "[]<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _6; Nolabel, _9]) ) +# 9351 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 8 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1428 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3, "." ^ _4 ^ "()<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _6; Nolabel, _9]) ) +# 9363 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 8 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : 'expr) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1431 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3, "." ^ _4 ^ "{}<-")) in + mkexp @@ Pexp_apply(id , [Nolabel, _1; Nolabel, _6; Nolabel, _9]) ) +# 9375 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1434 "parsing/parser.mly" + ( mkexp(Pexp_setinstvar(mkrhs _1 1, _3)) ) +# 9383 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1436 "parsing/parser.mly" + ( mkexp_attrs (Pexp_assert _3) _2 ) +# 9391 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1438 "parsing/parser.mly" + ( mkexp_attrs (Pexp_lazy _3) _2 ) +# 9399 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_structure) in + Obj.repr( +# 1440 "parsing/parser.mly" + ( mkexp_attrs (Pexp_object _3) _2 ) +# 9407 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'class_structure) in + Obj.repr( +# 1442 "parsing/parser.mly" + ( unclosed "object" 1 "end" 4 ) +# 9415 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 1444 "parsing/parser.mly" + ( Exp.attr _1 _2 ) +# 9423 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + Obj.repr( +# 1446 "parsing/parser.mly" + ( not_expecting 1 "wildcard \"_\"" ) +# 9429 "parsing/parser.ml" + : 'expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'val_longident) in + Obj.repr( +# 1450 "parsing/parser.mly" + ( mkexp(Pexp_ident (mkrhs _1 1)) ) +# 9436 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'constant) in + Obj.repr( +# 1452 "parsing/parser.mly" + ( mkexp(Pexp_constant _1) ) +# 9443 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'constr_longident) in + Obj.repr( +# 1454 "parsing/parser.mly" + ( mkexp(Pexp_construct(mkrhs _1 1, None)) ) +# 9450 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'name_tag) in + Obj.repr( +# 1456 "parsing/parser.mly" + ( mkexp(Pexp_variant(_1, None)) ) +# 9457 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1458 "parsing/parser.mly" + ( reloc_exp _2 ) +# 9464 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1460 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 9471 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1462 "parsing/parser.mly" + ( wrap_exp_attrs (reloc_exp _3) _2 (* check location *) ) +# 9479 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + Obj.repr( +# 1464 "parsing/parser.mly" + ( mkexp_attrs (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()), + None)) _2 ) +# 9487 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1467 "parsing/parser.mly" + ( unclosed "begin" 1 "end" 4 ) +# 9495 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'type_constraint) in + Obj.repr( +# 1469 "parsing/parser.mly" + ( mkexp_constraint _2 _3 ) +# 9503 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'label_longident) in + Obj.repr( +# 1471 "parsing/parser.mly" + ( mkexp(Pexp_field(_1, mkrhs _3 3)) ) +# 9511 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1473 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, _4)) ) +# 9519 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1475 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, + mkexp(Pexp_construct(mkrhs (Lident "()") 1, None)))) ) +# 9527 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1478 "parsing/parser.mly" + ( unclosed "(" 3 ")" 5 ) +# 9535 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1480 "parsing/parser.mly" + ( mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "get")), + [Nolabel,_1; Nolabel,_4])) ) +# 9544 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1483 "parsing/parser.mly" + ( unclosed "(" 3 ")" 5 ) +# 9552 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1485 "parsing/parser.mly" + ( mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "get")), + [Nolabel,_1; Nolabel,_4])) ) +# 9561 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'seq_expr) in + Obj.repr( +# 1488 "parsing/parser.mly" + ( unclosed "[" 3 "]" 5 ) +# 9569 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1490 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "[]")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _4]) ) +# 9579 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1493 "parsing/parser.mly" + ( unclosed "[" 3 "]" 5 ) +# 9588 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1495 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "()")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _4]) ) +# 9598 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1498 "parsing/parser.mly" + ( unclosed "(" 3 ")" 5 ) +# 9607 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1500 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Lident ("." ^ _2 ^ "{}")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _4]) ) +# 9617 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1503 "parsing/parser.mly" + ( unclosed "{" 3 "}" 5 ) +# 9626 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1505 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3, "." ^ _4 ^ "[]")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _6]) ) +# 9637 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1508 "parsing/parser.mly" + ( unclosed "[" 5 "]" 7 ) +# 9647 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1510 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3, "." ^ _4 ^ "()")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _6]) ) +# 9658 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1513 "parsing/parser.mly" + ( unclosed "(" 5 ")" 7 ) +# 9668 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1515 "parsing/parser.mly" + ( let id = mkexp @@ Pexp_ident( ghloc @@ Ldot(_3, "." ^ _4 ^ "{}")) in + mkexp @@ Pexp_apply(id, [Nolabel, _1; Nolabel, _6]) ) +# 9679 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1518 "parsing/parser.mly" + ( unclosed "{" 5 "}" 7 ) +# 9689 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr) in + Obj.repr( +# 1520 "parsing/parser.mly" + ( bigarray_get _1 _4 ) +# 9697 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_expr) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'expr_comma_list) in + Obj.repr( +# 1522 "parsing/parser.mly" + ( unclosed "{" 3 "}" 5 ) +# 9705 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'record_expr) in + Obj.repr( +# 1524 "parsing/parser.mly" + ( let (exten, fields) = _2 in mkexp (Pexp_record(fields, exten)) ) +# 9712 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'record_expr) in + Obj.repr( +# 1526 "parsing/parser.mly" + ( unclosed "{" 1 "}" 3 ) +# 9719 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'record_expr) in + Obj.repr( +# 1528 "parsing/parser.mly" + ( let (exten, fields) = _4 in + let rec_exp = mkexp(Pexp_record(fields, exten)) in + mkexp(Pexp_open(Fresh, mkrhs _1 1, rec_exp)) ) +# 9729 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'record_expr) in + Obj.repr( +# 1532 "parsing/parser.mly" + ( unclosed "{" 3 "}" 5 ) +# 9737 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1534 "parsing/parser.mly" + ( mkexp (Pexp_array(List.rev _2)) ) +# 9745 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1536 "parsing/parser.mly" + ( unclosed "[|" 1 "|]" 4 ) +# 9753 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + Obj.repr( +# 1538 "parsing/parser.mly" + ( mkexp (Pexp_array []) ) +# 9759 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1540 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, mkexp(Pexp_array(List.rev _4)))) ) +# 9768 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1542 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, mkexp(Pexp_array []))) ) +# 9775 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1544 "parsing/parser.mly" + ( unclosed "[|" 3 "|]" 6 ) +# 9784 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1546 "parsing/parser.mly" + ( reloc_exp (mktailexp (rhs_loc 4) (List.rev _2)) ) +# 9792 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1548 "parsing/parser.mly" + ( unclosed "[" 1 "]" 4 ) +# 9800 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1550 "parsing/parser.mly" + ( let list_exp = reloc_exp (mktailexp (rhs_loc 6) (List.rev _4)) in + mkexp(Pexp_open(Fresh, mkrhs _1 1, list_exp)) ) +# 9810 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1553 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, + mkexp(Pexp_construct(mkrhs (Lident "[]") 1, None)))) ) +# 9818 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1556 "parsing/parser.mly" + ( unclosed "[" 3 "]" 6 ) +# 9827 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1558 "parsing/parser.mly" + ( mkexp(Pexp_apply(mkoperator _1 1, [Nolabel,_2])) ) +# 9835 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1560 "parsing/parser.mly" + ( mkexp(Pexp_apply(mkoperator "!" 1, [Nolabel,_2])) ) +# 9842 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 1562 "parsing/parser.mly" + ( mkexp_attrs (Pexp_new(mkrhs _3 3)) _2 ) +# 9850 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'field_expr_list) in + Obj.repr( +# 1564 "parsing/parser.mly" + ( mkexp (Pexp_override _2) ) +# 9857 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'field_expr_list) in + Obj.repr( +# 1566 "parsing/parser.mly" + ( unclosed "{<" 1 ">}" 3 ) +# 9864 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + Obj.repr( +# 1568 "parsing/parser.mly" + ( mkexp (Pexp_override [])) +# 9870 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'field_expr_list) in + Obj.repr( +# 1570 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, mkexp (Pexp_override _4)))) +# 9878 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1572 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, mkexp (Pexp_override [])))) +# 9885 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'field_expr_list) in + Obj.repr( +# 1574 "parsing/parser.mly" + ( unclosed "{<" 3 ">}" 5 ) +# 9893 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'label) in + Obj.repr( +# 1576 "parsing/parser.mly" + ( mkexp(Pexp_send(_1, mkrhs _3 3)) ) +# 9901 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1578 "parsing/parser.mly" + ( mkinfix _1 _2 _3 ) +# 9910 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'module_expr) in + Obj.repr( +# 1580 "parsing/parser.mly" + ( mkexp_attrs (Pexp_pack _4) _3 ) +# 9918 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'module_expr) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 1582 "parsing/parser.mly" + ( mkexp_attrs (Pexp_constraint (ghexp (Pexp_pack _4), + ghtyp (Ptyp_package _6))) + _3 ) +# 9929 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'module_expr) in + Obj.repr( +# 1586 "parsing/parser.mly" + ( unclosed "(" 1 ")" 6 ) +# 9937 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 8 : 'mod_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _6 = (Parsing.peek_val __caml_parser_env 3 : 'module_expr) in + let _8 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 1589 "parsing/parser.mly" + ( mkexp(Pexp_open(Fresh, mkrhs _1 1, + mkexp_attrs (Pexp_constraint (ghexp (Pexp_pack _6), + ghtyp (Ptyp_package _8))) + _5 )) ) +# 9950 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 7 : 'mod_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _6 = (Parsing.peek_val __caml_parser_env 2 : 'module_expr) in + Obj.repr( +# 1594 "parsing/parser.mly" + ( unclosed "(" 3 ")" 8 ) +# 9959 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 1596 "parsing/parser.mly" + ( mkexp (Pexp_extension _1) ) +# 9966 "parsing/parser.ml" + : 'simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'labeled_simple_expr) in + Obj.repr( +# 1600 "parsing/parser.mly" + ( [_1] ) +# 9973 "parsing/parser.ml" + : 'simple_labeled_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'simple_labeled_expr_list) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'labeled_simple_expr) in + Obj.repr( +# 1602 "parsing/parser.mly" + ( _2 :: _1 ) +# 9981 "parsing/parser.ml" + : 'simple_labeled_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1606 "parsing/parser.mly" + ( (Nolabel, _1) ) +# 9988 "parsing/parser.ml" + : 'labeled_simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'label_expr) in + Obj.repr( +# 1608 "parsing/parser.mly" + ( _1 ) +# 9995 "parsing/parser.ml" + : 'labeled_simple_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1612 "parsing/parser.mly" + ( (Labelled _1, _2) ) +# 10003 "parsing/parser.ml" + : 'label_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'label_ident) in + Obj.repr( +# 1614 "parsing/parser.mly" + ( (Labelled (fst _2), snd _2) ) +# 10010 "parsing/parser.ml" + : 'label_expr)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'label_ident) in + Obj.repr( +# 1616 "parsing/parser.mly" + ( (Optional (fst _2), snd _2) ) +# 10017 "parsing/parser.ml" + : 'label_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_expr) in + Obj.repr( +# 1618 "parsing/parser.mly" + ( (Optional _1, _2) ) +# 10025 "parsing/parser.ml" + : 'label_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 1621 "parsing/parser.mly" + ( (_1, mkexp(Pexp_ident(mkrhs (Lident _1) 1))) ) +# 10032 "parsing/parser.ml" + : 'label_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 1624 "parsing/parser.mly" + ( [mkrhs _1 1] ) +# 10039 "parsing/parser.ml" + : 'lident_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'lident_list) in + Obj.repr( +# 1625 "parsing/parser.mly" + ( mkrhs _1 1 :: _2 ) +# 10047 "parsing/parser.ml" + : 'lident_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'val_ident) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'strict_binding) in + Obj.repr( +# 1629 "parsing/parser.mly" + ( (mkpatvar _1 1, _2) ) +# 10055 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'val_ident) in + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'type_constraint) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1631 "parsing/parser.mly" + ( let v = mkpatvar _1 1 in (* PR#7344 *) + let t = + match _2 with + Some t, None -> t + | _, Some t -> t + | _ -> assert false + in + (ghpat(Ppat_constraint(v, ghtyp(Ptyp_poly([],t)))), + mkexp_constraint _4 _2) ) +# 10072 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'val_ident) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'typevar_list) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1641 "parsing/parser.mly" + ( (ghpat(Ppat_constraint(mkpatvar _1 1, + ghtyp(Ptyp_poly(List.rev _3,_5)))), + _7) ) +# 10084 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 7 : 'val_ident) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'lident_list) in + let _6 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1645 "parsing/parser.mly" + ( let exp, poly = wrap_type_annotation _4 _6 _8 in + (ghpat(Ppat_constraint(mkpatvar _1 1, poly)), exp) ) +# 10095 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1648 "parsing/parser.mly" + ( (_1, _3) ) +# 10103 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'simple_pattern_not_ident) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1650 "parsing/parser.mly" + ( (ghpat(Ppat_constraint(_1, _3)), _5) ) +# 10112 "parsing/parser.ml" + : 'let_binding_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'let_binding) in + Obj.repr( +# 1653 "parsing/parser.mly" + ( _1 ) +# 10119 "parsing/parser.ml" + : 'let_bindings)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'let_bindings) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_let_binding) in + Obj.repr( +# 1654 "parsing/parser.mly" + ( addlb _1 _2 ) +# 10127 "parsing/parser.ml" + : 'let_bindings)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'rec_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'let_binding_body) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1658 "parsing/parser.mly" + ( let (ext, attr) = _2 in + mklbs ext _3 (mklb true _4 (attr@_5)) ) +# 10138 "parsing/parser.ml" + : 'let_binding)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'let_binding_body) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1663 "parsing/parser.mly" + ( mklb false _3 (_2@_4) ) +# 10147 "parsing/parser.ml" + : 'and_let_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'strict_binding) in + Obj.repr( +# 1667 "parsing/parser.mly" + ( _1 ) +# 10154 "parsing/parser.ml" + : 'fun_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'type_constraint) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1669 "parsing/parser.mly" + ( mkexp_constraint _3 _1 ) +# 10162 "parsing/parser.ml" + : 'fun_binding)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1673 "parsing/parser.mly" + ( _2 ) +# 10169 "parsing/parser.ml" + : 'strict_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'labeled_simple_pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'fun_binding) in + Obj.repr( +# 1675 "parsing/parser.mly" + ( let (l, o, p) = _1 in ghexp(Pexp_fun(l, o, p, _2)) ) +# 10177 "parsing/parser.ml" + : 'strict_binding)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'lident_list) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'fun_binding) in + Obj.repr( +# 1677 "parsing/parser.mly" + ( mk_newtypes _3 _5 ) +# 10185 "parsing/parser.ml" + : 'strict_binding)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'match_case) in + Obj.repr( +# 1680 "parsing/parser.mly" + ( [_1] ) +# 10192 "parsing/parser.ml" + : 'match_cases)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'match_cases) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'match_case) in + Obj.repr( +# 1681 "parsing/parser.mly" + ( _3 :: _1 ) +# 10200 "parsing/parser.ml" + : 'match_cases)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1685 "parsing/parser.mly" + ( Exp.case _1 _3 ) +# 10208 "parsing/parser.ml" + : 'match_case)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'seq_expr) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1687 "parsing/parser.mly" + ( Exp.case _1 ~guard:_3 _5 ) +# 10217 "parsing/parser.ml" + : 'match_case)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1689 "parsing/parser.mly" + ( Exp.case _1 (Exp.unreachable ~loc:(rhs_loc 3) ())) +# 10224 "parsing/parser.ml" + : 'match_case)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1693 "parsing/parser.mly" + ( _2 ) +# 10231 "parsing/parser.ml" + : 'fun_def)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 1695 "parsing/parser.mly" + ( mkexp (Pexp_constraint (_4, _2)) ) +# 10239 "parsing/parser.ml" + : 'fun_def)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'labeled_simple_pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'fun_def) in + Obj.repr( +# 1698 "parsing/parser.mly" + ( + let (l,o,p) = _1 in + ghexp(Pexp_fun(l, o, p, _2)) + ) +# 10250 "parsing/parser.ml" + : 'fun_def)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'lident_list) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'fun_def) in + Obj.repr( +# 1703 "parsing/parser.mly" + ( mk_newtypes _3 _5 ) +# 10258 "parsing/parser.ml" + : 'fun_def)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr_comma_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1706 "parsing/parser.mly" + ( _3 :: _1 ) +# 10266 "parsing/parser.ml" + : 'expr_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1707 "parsing/parser.mly" + ( [_3; _1] ) +# 10274 "parsing/parser.ml" + : 'expr_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_expr_list) in + Obj.repr( +# 1710 "parsing/parser.mly" + ( (Some _1, _3) ) +# 10282 "parsing/parser.ml" + : 'record_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_expr_list) in + Obj.repr( +# 1711 "parsing/parser.mly" + ( (None, _1) ) +# 10289 "parsing/parser.ml" + : 'record_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_expr) in + Obj.repr( +# 1714 "parsing/parser.mly" + ( [_1] ) +# 10296 "parsing/parser.ml" + : 'lbl_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'lbl_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_expr_list) in + Obj.repr( +# 1715 "parsing/parser.mly" + ( _1 :: _3 ) +# 10304 "parsing/parser.ml" + : 'lbl_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'lbl_expr) in + Obj.repr( +# 1716 "parsing/parser.mly" + ( [_1] ) +# 10311 "parsing/parser.ml" + : 'lbl_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'label_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'opt_type_constraint) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1720 "parsing/parser.mly" + ( (mkrhs _1 1, mkexp_opt_constraint _4 _2) ) +# 10320 "parsing/parser.ml" + : 'lbl_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'label_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'opt_type_constraint) in + Obj.repr( +# 1722 "parsing/parser.mly" + ( (mkrhs _1 1, mkexp_opt_constraint (exp_of_label _1 1) _2) ) +# 10328 "parsing/parser.ml" + : 'lbl_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'field_expr) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'opt_semi) in + Obj.repr( +# 1725 "parsing/parser.mly" + ( [_1] ) +# 10336 "parsing/parser.ml" + : 'field_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'field_expr) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'field_expr_list) in + Obj.repr( +# 1726 "parsing/parser.mly" + ( _1 :: _3 ) +# 10344 "parsing/parser.ml" + : 'field_expr_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'label) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1730 "parsing/parser.mly" + ( (mkrhs _1 1, _3) ) +# 10352 "parsing/parser.ml" + : 'field_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'label) in + Obj.repr( +# 1732 "parsing/parser.mly" + ( (mkrhs _1 1, exp_of_label (Lident _1) 1) ) +# 10359 "parsing/parser.ml" + : 'field_expr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1735 "parsing/parser.mly" + ( [_1] ) +# 10366 "parsing/parser.ml" + : 'expr_semi_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'expr_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'expr) in + Obj.repr( +# 1736 "parsing/parser.mly" + ( _3 :: _1 ) +# 10374 "parsing/parser.ml" + : 'expr_semi_list)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1739 "parsing/parser.mly" + ( (Some _2, None) ) +# 10381 "parsing/parser.ml" + : 'type_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'core_type) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1740 "parsing/parser.mly" + ( (Some _2, Some _4) ) +# 10389 "parsing/parser.ml" + : 'type_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1741 "parsing/parser.mly" + ( (None, Some _2) ) +# 10396 "parsing/parser.ml" + : 'type_constraint)) +; (fun __caml_parser_env -> + Obj.repr( +# 1742 "parsing/parser.mly" + ( syntax_error() ) +# 10402 "parsing/parser.ml" + : 'type_constraint)) +; (fun __caml_parser_env -> + Obj.repr( +# 1743 "parsing/parser.mly" + ( syntax_error() ) +# 10408 "parsing/parser.ml" + : 'type_constraint)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_constraint) in + Obj.repr( +# 1746 "parsing/parser.mly" + ( Some _1 ) +# 10415 "parsing/parser.ml" + : 'opt_type_constraint)) +; (fun __caml_parser_env -> + Obj.repr( +# 1747 "parsing/parser.mly" + ( None ) +# 10421 "parsing/parser.ml" + : 'opt_type_constraint)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'val_ident) in + Obj.repr( +# 1754 "parsing/parser.mly" + ( mkpat(Ppat_alias(_1, mkrhs _3 3)) ) +# 10429 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1756 "parsing/parser.mly" + ( expecting 3 "identifier" ) +# 10436 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern_comma_list) in + Obj.repr( +# 1758 "parsing/parser.mly" + ( mkpat(Ppat_tuple(List.rev _1)) ) +# 10443 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1760 "parsing/parser.mly" + ( mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[_1;_3])) (symbol_rloc()) ) +# 10451 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1762 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10458 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1764 "parsing/parser.mly" + ( mkpat(Ppat_or(_1, _3)) ) +# 10466 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1766 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10473 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1768 "parsing/parser.mly" + ( mkpat_attrs (Ppat_exception _3) _2) +# 10481 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 1770 "parsing/parser.mly" + ( Pat.attr _1 _2 ) +# 10489 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern_gen) in + Obj.repr( +# 1771 "parsing/parser.mly" + ( _1 ) +# 10496 "parsing/parser.ml" + : 'pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'val_ident) in + Obj.repr( +# 1775 "parsing/parser.mly" + ( mkpat(Ppat_alias(_1, mkrhs _3 3)) ) +# 10504 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + Obj.repr( +# 1777 "parsing/parser.mly" + ( expecting 3 "identifier" ) +# 10511 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern_no_exn_comma_list) in + Obj.repr( +# 1779 "parsing/parser.mly" + ( mkpat(Ppat_tuple(List.rev _1)) ) +# 10518 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1781 "parsing/parser.mly" + ( mkpat_cons (rhs_loc 2) (ghpat(Ppat_tuple[_1;_3])) (symbol_rloc()) ) +# 10526 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + Obj.repr( +# 1783 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10533 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1785 "parsing/parser.mly" + ( mkpat(Ppat_or(_1, _3)) ) +# 10541 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + Obj.repr( +# 1787 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10548 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'pattern_no_exn) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 1789 "parsing/parser.mly" + ( Pat.attr _1 _2 ) +# 10556 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern_gen) in + Obj.repr( +# 1790 "parsing/parser.mly" + ( _1 ) +# 10563 "parsing/parser.ml" + : 'pattern_no_exn)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_pattern) in + Obj.repr( +# 1794 "parsing/parser.mly" + ( _1 ) +# 10570 "parsing/parser.ml" + : 'pattern_gen)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'constr_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1796 "parsing/parser.mly" + ( mkpat(Ppat_construct(mkrhs _1 1, Some _2)) ) +# 10578 "parsing/parser.ml" + : 'pattern_gen)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'name_tag) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1798 "parsing/parser.mly" + ( mkpat(Ppat_variant(_1, Some _2)) ) +# 10586 "parsing/parser.ml" + : 'pattern_gen)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_pattern) in + Obj.repr( +# 1800 "parsing/parser.mly" + ( mkpat_attrs (Ppat_lazy _3) _2) +# 10594 "parsing/parser.ml" + : 'pattern_gen)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'val_ident) in + Obj.repr( +# 1804 "parsing/parser.mly" + ( mkpat(Ppat_var (mkrhs _1 1)) ) +# 10601 "parsing/parser.ml" + : 'simple_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_pattern_not_ident) in + Obj.repr( +# 1805 "parsing/parser.mly" + ( _1 ) +# 10608 "parsing/parser.ml" + : 'simple_pattern)) +; (fun __caml_parser_env -> + Obj.repr( +# 1809 "parsing/parser.mly" + ( mkpat(Ppat_any) ) +# 10614 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'signed_constant) in + Obj.repr( +# 1811 "parsing/parser.mly" + ( mkpat(Ppat_constant _1) ) +# 10621 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'signed_constant) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'signed_constant) in + Obj.repr( +# 1813 "parsing/parser.mly" + ( mkpat(Ppat_interval (_1, _3)) ) +# 10629 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'constr_longident) in + Obj.repr( +# 1815 "parsing/parser.mly" + ( mkpat(Ppat_construct(mkrhs _1 1, None)) ) +# 10636 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'name_tag) in + Obj.repr( +# 1817 "parsing/parser.mly" + ( mkpat(Ppat_variant(_1, None)) ) +# 10643 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'type_longident) in + Obj.repr( +# 1819 "parsing/parser.mly" + ( mkpat(Ppat_type (mkrhs _2 2)) ) +# 10650 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_delimited_pattern) in + Obj.repr( +# 1821 "parsing/parser.mly" + ( _1 ) +# 10657 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_delimited_pattern) in + Obj.repr( +# 1823 "parsing/parser.mly" + ( mkpat @@ Ppat_open(mkrhs _1 1, _3) ) +# 10665 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1825 "parsing/parser.mly" + ( mkpat @@ Ppat_open(mkrhs _1 1, mkpat @@ + Ppat_construct ( mkrhs (Lident "[]") 4, None)) ) +# 10673 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1828 "parsing/parser.mly" + ( mkpat @@ Ppat_open( mkrhs _1 1, mkpat @@ + Ppat_construct ( mkrhs (Lident "()") 4, None) ) ) +# 10681 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 1831 "parsing/parser.mly" + ( mkpat @@ Ppat_open (mkrhs _1 1, _4)) +# 10689 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 1833 "parsing/parser.mly" + (unclosed "(" 3 ")" 5 ) +# 10697 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_longident) in + Obj.repr( +# 1835 "parsing/parser.mly" + ( expecting 4 "pattern" ) +# 10704 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 1837 "parsing/parser.mly" + ( reloc_pat _2 ) +# 10711 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pattern) in + Obj.repr( +# 1839 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 10718 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + Obj.repr( +# 1841 "parsing/parser.mly" + ( mkpat(Ppat_constraint(_2, _4)) ) +# 10726 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + Obj.repr( +# 1843 "parsing/parser.mly" + ( unclosed "(" 1 ")" 5 ) +# 10734 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1845 "parsing/parser.mly" + ( expecting 4 "type" ) +# 10741 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : string) in + Obj.repr( +# 1847 "parsing/parser.mly" + ( mkpat_attrs (Ppat_unpack (mkrhs _4 4)) _3 ) +# 10749 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 1849 "parsing/parser.mly" + ( mkpat_attrs + (Ppat_constraint(mkpat(Ppat_unpack (mkrhs _4 4)), + ghtyp(Ptyp_package _6))) + _3 ) +# 10761 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 1854 "parsing/parser.mly" + ( unclosed "(" 1 ")" 7 ) +# 10770 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 1856 "parsing/parser.mly" + ( mkpat(Ppat_extension _1) ) +# 10777 "parsing/parser.ml" + : 'simple_pattern_not_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'lbl_pattern_list) in + Obj.repr( +# 1861 "parsing/parser.mly" + ( let (fields, closed) = _2 in mkpat(Ppat_record(fields, closed)) ) +# 10784 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'lbl_pattern_list) in + Obj.repr( +# 1863 "parsing/parser.mly" + ( unclosed "{" 1 "}" 3 ) +# 10791 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1865 "parsing/parser.mly" + ( reloc_pat (mktailpat (rhs_loc 4) (List.rev _2)) ) +# 10799 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1867 "parsing/parser.mly" + ( unclosed "[" 1 "]" 4 ) +# 10807 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1869 "parsing/parser.mly" + ( mkpat(Ppat_array(List.rev _2)) ) +# 10815 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + Obj.repr( +# 1871 "parsing/parser.mly" + ( mkpat(Ppat_array []) ) +# 10821 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'opt_semi) in + Obj.repr( +# 1873 "parsing/parser.mly" + ( unclosed "[|" 1 "|]" 4 ) +# 10829 "parsing/parser.ml" + : 'simple_delimited_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_comma_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1876 "parsing/parser.mly" + ( _3 :: _1 ) +# 10837 "parsing/parser.ml" + : 'pattern_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1877 "parsing/parser.mly" + ( [_3; _1] ) +# 10845 "parsing/parser.ml" + : 'pattern_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + Obj.repr( +# 1878 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10852 "parsing/parser.ml" + : 'pattern_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn_comma_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1881 "parsing/parser.mly" + ( _3 :: _1 ) +# 10860 "parsing/parser.ml" + : 'pattern_no_exn_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1882 "parsing/parser.mly" + ( [_3; _1] ) +# 10868 "parsing/parser.ml" + : 'pattern_no_exn_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_no_exn) in + Obj.repr( +# 1883 "parsing/parser.mly" + ( expecting 3 "pattern" ) +# 10875 "parsing/parser.ml" + : 'pattern_no_exn_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1886 "parsing/parser.mly" + ( [_1] ) +# 10882 "parsing/parser.ml" + : 'pattern_semi_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'pattern_semi_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1887 "parsing/parser.mly" + ( _3 :: _1 ) +# 10890 "parsing/parser.ml" + : 'pattern_semi_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_pattern) in + Obj.repr( +# 1890 "parsing/parser.mly" + ( [_1], Closed ) +# 10897 "parsing/parser.ml" + : 'lbl_pattern_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'lbl_pattern) in + Obj.repr( +# 1891 "parsing/parser.mly" + ( [_1], Closed ) +# 10904 "parsing/parser.ml" + : 'lbl_pattern_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'lbl_pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'opt_semi) in + Obj.repr( +# 1892 "parsing/parser.mly" + ( [_1], Open ) +# 10912 "parsing/parser.ml" + : 'lbl_pattern_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'lbl_pattern) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'lbl_pattern_list) in + Obj.repr( +# 1894 "parsing/parser.mly" + ( let (fields, closed) = _3 in _1 :: fields, closed ) +# 10920 "parsing/parser.ml" + : 'lbl_pattern_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'label_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'opt_pattern_type_constraint) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 1898 "parsing/parser.mly" + ( (mkrhs _1 1, mkpat_opt_constraint _4 _2) ) +# 10929 "parsing/parser.ml" + : 'lbl_pattern)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'label_longident) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'opt_pattern_type_constraint) in + Obj.repr( +# 1900 "parsing/parser.mly" + ( (mkrhs _1 1, mkpat_opt_constraint (pat_of_label _1 1) _2) ) +# 10937 "parsing/parser.ml" + : 'lbl_pattern)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1903 "parsing/parser.mly" + ( Some _2 ) +# 10944 "parsing/parser.ml" + : 'opt_pattern_type_constraint)) +; (fun __caml_parser_env -> + Obj.repr( +# 1904 "parsing/parser.mly" + ( None ) +# 10950 "parsing/parser.ml" + : 'opt_pattern_type_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'val_ident) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1911 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Val.mk (mkrhs _3 3) _5 ~attrs:(attrs@_6) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 10963 "parsing/parser.ml" + : 'value_description)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string * string option) in + Obj.repr( +# 1920 "parsing/parser.mly" + ( [fst _1] ) +# 10970 "parsing/parser.ml" + : 'primitive_declaration_body)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : string * string option) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'primitive_declaration_body) in + Obj.repr( +# 1921 "parsing/parser.mly" + ( fst _1 :: _2 ) +# 10978 "parsing/parser.ml" + : 'primitive_declaration_body)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'val_ident) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : 'core_type) in + let _7 = (Parsing.peek_val __caml_parser_env 1 : 'primitive_declaration_body) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1926 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + Val.mk (mkrhs _3 3) _5 ~prim:_7 ~attrs:(attrs@_8) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + , ext ) +# 10992 "parsing/parser.ml" + : 'primitive_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_declaration) in + Obj.repr( +# 1936 "parsing/parser.mly" + ( let (nonrec_flag, ty, ext) = _1 in (nonrec_flag, [ty], ext) ) +# 10999 "parsing/parser.ml" + : 'type_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'type_declarations) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'and_type_declaration) in + Obj.repr( +# 1938 "parsing/parser.mly" + ( let (nonrec_flag, tys, ext) = _1 in (nonrec_flag, _2 :: tys, ext) ) +# 11007 "parsing/parser.ml" + : 'type_declarations)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 6 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 5 : 'nonrec_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 4 : 'optional_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _6 = (Parsing.peek_val __caml_parser_env 2 : 'type_kind) in + let _7 = (Parsing.peek_val __caml_parser_env 1 : 'constraints) in + let _8 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1944 "parsing/parser.mly" + ( let (kind, priv, manifest) = _6 in + let (ext, attrs) = _2 in + let ty = + Type.mk (mkrhs _5 5) ~params:_4 ~cstrs:(List.rev _7) ~kind + ~priv ?manifest ~attrs:(attrs@_8) + ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) + in + (_3, ty, ext) ) +# 11027 "parsing/parser.ml" + : 'type_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'optional_type_parameters) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'type_kind) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'constraints) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 1956 "parsing/parser.mly" + ( let (kind, priv, manifest) = _5 in + Type.mk (mkrhs _4 4) ~params:_3 ~cstrs:(List.rev _6) + ~kind ~priv ?manifest ~attrs:(_2@_7) ~loc:(symbol_rloc ()) + ~text:(symbol_text ()) ~docs:(symbol_docs ()) ) +# 11042 "parsing/parser.ml" + : 'and_type_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'constraints) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'constrain) in + Obj.repr( +# 1962 "parsing/parser.mly" + ( _3 :: _1 ) +# 11050 "parsing/parser.ml" + : 'constraints)) +; (fun __caml_parser_env -> + Obj.repr( +# 1963 "parsing/parser.mly" + ( [] ) +# 11056 "parsing/parser.ml" + : 'constraints)) +; (fun __caml_parser_env -> + Obj.repr( +# 1967 "parsing/parser.mly" + ( (Ptype_abstract, Public, None) ) +# 11062 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1969 "parsing/parser.mly" + ( (Ptype_abstract, Public, Some _2) ) +# 11069 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 1971 "parsing/parser.mly" + ( (Ptype_abstract, Private, Some _3) ) +# 11076 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'constructor_declarations) in + Obj.repr( +# 1973 "parsing/parser.mly" + ( (Ptype_variant(List.rev _2), Public, None) ) +# 11083 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'constructor_declarations) in + Obj.repr( +# 1975 "parsing/parser.mly" + ( (Ptype_variant(List.rev _3), Private, None) ) +# 11090 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + Obj.repr( +# 1977 "parsing/parser.mly" + ( (Ptype_open, Public, None) ) +# 11096 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + Obj.repr( +# 1979 "parsing/parser.mly" + ( (Ptype_open, Private, None) ) +# 11102 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'private_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'label_declarations) in + Obj.repr( +# 1981 "parsing/parser.mly" + ( (Ptype_record _4, _2, None) ) +# 11110 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'core_type) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'private_flag) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'constructor_declarations) in + Obj.repr( +# 1983 "parsing/parser.mly" + ( (Ptype_variant(List.rev _5), _4, Some _2) ) +# 11119 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'core_type) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'private_flag) in + Obj.repr( +# 1985 "parsing/parser.mly" + ( (Ptype_open, _4, Some _2) ) +# 11127 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'core_type) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'private_flag) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'label_declarations) in + Obj.repr( +# 1987 "parsing/parser.mly" + ( (Ptype_record _6, _4, Some _2) ) +# 11136 "parsing/parser.ml" + : 'type_kind)) +; (fun __caml_parser_env -> + Obj.repr( +# 1990 "parsing/parser.mly" + ( [] ) +# 11142 "parsing/parser.ml" + : 'optional_type_parameters)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'optional_type_parameter) in + Obj.repr( +# 1991 "parsing/parser.mly" + ( [_1] ) +# 11149 "parsing/parser.ml" + : 'optional_type_parameters)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'optional_type_parameter_list) in + Obj.repr( +# 1992 "parsing/parser.mly" + ( List.rev _2 ) +# 11156 "parsing/parser.ml" + : 'optional_type_parameters)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'type_variance) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'optional_type_variable) in + Obj.repr( +# 1995 "parsing/parser.mly" + ( _2, _1 ) +# 11164 "parsing/parser.ml" + : 'optional_type_parameter)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'optional_type_parameter) in + Obj.repr( +# 1998 "parsing/parser.mly" + ( [_1] ) +# 11171 "parsing/parser.ml" + : 'optional_type_parameter_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'optional_type_parameter_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'optional_type_parameter) in + Obj.repr( +# 1999 "parsing/parser.mly" + ( _3 :: _1 ) +# 11179 "parsing/parser.ml" + : 'optional_type_parameter_list)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2002 "parsing/parser.mly" + ( mktyp(Ptyp_var _2) ) +# 11186 "parsing/parser.ml" + : 'optional_type_variable)) +; (fun __caml_parser_env -> + Obj.repr( +# 2003 "parsing/parser.mly" + ( mktyp(Ptyp_any) ) +# 11192 "parsing/parser.ml" + : 'optional_type_variable)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'type_variance) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'type_variable) in + Obj.repr( +# 2008 "parsing/parser.mly" + ( _2, _1 ) +# 11200 "parsing/parser.ml" + : 'type_parameter)) +; (fun __caml_parser_env -> + Obj.repr( +# 2011 "parsing/parser.mly" + ( Invariant ) +# 11206 "parsing/parser.ml" + : 'type_variance)) +; (fun __caml_parser_env -> + Obj.repr( +# 2012 "parsing/parser.mly" + ( Covariant ) +# 11212 "parsing/parser.ml" + : 'type_variance)) +; (fun __caml_parser_env -> + Obj.repr( +# 2013 "parsing/parser.mly" + ( Contravariant ) +# 11218 "parsing/parser.ml" + : 'type_variance)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2016 "parsing/parser.mly" + ( mktyp(Ptyp_var _2) ) +# 11225 "parsing/parser.ml" + : 'type_variable)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_parameter) in + Obj.repr( +# 2019 "parsing/parser.mly" + ( [_1] ) +# 11232 "parsing/parser.ml" + : 'type_parameter_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'type_parameter_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'type_parameter) in + Obj.repr( +# 2020 "parsing/parser.mly" + ( _3 :: _1 ) +# 11240 "parsing/parser.ml" + : 'type_parameter_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'constructor_declaration) in + Obj.repr( +# 2023 "parsing/parser.mly" + ( [_1] ) +# 11247 "parsing/parser.ml" + : 'constructor_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'bar_constructor_declaration) in + Obj.repr( +# 2024 "parsing/parser.mly" + ( [_1] ) +# 11254 "parsing/parser.ml" + : 'constructor_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'constructor_declarations) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'bar_constructor_declaration) in + Obj.repr( +# 2025 "parsing/parser.mly" + ( _2 :: _1 ) +# 11262 "parsing/parser.ml" + : 'constructor_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'constr_ident) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'generalized_constructor_arguments) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2029 "parsing/parser.mly" + ( + let args,res = _2 in + Type.constructor (mkrhs _1 1) ~args ?res ~attrs:_3 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) + ) +# 11275 "parsing/parser.ml" + : 'constructor_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'constr_ident) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'generalized_constructor_arguments) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2037 "parsing/parser.mly" + ( + let args,res = _3 in + Type.constructor (mkrhs _2 2) ~args ?res ~attrs:_4 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) + ) +# 11288 "parsing/parser.ml" + : 'bar_constructor_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'sig_exception_declaration) in + Obj.repr( +# 2044 "parsing/parser.mly" + ( _1 ) +# 11295 "parsing/parser.ml" + : 'str_exception_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 4 : 'constr_ident) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'constr_longident) in + let _6 = (Parsing.peek_val __caml_parser_env 1 : 'attributes) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 2047 "parsing/parser.mly" + ( let (ext,attrs) = _2 in + Te.rebind (mkrhs _3 3) (mkrhs _5 5) ~attrs:(attrs @ _6 @ _7) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 11309 "parsing/parser.ml" + : 'str_exception_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'constr_ident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'generalized_constructor_arguments) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'attributes) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 2055 "parsing/parser.mly" + ( let args, res = _4 in + let (ext,attrs) = _2 in + Te.decl (mkrhs _3 3) ~args ?res ~attrs:(attrs @ _5 @ _6) + ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) + , ext ) +# 11324 "parsing/parser.ml" + : 'sig_exception_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'constr_ident) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'generalized_constructor_arguments) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2063 "parsing/parser.mly" + ( let args, res = _2 in + Te.decl (mkrhs _1 1) ~args ?res ~attrs:_3 ~loc:(symbol_rloc()) ) +# 11334 "parsing/parser.ml" + : 'let_exception_declaration)) +; (fun __caml_parser_env -> + Obj.repr( +# 2067 "parsing/parser.mly" + ( (Pcstr_tuple [],None) ) +# 11340 "parsing/parser.ml" + : 'generalized_constructor_arguments)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'constructor_arguments) in + Obj.repr( +# 2068 "parsing/parser.mly" + ( (_2,None) ) +# 11347 "parsing/parser.ml" + : 'generalized_constructor_arguments)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'constructor_arguments) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2070 "parsing/parser.mly" + ( (_2,Some _4) ) +# 11355 "parsing/parser.ml" + : 'generalized_constructor_arguments)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2072 "parsing/parser.mly" + ( (Pcstr_tuple [],Some _2) ) +# 11362 "parsing/parser.ml" + : 'generalized_constructor_arguments)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_list) in + Obj.repr( +# 2076 "parsing/parser.mly" + ( Pcstr_tuple (List.rev _1) ) +# 11369 "parsing/parser.ml" + : 'constructor_arguments)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'label_declarations) in + Obj.repr( +# 2077 "parsing/parser.mly" + ( Pcstr_record _2 ) +# 11376 "parsing/parser.ml" + : 'constructor_arguments)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'label_declaration) in + Obj.repr( +# 2080 "parsing/parser.mly" + ( [_1] ) +# 11383 "parsing/parser.ml" + : 'label_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'label_declaration_semi) in + Obj.repr( +# 2081 "parsing/parser.mly" + ( [_1] ) +# 11390 "parsing/parser.ml" + : 'label_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'label_declaration_semi) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'label_declarations) in + Obj.repr( +# 2082 "parsing/parser.mly" + ( _1 :: _2 ) +# 11398 "parsing/parser.ml" + : 'label_declarations)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mutable_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'label) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'poly_type_no_attr) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2086 "parsing/parser.mly" + ( + Type.field (mkrhs _2 2) _4 ~mut:_1 ~attrs:_5 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) + ) +# 11411 "parsing/parser.ml" + : 'label_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 6 : 'mutable_flag) in + let _2 = (Parsing.peek_val __caml_parser_env 5 : 'label) in + let _4 = (Parsing.peek_val __caml_parser_env 3 : 'poly_type_no_attr) in + let _5 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _7 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2093 "parsing/parser.mly" + ( + let info = + match rhs_info 5 with + | Some _ as info_before_semi -> info_before_semi + | None -> symbol_info () + in + Type.field (mkrhs _2 2) _4 ~mut:_1 ~attrs:(_5 @ _7) + ~loc:(symbol_rloc()) ~info + ) +# 11430 "parsing/parser.ml" + : 'label_declaration_semi)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 7 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'nonrec_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : 'optional_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 4 : 'type_longident) in + let _7 = (Parsing.peek_val __caml_parser_env 2 : 'private_flag) in + let _8 = (Parsing.peek_val __caml_parser_env 1 : 'str_extension_constructors) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 2109 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + if _3 <> Recursive then not_expecting 3 "nonrec flag"; + Te.mk (mkrhs _5 5) (List.rev _8) ~params:_4 ~priv:_7 + ~attrs:(attrs@_9) ~docs:(symbol_docs ()) + , ext ) +# 11447 "parsing/parser.ml" + : 'str_type_extension)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 7 : 'ext_attributes) in + let _3 = (Parsing.peek_val __caml_parser_env 6 : 'nonrec_flag) in + let _4 = (Parsing.peek_val __caml_parser_env 5 : 'optional_type_parameters) in + let _5 = (Parsing.peek_val __caml_parser_env 4 : 'type_longident) in + let _7 = (Parsing.peek_val __caml_parser_env 2 : 'private_flag) in + let _8 = (Parsing.peek_val __caml_parser_env 1 : 'sig_extension_constructors) in + let _9 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 2118 "parsing/parser.mly" + ( let (ext, attrs) = _2 in + if _3 <> Recursive then not_expecting 3 "nonrec flag"; + Te.mk (mkrhs _5 5) (List.rev _8) ~params:_4 ~priv:_7 + ~attrs:(attrs @ _9) ~docs:(symbol_docs ()) + , ext ) +# 11464 "parsing/parser.ml" + : 'sig_type_extension)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension_constructor_declaration) in + Obj.repr( +# 2125 "parsing/parser.mly" + ( [_1] ) +# 11471 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_declaration) in + Obj.repr( +# 2126 "parsing/parser.mly" + ( [_1] ) +# 11478 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension_constructor_rebind) in + Obj.repr( +# 2127 "parsing/parser.mly" + ( [_1] ) +# 11485 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_rebind) in + Obj.repr( +# 2128 "parsing/parser.mly" + ( [_1] ) +# 11492 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'str_extension_constructors) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_declaration) in + Obj.repr( +# 2130 "parsing/parser.mly" + ( _2 :: _1 ) +# 11500 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'str_extension_constructors) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_rebind) in + Obj.repr( +# 2132 "parsing/parser.mly" + ( _2 :: _1 ) +# 11508 "parsing/parser.ml" + : 'str_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension_constructor_declaration) in + Obj.repr( +# 2135 "parsing/parser.mly" + ( [_1] ) +# 11515 "parsing/parser.ml" + : 'sig_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_declaration) in + Obj.repr( +# 2136 "parsing/parser.mly" + ( [_1] ) +# 11522 "parsing/parser.ml" + : 'sig_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'sig_extension_constructors) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'bar_extension_constructor_declaration) in + Obj.repr( +# 2138 "parsing/parser.mly" + ( _2 :: _1 ) +# 11530 "parsing/parser.ml" + : 'sig_extension_constructors)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'constr_ident) in + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'generalized_constructor_arguments) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2142 "parsing/parser.mly" + ( let args, res = _2 in + Te.decl (mkrhs _1 1) ~args ?res ~attrs:_3 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) ) +# 11541 "parsing/parser.ml" + : 'extension_constructor_declaration)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'constr_ident) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'generalized_constructor_arguments) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2148 "parsing/parser.mly" + ( let args, res = _3 in + Te.decl (mkrhs _2 2) ~args ?res ~attrs:_4 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) ) +# 11552 "parsing/parser.ml" + : 'bar_extension_constructor_declaration)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'constr_ident) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'constr_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2154 "parsing/parser.mly" + ( Te.rebind (mkrhs _1 1) (mkrhs _3 3) ~attrs:_4 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) ) +# 11562 "parsing/parser.ml" + : 'extension_constructor_rebind)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'constr_ident) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'constr_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2159 "parsing/parser.mly" + ( Te.rebind (mkrhs _2 2) (mkrhs _4 4) ~attrs:_5 + ~loc:(symbol_rloc()) ~info:(symbol_info ()) ) +# 11572 "parsing/parser.ml" + : 'bar_extension_constructor_rebind)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'with_constraint) in + Obj.repr( +# 2166 "parsing/parser.mly" + ( [_1] ) +# 11579 "parsing/parser.ml" + : 'with_constraints)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'with_constraints) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'with_constraint) in + Obj.repr( +# 2167 "parsing/parser.mly" + ( _3 :: _1 ) +# 11587 "parsing/parser.ml" + : 'with_constraints)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'optional_type_parameters) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'label_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'with_type_binder) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'core_type_no_attr) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'constraints) in + Obj.repr( +# 2172 "parsing/parser.mly" + ( Pwith_type + (mkrhs _3 3, + (Type.mk (mkrhs (Longident.last _3) 3) + ~params:_2 + ~cstrs:(List.rev _6) + ~manifest:_5 + ~priv:_4 + ~loc:(symbol_rloc()))) ) +# 11605 "parsing/parser.ml" + : 'with_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'optional_type_parameters) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'label_longident) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2183 "parsing/parser.mly" + ( Pwith_typesubst + (mkrhs _3 3, + (Type.mk (mkrhs (Longident.last _3) 3) + ~params:_2 + ~manifest:_5 + ~loc:(symbol_rloc()))) ) +# 11619 "parsing/parser.ml" + : 'with_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'mod_ext_longident) in + Obj.repr( +# 2190 "parsing/parser.mly" + ( Pwith_module (mkrhs _2 2, mkrhs _4 4) ) +# 11627 "parsing/parser.ml" + : 'with_constraint)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'mod_ext_longident) in + Obj.repr( +# 2192 "parsing/parser.mly" + ( Pwith_modsubst (mkrhs _2 2, mkrhs _4 4) ) +# 11635 "parsing/parser.ml" + : 'with_constraint)) +; (fun __caml_parser_env -> + Obj.repr( +# 2195 "parsing/parser.mly" + ( Public ) +# 11641 "parsing/parser.ml" + : 'with_type_binder)) +; (fun __caml_parser_env -> + Obj.repr( +# 2196 "parsing/parser.mly" + ( Private ) +# 11647 "parsing/parser.ml" + : 'with_type_binder)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2202 "parsing/parser.mly" + ( [mkrhs _2 2] ) +# 11654 "parsing/parser.ml" + : 'typevar_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'typevar_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2203 "parsing/parser.mly" + ( mkrhs _3 3 :: _1 ) +# 11662 "parsing/parser.ml" + : 'typevar_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 2207 "parsing/parser.mly" + ( _1 ) +# 11669 "parsing/parser.ml" + : 'poly_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'typevar_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 2209 "parsing/parser.mly" + ( mktyp(Ptyp_poly(List.rev _1, _3)) ) +# 11677 "parsing/parser.ml" + : 'poly_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2213 "parsing/parser.mly" + ( _1 ) +# 11684 "parsing/parser.ml" + : 'poly_type_no_attr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'typevar_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2215 "parsing/parser.mly" + ( mktyp(Ptyp_poly(List.rev _1, _3)) ) +# 11692 "parsing/parser.ml" + : 'poly_type_no_attr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2222 "parsing/parser.mly" + ( _1 ) +# 11699 "parsing/parser.ml" + : 'core_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'core_type) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attribute) in + Obj.repr( +# 2224 "parsing/parser.mly" + ( Typ.attr _1 _2 ) +# 11707 "parsing/parser.ml" + : 'core_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type2) in + Obj.repr( +# 2228 "parsing/parser.mly" + ( _1 ) +# 11714 "parsing/parser.ml" + : 'core_type_no_attr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'core_type2) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2230 "parsing/parser.mly" + ( mktyp(Ptyp_alias(_1, _4)) ) +# 11722 "parsing/parser.ml" + : 'core_type_no_attr)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type_or_tuple) in + Obj.repr( +# 2234 "parsing/parser.mly" + ( _1 ) +# 11729 "parsing/parser.ml" + : 'core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'core_type2) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'core_type2) in + Obj.repr( +# 2236 "parsing/parser.mly" + ( let param = extra_rhs_core_type _4 ~pos:4 in + mktyp (Ptyp_arrow(Optional _2 , param, _6)) ) +# 11739 "parsing/parser.ml" + : 'core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'core_type2) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'core_type2) in + Obj.repr( +# 2239 "parsing/parser.mly" + ( let param = extra_rhs_core_type _2 ~pos:2 in + mktyp(Ptyp_arrow(Optional _1 , param, _4)) + ) +# 11750 "parsing/parser.ml" + : 'core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : string) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'core_type2) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'core_type2) in + Obj.repr( +# 2243 "parsing/parser.mly" + ( let param = extra_rhs_core_type _3 ~pos:3 in + mktyp(Ptyp_arrow(Labelled _1, param, _5)) ) +# 11760 "parsing/parser.ml" + : 'core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'core_type2) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type2) in + Obj.repr( +# 2246 "parsing/parser.mly" + ( let param = extra_rhs_core_type _1 ~pos:1 in + mktyp(Ptyp_arrow(Nolabel, param, _3)) ) +# 11769 "parsing/parser.ml" + : 'core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type2) in + Obj.repr( +# 2252 "parsing/parser.mly" + ( _1 ) +# 11776 "parsing/parser.ml" + : 'simple_core_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'core_type_comma_list) in + Obj.repr( +# 2254 "parsing/parser.mly" + ( match _2 with [sty] -> sty | _ -> raise Parse_error ) +# 11783 "parsing/parser.ml" + : 'simple_core_type)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2259 "parsing/parser.mly" + ( mktyp(Ptyp_var _2) ) +# 11790 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + Obj.repr( +# 2261 "parsing/parser.mly" + ( mktyp(Ptyp_any) ) +# 11796 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'type_longident) in + Obj.repr( +# 2263 "parsing/parser.mly" + ( mktyp(Ptyp_constr(mkrhs _1 1, [])) ) +# 11803 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'simple_core_type2) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'type_longident) in + Obj.repr( +# 2265 "parsing/parser.mly" + ( mktyp(Ptyp_constr(mkrhs _2 2, [_1])) ) +# 11811 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'core_type_comma_list) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'type_longident) in + Obj.repr( +# 2267 "parsing/parser.mly" + ( mktyp(Ptyp_constr(mkrhs _4 4, List.rev _2)) ) +# 11819 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'meth_list) in + Obj.repr( +# 2269 "parsing/parser.mly" + ( let (f, c) = _2 in mktyp(Ptyp_object (f, c)) ) +# 11826 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + Obj.repr( +# 2271 "parsing/parser.mly" + ( mktyp(Ptyp_object ([], Closed)) ) +# 11832 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 2273 "parsing/parser.mly" + ( mktyp(Ptyp_class(mkrhs _2 2, [])) ) +# 11839 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type2) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 2275 "parsing/parser.mly" + ( mktyp(Ptyp_class(mkrhs _3 3, [_1])) ) +# 11847 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'core_type_comma_list) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in + Obj.repr( +# 2277 "parsing/parser.mly" + ( mktyp(Ptyp_class(mkrhs _5 5, List.rev _2)) ) +# 11855 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'tag_field) in + Obj.repr( +# 2279 "parsing/parser.mly" + ( mktyp(Ptyp_variant([_2], Closed, None)) ) +# 11862 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'row_field_list) in + Obj.repr( +# 2285 "parsing/parser.mly" + ( mktyp(Ptyp_variant(List.rev _3, Closed, None)) ) +# 11869 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 3 : 'row_field) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'row_field_list) in + Obj.repr( +# 2287 "parsing/parser.mly" + ( mktyp(Ptyp_variant(_2 :: List.rev _4, Closed, None)) ) +# 11877 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'opt_bar) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'row_field_list) in + Obj.repr( +# 2289 "parsing/parser.mly" + ( mktyp(Ptyp_variant(List.rev _3, Open, None)) ) +# 11885 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + Obj.repr( +# 2291 "parsing/parser.mly" + ( mktyp(Ptyp_variant([], Open, None)) ) +# 11891 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'opt_bar) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'row_field_list) in + Obj.repr( +# 2293 "parsing/parser.mly" + ( mktyp(Ptyp_variant(List.rev _3, Closed, Some [])) ) +# 11899 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 4 : 'opt_bar) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'row_field_list) in + let _5 = (Parsing.peek_val __caml_parser_env 1 : 'name_tag_list) in + Obj.repr( +# 2295 "parsing/parser.mly" + ( mktyp(Ptyp_variant(List.rev _3, Closed, Some (List.rev _5))) ) +# 11908 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'ext_attributes) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'package_type) in + Obj.repr( +# 2297 "parsing/parser.mly" + ( mktyp_attrs (Ptyp_package _4) _3 ) +# 11916 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'extension) in + Obj.repr( +# 2299 "parsing/parser.mly" + ( mktyp (Ptyp_extension _1) ) +# 11923 "parsing/parser.ml" + : 'simple_core_type2)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'module_type) in + Obj.repr( +# 2302 "parsing/parser.mly" + ( package_type_of_module_type _1 ) +# 11930 "parsing/parser.ml" + : 'package_type)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'row_field) in + Obj.repr( +# 2305 "parsing/parser.mly" + ( [_1] ) +# 11937 "parsing/parser.ml" + : 'row_field_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'row_field_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'row_field) in + Obj.repr( +# 2306 "parsing/parser.mly" + ( _3 :: _1 ) +# 11945 "parsing/parser.ml" + : 'row_field_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'tag_field) in + Obj.repr( +# 2309 "parsing/parser.mly" + ( _1 ) +# 11952 "parsing/parser.ml" + : 'row_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2310 "parsing/parser.mly" + ( Rinherit _1 ) +# 11959 "parsing/parser.ml" + : 'row_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'name_tag) in + let _3 = (Parsing.peek_val __caml_parser_env 2 : 'opt_ampersand) in + let _4 = (Parsing.peek_val __caml_parser_env 1 : 'amper_type_list) in + let _5 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2314 "parsing/parser.mly" + ( Rtag (mkrhs _1 1, add_info_attrs (symbol_info ()) _5, + _3, List.rev _4) ) +# 11970 "parsing/parser.ml" + : 'tag_field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'name_tag) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2317 "parsing/parser.mly" + ( Rtag (mkrhs _1 1, add_info_attrs (symbol_info ()) _2, true, []) ) +# 11978 "parsing/parser.ml" + : 'tag_field)) +; (fun __caml_parser_env -> + Obj.repr( +# 2320 "parsing/parser.mly" + ( true ) +# 11984 "parsing/parser.ml" + : 'opt_ampersand)) +; (fun __caml_parser_env -> + Obj.repr( +# 2321 "parsing/parser.mly" + ( false ) +# 11990 "parsing/parser.ml" + : 'opt_ampersand)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2324 "parsing/parser.mly" + ( [_1] ) +# 11997 "parsing/parser.ml" + : 'amper_type_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'amper_type_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_no_attr) in + Obj.repr( +# 2325 "parsing/parser.mly" + ( _3 :: _1 ) +# 12005 "parsing/parser.ml" + : 'amper_type_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'name_tag) in + Obj.repr( +# 2328 "parsing/parser.mly" + ( [_1] ) +# 12012 "parsing/parser.ml" + : 'name_tag_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'name_tag_list) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'name_tag) in + Obj.repr( +# 2329 "parsing/parser.mly" + ( _2 :: _1 ) +# 12020 "parsing/parser.ml" + : 'name_tag_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2332 "parsing/parser.mly" + ( _1 ) +# 12027 "parsing/parser.ml" + : 'simple_core_type_or_tuple)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type_list) in + Obj.repr( +# 2334 "parsing/parser.mly" + ( mktyp(Ptyp_tuple(_1 :: List.rev _3)) ) +# 12035 "parsing/parser.ml" + : 'simple_core_type_or_tuple)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 2337 "parsing/parser.mly" + ( [_1] ) +# 12042 "parsing/parser.ml" + : 'core_type_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'core_type_comma_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 2338 "parsing/parser.mly" + ( _3 :: _1 ) +# 12050 "parsing/parser.ml" + : 'core_type_comma_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2341 "parsing/parser.mly" + ( [_1] ) +# 12057 "parsing/parser.ml" + : 'core_type_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'core_type_list) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2342 "parsing/parser.mly" + ( _3 :: _1 ) +# 12065 "parsing/parser.ml" + : 'core_type_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'field_semi) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'meth_list) in + Obj.repr( +# 2345 "parsing/parser.mly" + ( let (f, c) = _2 in (_1 :: f, c) ) +# 12073 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'inherit_field_semi) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'meth_list) in + Obj.repr( +# 2346 "parsing/parser.mly" + ( let (f, c) = _2 in (_1 :: f, c) ) +# 12081 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'field_semi) in + Obj.repr( +# 2347 "parsing/parser.mly" + ( [_1], Closed ) +# 12088 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'field) in + Obj.repr( +# 2348 "parsing/parser.mly" + ( [_1], Closed ) +# 12095 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'inherit_field_semi) in + Obj.repr( +# 2349 "parsing/parser.mly" + ( [_1], Closed ) +# 12102 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'simple_core_type) in + Obj.repr( +# 2350 "parsing/parser.mly" + ( [Oinherit _1], Closed ) +# 12109 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + Obj.repr( +# 2351 "parsing/parser.mly" + ( [], Open ) +# 12115 "parsing/parser.ml" + : 'meth_list)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'label) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'poly_type_no_attr) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2355 "parsing/parser.mly" + ( Otag (mkrhs _1 1, add_info_attrs (symbol_info ()) _4, _3) ) +# 12124 "parsing/parser.ml" + : 'field)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 5 : 'label) in + let _3 = (Parsing.peek_val __caml_parser_env 3 : 'poly_type_no_attr) in + let _4 = (Parsing.peek_val __caml_parser_env 2 : 'attributes) in + let _6 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2360 "parsing/parser.mly" + ( let info = + match rhs_info 4 with + | Some _ as info_before_semi -> info_before_semi + | None -> symbol_info () + in + ( Otag (mkrhs _1 1, add_info_attrs info (_4 @ _6), _3)) ) +# 12139 "parsing/parser.ml" + : 'field_semi)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'simple_core_type) in + Obj.repr( +# 2369 "parsing/parser.mly" + ( Oinherit _1 ) +# 12146 "parsing/parser.ml" + : 'inherit_field_semi)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2372 "parsing/parser.mly" + ( _1 ) +# 12153 "parsing/parser.ml" + : 'label)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2378 "parsing/parser.mly" + ( let (n, m) = _1 in Pconst_integer (n, m) ) +# 12160 "parsing/parser.ml" + : 'constant)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in + Obj.repr( +# 2379 "parsing/parser.mly" + ( Pconst_char _1 ) +# 12167 "parsing/parser.ml" + : 'constant)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string * string option) in + Obj.repr( +# 2380 "parsing/parser.mly" + ( let (s, d) = _1 in Pconst_string (s, d) ) +# 12174 "parsing/parser.ml" + : 'constant)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2381 "parsing/parser.mly" + ( let (f, m) = _1 in Pconst_float (f, m) ) +# 12181 "parsing/parser.ml" + : 'constant)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'constant) in + Obj.repr( +# 2384 "parsing/parser.mly" + ( _1 ) +# 12188 "parsing/parser.ml" + : 'signed_constant)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2385 "parsing/parser.mly" + ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) ) +# 12195 "parsing/parser.ml" + : 'signed_constant)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2386 "parsing/parser.mly" + ( let (f, m) = _2 in Pconst_float("-" ^ f, m) ) +# 12202 "parsing/parser.ml" + : 'signed_constant)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2387 "parsing/parser.mly" + ( let (n, m) = _2 in Pconst_integer (n, m) ) +# 12209 "parsing/parser.ml" + : 'signed_constant)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2388 "parsing/parser.mly" + ( let (f, m) = _2 in Pconst_float(f, m) ) +# 12216 "parsing/parser.ml" + : 'signed_constant)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2394 "parsing/parser.mly" + ( _1 ) +# 12223 "parsing/parser.ml" + : 'ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2395 "parsing/parser.mly" + ( _1 ) +# 12230 "parsing/parser.ml" + : 'ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2398 "parsing/parser.mly" + ( _1 ) +# 12237 "parsing/parser.ml" + : 'val_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'operator) in + Obj.repr( +# 2399 "parsing/parser.mly" + ( _2 ) +# 12244 "parsing/parser.ml" + : 'val_ident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'operator) in + Obj.repr( +# 2400 "parsing/parser.mly" + ( unclosed "(" 1 ")" 3 ) +# 12251 "parsing/parser.ml" + : 'val_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2401 "parsing/parser.mly" + ( expecting 2 "operator" ) +# 12257 "parsing/parser.ml" + : 'val_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2402 "parsing/parser.mly" + ( expecting 3 "module-expr" ) +# 12263 "parsing/parser.ml" + : 'val_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2405 "parsing/parser.mly" + ( _1 ) +# 12270 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2406 "parsing/parser.mly" + ( _1 ) +# 12277 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2407 "parsing/parser.mly" + ( _1 ) +# 12284 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2408 "parsing/parser.mly" + ( _1 ) +# 12291 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2409 "parsing/parser.mly" + ( _1 ) +# 12298 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2410 "parsing/parser.mly" + ( _1 ) +# 12305 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : string) in + Obj.repr( +# 2411 "parsing/parser.mly" + ( "."^ _1 ^"()" ) +# 12312 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in + Obj.repr( +# 2412 "parsing/parser.mly" + ( "."^ _1 ^ "()<-" ) +# 12319 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : string) in + Obj.repr( +# 2413 "parsing/parser.mly" + ( "."^ _1 ^"[]" ) +# 12326 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in + Obj.repr( +# 2414 "parsing/parser.mly" + ( "."^ _1 ^ "[]<-" ) +# 12333 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : string) in + Obj.repr( +# 2415 "parsing/parser.mly" + ( "."^ _1 ^"{}" ) +# 12340 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in + Obj.repr( +# 2416 "parsing/parser.mly" + ( "."^ _1 ^ "{}<-" ) +# 12347 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2417 "parsing/parser.mly" + ( _1 ) +# 12354 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2418 "parsing/parser.mly" + ( "!" ) +# 12360 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2419 "parsing/parser.mly" + ( "+" ) +# 12366 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2420 "parsing/parser.mly" + ( "+." ) +# 12372 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2421 "parsing/parser.mly" + ( "-" ) +# 12378 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2422 "parsing/parser.mly" + ( "-." ) +# 12384 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2423 "parsing/parser.mly" + ( "*" ) +# 12390 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2424 "parsing/parser.mly" + ( "=" ) +# 12396 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2425 "parsing/parser.mly" + ( "<" ) +# 12402 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2426 "parsing/parser.mly" + ( ">" ) +# 12408 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2427 "parsing/parser.mly" + ( "or" ) +# 12414 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2428 "parsing/parser.mly" + ( "||" ) +# 12420 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2429 "parsing/parser.mly" + ( "&" ) +# 12426 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2430 "parsing/parser.mly" + ( "&&" ) +# 12432 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2431 "parsing/parser.mly" + ( ":=" ) +# 12438 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2432 "parsing/parser.mly" + ( "+=" ) +# 12444 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + Obj.repr( +# 2433 "parsing/parser.mly" + ( "%" ) +# 12450 "parsing/parser.ml" + : 'operator)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2436 "parsing/parser.mly" + ( _1 ) +# 12457 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2437 "parsing/parser.mly" + ( "[]" ) +# 12463 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2438 "parsing/parser.mly" + ( "()" ) +# 12469 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2439 "parsing/parser.mly" + ( "::" ) +# 12475 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2440 "parsing/parser.mly" + ( "false" ) +# 12481 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2441 "parsing/parser.mly" + ( "true" ) +# 12487 "parsing/parser.ml" + : 'constr_ident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'val_ident) in + Obj.repr( +# 2445 "parsing/parser.mly" + ( Lident _1 ) +# 12494 "parsing/parser.ml" + : 'val_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'val_ident) in + Obj.repr( +# 2446 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12502 "parsing/parser.ml" + : 'val_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'mod_longident) in + Obj.repr( +# 2449 "parsing/parser.mly" + ( _1 ) +# 12509 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 4 : 'mod_longident) in + Obj.repr( +# 2450 "parsing/parser.mly" + ( Ldot(_1,"::") ) +# 12516 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2451 "parsing/parser.mly" + ( Lident "[]" ) +# 12522 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2452 "parsing/parser.mly" + ( Lident "()" ) +# 12528 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2453 "parsing/parser.mly" + ( Lident "::" ) +# 12534 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2454 "parsing/parser.mly" + ( Lident "false" ) +# 12540 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + Obj.repr( +# 2455 "parsing/parser.mly" + ( Lident "true" ) +# 12546 "parsing/parser.ml" + : 'constr_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2458 "parsing/parser.mly" + ( Lident _1 ) +# 12553 "parsing/parser.ml" + : 'label_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2459 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12561 "parsing/parser.ml" + : 'label_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2462 "parsing/parser.mly" + ( Lident _1 ) +# 12568 "parsing/parser.ml" + : 'type_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_ext_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2463 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12576 "parsing/parser.ml" + : 'type_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2466 "parsing/parser.mly" + ( Lident _1 ) +# 12583 "parsing/parser.ml" + : 'mod_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2467 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12591 "parsing/parser.ml" + : 'mod_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2470 "parsing/parser.mly" + ( Lident _1 ) +# 12598 "parsing/parser.ml" + : 'mod_ext_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_ext_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2471 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12606 "parsing/parser.ml" + : 'mod_ext_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 3 : 'mod_ext_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'mod_ext_longident) in + Obj.repr( +# 2472 "parsing/parser.mly" + ( lapply _1 _3 ) +# 12614 "parsing/parser.ml" + : 'mod_ext_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2475 "parsing/parser.mly" + ( Lident _1 ) +# 12621 "parsing/parser.ml" + : 'mty_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_ext_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2476 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12629 "parsing/parser.ml" + : 'mty_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2479 "parsing/parser.mly" + ( Lident _1 ) +# 12636 "parsing/parser.ml" + : 'clty_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_ext_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2480 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12644 "parsing/parser.ml" + : 'clty_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2483 "parsing/parser.mly" + ( Lident _1 ) +# 12651 "parsing/parser.ml" + : 'class_longident)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'mod_longident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2484 "parsing/parser.mly" + ( Ldot(_1, _3) ) +# 12659 "parsing/parser.ml" + : 'class_longident)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2490 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_none) ) +# 12666 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string * string option) in + Obj.repr( +# 2491 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_string (fst _3)) ) +# 12674 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : string * char option) in + Obj.repr( +# 2492 "parsing/parser.mly" + ( let (n, m) = _3 in + Ptop_dir(_2, Pdir_int (n ,m)) ) +# 12683 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'val_longident) in + Obj.repr( +# 2494 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_ident _3) ) +# 12691 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'mod_longident) in + Obj.repr( +# 2495 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_ident _3) ) +# 12699 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + Obj.repr( +# 2496 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_bool false) ) +# 12706 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'ident) in + Obj.repr( +# 2497 "parsing/parser.mly" + ( Ptop_dir(_2, Pdir_bool true) ) +# 12713 "parsing/parser.ml" + : 'toplevel_directive)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'ident) in + Obj.repr( +# 2503 "parsing/parser.mly" + ( _2 ) +# 12720 "parsing/parser.ml" + : 'name_tag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2506 "parsing/parser.mly" + ( Nonrecursive ) +# 12726 "parsing/parser.ml" + : 'rec_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2507 "parsing/parser.mly" + ( Recursive ) +# 12732 "parsing/parser.ml" + : 'rec_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2510 "parsing/parser.mly" + ( Recursive ) +# 12738 "parsing/parser.ml" + : 'nonrec_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2511 "parsing/parser.mly" + ( Nonrecursive ) +# 12744 "parsing/parser.ml" + : 'nonrec_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2514 "parsing/parser.mly" + ( Upto ) +# 12750 "parsing/parser.ml" + : 'direction_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2515 "parsing/parser.mly" + ( Downto ) +# 12756 "parsing/parser.ml" + : 'direction_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2518 "parsing/parser.mly" + ( Public ) +# 12762 "parsing/parser.ml" + : 'private_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2519 "parsing/parser.mly" + ( Private ) +# 12768 "parsing/parser.ml" + : 'private_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2522 "parsing/parser.mly" + ( Immutable ) +# 12774 "parsing/parser.ml" + : 'mutable_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2523 "parsing/parser.mly" + ( Mutable ) +# 12780 "parsing/parser.ml" + : 'mutable_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2526 "parsing/parser.mly" + ( Concrete ) +# 12786 "parsing/parser.ml" + : 'virtual_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2527 "parsing/parser.mly" + ( Virtual ) +# 12792 "parsing/parser.ml" + : 'virtual_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2530 "parsing/parser.mly" + ( Public, Concrete ) +# 12798 "parsing/parser.ml" + : 'private_virtual_flags)) +; (fun __caml_parser_env -> + Obj.repr( +# 2531 "parsing/parser.mly" + ( Private, Concrete ) +# 12804 "parsing/parser.ml" + : 'private_virtual_flags)) +; (fun __caml_parser_env -> + Obj.repr( +# 2532 "parsing/parser.mly" + ( Public, Virtual ) +# 12810 "parsing/parser.ml" + : 'private_virtual_flags)) +; (fun __caml_parser_env -> + Obj.repr( +# 2533 "parsing/parser.mly" + ( Private, Virtual ) +# 12816 "parsing/parser.ml" + : 'private_virtual_flags)) +; (fun __caml_parser_env -> + Obj.repr( +# 2534 "parsing/parser.mly" + ( Private, Virtual ) +# 12822 "parsing/parser.ml" + : 'private_virtual_flags)) +; (fun __caml_parser_env -> + Obj.repr( +# 2537 "parsing/parser.mly" + ( Fresh ) +# 12828 "parsing/parser.ml" + : 'override_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2538 "parsing/parser.mly" + ( Override ) +# 12834 "parsing/parser.ml" + : 'override_flag)) +; (fun __caml_parser_env -> + Obj.repr( +# 2541 "parsing/parser.mly" + ( () ) +# 12840 "parsing/parser.ml" + : 'opt_bar)) +; (fun __caml_parser_env -> + Obj.repr( +# 2542 "parsing/parser.mly" + ( () ) +# 12846 "parsing/parser.ml" + : 'opt_bar)) +; (fun __caml_parser_env -> + Obj.repr( +# 2545 "parsing/parser.mly" + ( () ) +# 12852 "parsing/parser.ml" + : 'opt_semi)) +; (fun __caml_parser_env -> + Obj.repr( +# 2546 "parsing/parser.mly" + ( () ) +# 12858 "parsing/parser.ml" + : 'opt_semi)) +; (fun __caml_parser_env -> + Obj.repr( +# 2549 "parsing/parser.mly" + ( "-" ) +# 12864 "parsing/parser.ml" + : 'subtractive)) +; (fun __caml_parser_env -> + Obj.repr( +# 2550 "parsing/parser.mly" + ( "-." ) +# 12870 "parsing/parser.ml" + : 'subtractive)) +; (fun __caml_parser_env -> + Obj.repr( +# 2553 "parsing/parser.mly" + ( "+" ) +# 12876 "parsing/parser.ml" + : 'additive)) +; (fun __caml_parser_env -> + Obj.repr( +# 2554 "parsing/parser.mly" + ( "+." ) +# 12882 "parsing/parser.ml" + : 'additive)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2560 "parsing/parser.mly" + ( _1 ) +# 12889 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in + Obj.repr( +# 2561 "parsing/parser.mly" + ( _1 ) +# 12896 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2562 "parsing/parser.mly" + ( "and" ) +# 12902 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2563 "parsing/parser.mly" + ( "as" ) +# 12908 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2564 "parsing/parser.mly" + ( "assert" ) +# 12914 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2565 "parsing/parser.mly" + ( "begin" ) +# 12920 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2566 "parsing/parser.mly" + ( "class" ) +# 12926 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2567 "parsing/parser.mly" + ( "constraint" ) +# 12932 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2568 "parsing/parser.mly" + ( "do" ) +# 12938 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2569 "parsing/parser.mly" + ( "done" ) +# 12944 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2570 "parsing/parser.mly" + ( "downto" ) +# 12950 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2571 "parsing/parser.mly" + ( "else" ) +# 12956 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2572 "parsing/parser.mly" + ( "end" ) +# 12962 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2573 "parsing/parser.mly" + ( "exception" ) +# 12968 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2574 "parsing/parser.mly" + ( "external" ) +# 12974 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2575 "parsing/parser.mly" + ( "false" ) +# 12980 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2576 "parsing/parser.mly" + ( "for" ) +# 12986 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2577 "parsing/parser.mly" + ( "fun" ) +# 12992 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2578 "parsing/parser.mly" + ( "function" ) +# 12998 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2579 "parsing/parser.mly" + ( "functor" ) +# 13004 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2580 "parsing/parser.mly" + ( "if" ) +# 13010 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2581 "parsing/parser.mly" + ( "in" ) +# 13016 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2582 "parsing/parser.mly" + ( "include" ) +# 13022 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2583 "parsing/parser.mly" + ( "inherit" ) +# 13028 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2584 "parsing/parser.mly" + ( "initializer" ) +# 13034 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2585 "parsing/parser.mly" + ( "lazy" ) +# 13040 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2586 "parsing/parser.mly" + ( "let" ) +# 13046 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2587 "parsing/parser.mly" + ( "match" ) +# 13052 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2588 "parsing/parser.mly" + ( "method" ) +# 13058 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2589 "parsing/parser.mly" + ( "module" ) +# 13064 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2590 "parsing/parser.mly" + ( "mutable" ) +# 13070 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2591 "parsing/parser.mly" + ( "new" ) +# 13076 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2592 "parsing/parser.mly" + ( "nonrec" ) +# 13082 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2593 "parsing/parser.mly" + ( "object" ) +# 13088 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2594 "parsing/parser.mly" + ( "of" ) +# 13094 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2595 "parsing/parser.mly" + ( "open" ) +# 13100 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2596 "parsing/parser.mly" + ( "or" ) +# 13106 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2597 "parsing/parser.mly" + ( "private" ) +# 13112 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2598 "parsing/parser.mly" + ( "rec" ) +# 13118 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2599 "parsing/parser.mly" + ( "sig" ) +# 13124 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2600 "parsing/parser.mly" + ( "struct" ) +# 13130 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2601 "parsing/parser.mly" + ( "then" ) +# 13136 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2602 "parsing/parser.mly" + ( "to" ) +# 13142 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2603 "parsing/parser.mly" + ( "true" ) +# 13148 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2604 "parsing/parser.mly" + ( "try" ) +# 13154 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2605 "parsing/parser.mly" + ( "type" ) +# 13160 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2606 "parsing/parser.mly" + ( "val" ) +# 13166 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2607 "parsing/parser.mly" + ( "virtual" ) +# 13172 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2608 "parsing/parser.mly" + ( "when" ) +# 13178 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2609 "parsing/parser.mly" + ( "while" ) +# 13184 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + Obj.repr( +# 2610 "parsing/parser.mly" + ( "with" ) +# 13190 "parsing/parser.ml" + : 'single_attr_id)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'single_attr_id) in + Obj.repr( +# 2615 "parsing/parser.mly" + ( mkloc _1 (symbol_rloc()) ) +# 13197 "parsing/parser.ml" + : 'attr_id)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 2 : 'single_attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attr_id) in + Obj.repr( +# 2616 "parsing/parser.mly" + ( mkloc (_1 ^ "." ^ _3.txt) (symbol_rloc())) +# 13205 "parsing/parser.ml" + : 'attr_id)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'payload) in + Obj.repr( +# 2619 "parsing/parser.mly" + ( (_2, _3) ) +# 13213 "parsing/parser.ml" + : 'attribute)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'payload) in + Obj.repr( +# 2622 "parsing/parser.mly" + ( (_2, _3) ) +# 13221 "parsing/parser.ml" + : 'post_item_attribute)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'payload) in + Obj.repr( +# 2625 "parsing/parser.mly" + ( (_2, _3) ) +# 13229 "parsing/parser.ml" + : 'floating_attribute)) +; (fun __caml_parser_env -> + Obj.repr( +# 2628 "parsing/parser.mly" + ( [] ) +# 13235 "parsing/parser.ml" + : 'post_item_attributes)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'post_item_attribute) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'post_item_attributes) in + Obj.repr( +# 2629 "parsing/parser.mly" + ( _1 :: _2 ) +# 13243 "parsing/parser.ml" + : 'post_item_attributes)) +; (fun __caml_parser_env -> + Obj.repr( +# 2632 "parsing/parser.mly" + ( [] ) +# 13249 "parsing/parser.ml" + : 'attributes)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'attribute) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2633 "parsing/parser.mly" + ( _1 :: _2 ) +# 13257 "parsing/parser.ml" + : 'attributes)) +; (fun __caml_parser_env -> + Obj.repr( +# 2636 "parsing/parser.mly" + ( None, [] ) +# 13263 "parsing/parser.ml" + : 'ext_attributes)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 1 : 'attribute) in + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2637 "parsing/parser.mly" + ( None, _1 :: _2 ) +# 13271 "parsing/parser.ml" + : 'ext_attributes)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 1 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attributes) in + Obj.repr( +# 2638 "parsing/parser.mly" + ( Some _2, _3 ) +# 13279 "parsing/parser.ml" + : 'ext_attributes)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'payload) in + Obj.repr( +# 2641 "parsing/parser.mly" + ( (_2, _3) ) +# 13287 "parsing/parser.ml" + : 'extension)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'attr_id) in + let _3 = (Parsing.peek_val __caml_parser_env 1 : 'payload) in + Obj.repr( +# 2644 "parsing/parser.mly" + ( (_2, _3) ) +# 13295 "parsing/parser.ml" + : 'item_extension)) +; (fun __caml_parser_env -> + let _1 = (Parsing.peek_val __caml_parser_env 0 : 'structure) in + Obj.repr( +# 2647 "parsing/parser.mly" + ( PStr _1 ) +# 13302 "parsing/parser.ml" + : 'payload)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'signature) in + Obj.repr( +# 2648 "parsing/parser.mly" + ( PSig _2 ) +# 13309 "parsing/parser.ml" + : 'payload)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'core_type) in + Obj.repr( +# 2649 "parsing/parser.mly" + ( PTyp _2 ) +# 13316 "parsing/parser.ml" + : 'payload)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 0 : 'pattern) in + Obj.repr( +# 2650 "parsing/parser.mly" + ( PPat (_2, None) ) +# 13323 "parsing/parser.ml" + : 'payload)) +; (fun __caml_parser_env -> + let _2 = (Parsing.peek_val __caml_parser_env 2 : 'pattern) in + let _4 = (Parsing.peek_val __caml_parser_env 0 : 'seq_expr) in + Obj.repr( +# 2651 "parsing/parser.mly" + ( PPat (_2, Some _4) ) +# 13331 "parsing/parser.ml" + : 'payload)) +(* Entry implementation *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry interface *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry toplevel_phrase *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry use_file *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry parse_core_type *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry parse_expression *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +(* Entry parse_pattern *) +; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0))) +|] +let yytables = + { Parsing.actions=yyact; + Parsing.transl_const=yytransl_const; + Parsing.transl_block=yytransl_block; + Parsing.lhs=yylhs; + Parsing.len=yylen; + Parsing.defred=yydefred; + Parsing.dgoto=yydgoto; + Parsing.sindex=yysindex; + Parsing.rindex=yyrindex; + Parsing.gindex=yygindex; + Parsing.tablesize=yytablesize; + Parsing.table=yytable; + Parsing.check=yycheck; + Parsing.error_function=parse_error; + Parsing.names_const=yynames_const; + Parsing.names_block=yynames_block } +let implementation (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 1 lexfun lexbuf : Parsetree.structure) +let interface (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 2 lexfun lexbuf : Parsetree.signature) +let toplevel_phrase (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 3 lexfun lexbuf : Parsetree.toplevel_phrase) +let use_file (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 4 lexfun lexbuf : Parsetree.toplevel_phrase list) +let parse_core_type (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 5 lexfun lexbuf : Parsetree.core_type) +let parse_expression (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 6 lexfun lexbuf : Parsetree.expression) +let parse_pattern (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) = + (Parsing.yyparse yytables 7 lexfun lexbuf : Parsetree.pattern) +;; + +end +module Lexer : sig +#1 "lexer.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* The lexical analyzer *) + +val init : unit -> unit +val token: Lexing.lexbuf -> Parser.token +val skip_hash_bang: Lexing.lexbuf -> unit + +type directive_type + +type error = + | Illegal_character of char + | Illegal_escape of string + | Unterminated_comment of Location.t + | Unterminated_string + | Unterminated_string_in_comment of Location.t * Location.t + | Keyword_as_label of string + | Invalid_literal of string + | Invalid_directive of string * string option + | Unterminated_paren_in_conditional + | Unterminated_if + | Unterminated_else + | Unexpected_token_in_conditional + | Expect_hash_then_in_conditional + | Illegal_semver of string + | Unexpected_directive + | Conditional_expr_expected_type of directive_type * directive_type +;; + +exception Error of error * Location.t + +open Format + +val report_error: formatter -> error -> unit + (* Deprecated. Use Location.{error_of_exn, report_error}. *) + +val in_comment : unit -> bool;; +val in_string : unit -> bool;; + + +val print_warnings : bool ref +val handle_docstrings: bool ref +val comments : unit -> (string * Location.t) list +val token_with_comments : Lexing.lexbuf -> Parser.token + +(* + [set_preprocessor init preprocessor] registers [init] as the function +to call to initialize the preprocessor when the lexer is initialized, +and [preprocessor] a function that is called when a new token is needed +by the parser, as [preprocessor lexer lexbuf] where [lexer] is the +lexing function. + +When a preprocessor is configured by calling [set_preprocessor], the lexer +changes its behavior to accept backslash-newline as a token-separating blank. +*) + +val set_preprocessor : + (unit -> unit) -> + ((Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> Parser.token) -> + unit + +(** semantic version predicate *) +val semver : Location.t -> string -> string -> bool + +val filter_directive_from_lexbuf : Lexing.lexbuf -> (int * int) list + +val replace_directive_int : string -> int -> unit +val replace_directive_string : string -> string -> unit +val replace_directive_bool : string -> bool -> unit +val remove_directive_built_in_value : string -> unit + +(** @return false means failed to define *) +val define_key_value : string -> string -> bool +val list_variables : Format.formatter -> unit + +end = struct +#1 "lexer.ml" +# 18 "parsing/lexer.mll" + +open Lexing +open Misc +open Parser + +type directive_value = + | Dir_bool of bool + | Dir_float of float + | Dir_int of int + | Dir_string of string + | Dir_null + +type directive_type = + | Dir_type_bool + | Dir_type_float + | Dir_type_int + | Dir_type_string + | Dir_type_null + +let type_of_directive x = + match x with + | Dir_bool _ -> Dir_type_bool + | Dir_float _ -> Dir_type_float + | Dir_int _ -> Dir_type_int + | Dir_string _ -> Dir_type_string + | Dir_null -> Dir_type_null + +let string_of_type_directive x = + match x with + | Dir_type_bool -> "bool" + | Dir_type_float -> "float" + | Dir_type_int -> "int" + | Dir_type_string -> "string" + | Dir_type_null -> "null" + +type error = + | Illegal_character of char + | Illegal_escape of string + | Unterminated_comment of Location.t + | Unterminated_string + | Unterminated_string_in_comment of Location.t * Location.t + | Keyword_as_label of string + | Invalid_literal of string + | Invalid_directive of string * string option + | Unterminated_paren_in_conditional + | Unterminated_if + | Unterminated_else + | Unexpected_token_in_conditional + | Expect_hash_then_in_conditional + | Illegal_semver of string + | Unexpected_directive + | Conditional_expr_expected_type of directive_type * directive_type + +;; + +exception Error of error * Location.t;; + +let assert_same_type lexbuf x y = + let lhs = type_of_directive x in let rhs = type_of_directive y in + if lhs <> rhs then + raise (Error(Conditional_expr_expected_type(lhs,rhs), Location.curr lexbuf)) + else y + +let directive_built_in_values = + Hashtbl.create 51 + + +let replace_directive_built_in_value k v = + Hashtbl.replace directive_built_in_values k v + +let remove_directive_built_in_value k = + Hashtbl.replace directive_built_in_values k Dir_null + +let replace_directive_int k v = + Hashtbl.replace directive_built_in_values k (Dir_int v) + +let replace_directive_bool k v = + Hashtbl.replace directive_built_in_values k (Dir_bool v) + +let replace_directive_string k v = + Hashtbl.replace directive_built_in_values k (Dir_string v) + +let () = + (* Note we use {!Config} instead of {!Sys} becasue + we want to overwrite in some cases with the + same stdlib + *) + let version = + Config.version (* so that it can be overridden*) + in + replace_directive_built_in_value "OCAML_VERSION" + (Dir_string version); + replace_directive_built_in_value "OCAML_PATCH" + (Dir_string + (match String.rindex version '+' with + | exception Not_found -> "" + | i -> + String.sub version (i + 1) + (String.length version - i - 1))) + ; + replace_directive_built_in_value "OS_TYPE" + (Dir_string Sys.os_type); + replace_directive_built_in_value "BIG_ENDIAN" + (Dir_bool Sys.big_endian); + replace_directive_built_in_value "WORD_SIZE" + (Dir_int Sys.word_size) + +let find_directive_built_in_value k = + Hashtbl.find directive_built_in_values k + +let iter_directive_built_in_value f = Hashtbl.iter f directive_built_in_values + +(* + {[ + # semver 0 "12";; + - : int * int * int * string = (12, 0, 0, "");; + # semver 0 "12.3";; + - : int * int * int * string = (12, 3, 0, "");; + semver 0 "12.3.10";; + - : int * int * int * string = (12, 3, 10, "");; + # semver 0 "12.3.10+x";; + - : int * int * int * string = (12, 3, 10, "+x") + ]} +*) +let zero = Char.code '0' +let dot = Char.code '.' +let semantic_version_parse str start last_index = + let rec aux start acc last_index = + if start <= last_index then + let c = Char.code (String.unsafe_get str start) in + if c = dot then (acc, start + 1) (* consume [4.] instead of [4]*) + else + let v = c - zero in + if v >=0 && v <= 9 then + aux (start + 1) (acc * 10 + v) last_index + else (acc , start) + else (acc, start) + in + let major, major_end = aux start 0 last_index in + let minor, minor_end = aux major_end 0 last_index in + let patch, patch_end = aux minor_end 0 last_index in + let additional = String.sub str patch_end (last_index - patch_end +1) in + (major, minor, patch), additional + +(** + {[ + semver Location.none "1.2.3" "~1.3.0" = false;; + semver Location.none "1.2.3" "^1.3.0" = true ;; + semver Location.none "1.2.3" ">1.3.0" = false ;; + semver Location.none "1.2.3" ">=1.3.0" = false ;; + semver Location.none "1.2.3" "<1.3.0" = true ;; + semver Location.none "1.2.3" "<=1.3.0" = true ;; + ]} +*) +let semver loc lhs str = + let last_index = String.length str - 1 in + if last_index < 0 then raise (Error(Illegal_semver str, loc)) + else + let pred, ((major, minor, _patch) as version, _) = + let v = String.unsafe_get str 0 in + match v with + | '>' -> + if last_index = 0 then raise (Error(Illegal_semver str, loc)) else + if String.unsafe_get str 1 = '=' then + `Ge, semantic_version_parse str 2 last_index + else `Gt, semantic_version_parse str 1 last_index + | '<' + -> + if last_index = 0 then raise (Error(Illegal_semver str, loc)) else + if String.unsafe_get str 1 = '=' then + `Le, semantic_version_parse str 2 last_index + else `Lt, semantic_version_parse str 1 last_index + | '^' + -> `Compatible, semantic_version_parse str 1 last_index + | '~' -> `Approximate, semantic_version_parse str 1 last_index + | _ -> `Exact, semantic_version_parse str 0 last_index + in + let ((l_major, l_minor, _l_patch) as lversion,_) = + semantic_version_parse lhs 0 (String.length lhs - 1) in + match pred with + | `Ge -> lversion >= version + | `Gt -> lversion > version + | `Le -> lversion <= version + | `Lt -> lversion < version + | `Approximate -> major = l_major && minor = l_minor + | `Compatible -> major = l_major + | `Exact -> lversion = version + + +let pp_directive_value fmt (x : directive_value) = + match x with + | Dir_bool b -> Format.pp_print_bool fmt b + | Dir_int b -> Format.pp_print_int fmt b + | Dir_float b -> Format.pp_print_float fmt b + | Dir_string s -> Format.fprintf fmt "%S" s + | Dir_null -> Format.pp_print_string fmt "null" + +let list_variables fmt = + iter_directive_built_in_value + (fun s dir_value -> + Format.fprintf + fmt "@[%s@ %a@]@." + s pp_directive_value dir_value + ) + +let defined str = + begin match find_directive_built_in_value str with + | Dir_null -> false + | _ -> true + | exception _ -> + try ignore @@ Sys.getenv str; true with _ -> false + end + +let query _loc str = + begin match find_directive_built_in_value str with + | Dir_null -> Dir_bool false + | v -> v + | exception Not_found -> + begin match Sys.getenv str with + | v -> + begin + try Dir_bool (bool_of_string v) with + _ -> + begin + try Dir_int (int_of_string v ) + with + _ -> + begin try (Dir_float (float_of_string v)) + with _ -> Dir_string v + end + end + end + | exception Not_found -> + Dir_bool false + end + end + + +let define_key_value key v = + if String.length key > 0 + && Char.uppercase_ascii (key.[0]) = key.[0] then + begin + replace_directive_built_in_value key + begin + (* NEED Sync up across {!lexer.mll} {!bspp.ml} and here, + TODO: put it in {!lexer.mll} + *) + try Dir_bool (bool_of_string v) with + _ -> + begin + try Dir_int (int_of_string v ) + with + _ -> + begin try (Dir_float (float_of_string v)) + with _ -> Dir_string v + end + end + end; + true + end + else false + +let cvt_int_literal s = + - int_of_string ("-" ^ s) + +let value_of_token loc (t : Parser.token) = + match t with + | INT (i,None) -> Dir_int (cvt_int_literal i) + | STRING (s,_) -> Dir_string s + | FLOAT (s,None) -> Dir_float (float_of_string s) + | TRUE -> Dir_bool true + | FALSE -> Dir_bool false + | UIDENT s -> query loc s + | _ -> raise (Error (Unexpected_token_in_conditional, loc)) + + +let directive_parse token_with_comments lexbuf = + let look_ahead = ref None in + let token () : Parser.token = + let v = !look_ahead in + match v with + | Some v -> + look_ahead := None ; + v + | None -> + let rec skip () = + match token_with_comments lexbuf with + | COMMENT _ + | DOCSTRING _ + | EOL -> skip () + | EOF -> raise (Error (Unterminated_if, Location.curr lexbuf)) + | t -> t + in skip () + in + let push e = + (* INVARIANT: only look at most one token *) + assert (!look_ahead = None); + look_ahead := Some e + in + let rec + token_op calc ~no lhs = + match token () with + | (LESS + | GREATER + | INFIXOP0 "<=" + | INFIXOP0 ">=" + | EQUAL + | INFIXOP0 "<>" as op) -> + let f = + match op with + | LESS -> (<) + | GREATER -> (>) + | INFIXOP0 "<=" -> (<=) + | EQUAL -> (=) + | INFIXOP0 "<>" -> (<>) + | _ -> assert false + in + let curr_loc = Location.curr lexbuf in + let rhs = value_of_token curr_loc (token ()) in + not calc || + f lhs (assert_same_type lexbuf lhs rhs) + | INFIXOP0 "=~" -> + not calc || + begin match lhs with + | Dir_string s -> + let curr_loc = Location.curr lexbuf in + let rhs = value_of_token curr_loc (token ()) in + begin match rhs with + | Dir_string rhs -> + semver curr_loc s rhs + | _ -> + raise + (Error + ( Conditional_expr_expected_type + (Dir_type_string, type_of_directive lhs), Location.curr lexbuf)) + end + | _ -> raise + (Error + ( Conditional_expr_expected_type + (Dir_type_string, type_of_directive lhs), Location.curr lexbuf)) + end + | e -> no e + and + parse_or calc : bool = + parse_or_aux calc (parse_and calc) + and (* a || (b || (c || d))*) + parse_or_aux calc v : bool = + (* let l = v in *) + match token () with + | BARBAR -> + let b = parse_or (calc && not v) in + v || b + | e -> push e ; v + and parse_and calc = + parse_and_aux calc (parse_relation calc) + and parse_and_aux calc v = (* a && (b && (c && d)) *) + (* let l = v in *) + match token () with + | AMPERAMPER -> + let b = parse_and (calc && v) in + v && b + | e -> push e ; v + and parse_relation (calc : bool) : bool = + let curr_token = token () in + let curr_loc = Location.curr lexbuf in + match curr_token with + | TRUE -> true + | FALSE -> false + | UIDENT v -> + let value_v = query curr_loc v in + token_op calc + ~no:(fun e -> push e ; + match value_v with + | Dir_bool b -> b + | _ -> + let ty = type_of_directive value_v in + raise + (Error(Conditional_expr_expected_type (Dir_type_bool, ty), + curr_loc))) + value_v + | INT (v,None) -> + let num_v = cvt_int_literal v in + token_op calc + ~no:(fun e -> + push e; + num_v <> 0 + ) + (Dir_int num_v) + | FLOAT (v,None) -> + token_op calc + ~no:(fun _e -> + raise (Error(Conditional_expr_expected_type(Dir_type_bool, Dir_type_float), + curr_loc))) + (Dir_float (float_of_string v)) + | STRING (v,_) -> + token_op calc + ~no:(fun _e -> + raise (Error + (Conditional_expr_expected_type(Dir_type_bool, Dir_type_string), + curr_loc))) + (Dir_string v) + | LIDENT ("defined" | "undefined" as r) -> + let t = token () in + let loc = Location.curr lexbuf in + begin match t with + | UIDENT s -> + not calc || + if r.[0] = 'u' then + not @@ defined s + else defined s + | _ -> raise (Error (Unexpected_token_in_conditional, loc)) + end + | LPAREN -> + let v = parse_or calc in + begin match token () with + | RPAREN -> v + | _ -> raise (Error(Unterminated_paren_in_conditional, Location.curr lexbuf)) + end + + | _ -> raise (Error (Unexpected_token_in_conditional, curr_loc)) + in + let v = parse_or true in + begin match token () with + | THEN -> v + | _ -> raise (Error (Expect_hash_then_in_conditional, Location.curr lexbuf)) + end + + +type dir_conditional = + | Dir_if_true + | Dir_if_false + | Dir_out + +(* let string_of_dir_conditional (x : dir_conditional) = *) +(* match x with *) +(* | Dir_if_true -> "Dir_if_true" *) +(* | Dir_if_false -> "Dir_if_false" *) +(* | Dir_out -> "Dir_out" *) + +let is_elif (i : Parser.token ) = + match i with + | LIDENT "elif" -> true + | _ -> false (* avoid polymorphic equal *) + + +(* The table of keywords *) + +let keyword_table = + create_hashtable 149 [ + "and", AND; + "as", AS; + "assert", ASSERT; + "begin", BEGIN; + "class", CLASS; + "constraint", CONSTRAINT; + "do", DO; + "done", DONE; + "downto", DOWNTO; + "else", ELSE; + "end", END; + "exception", EXCEPTION; + "external", EXTERNAL; + "false", FALSE; + "for", FOR; + "fun", FUN; + "function", FUNCTION; + "functor", FUNCTOR; + "if", IF; + "in", IN; + "include", INCLUDE; + "inherit", INHERIT; + "initializer", INITIALIZER; + "lazy", LAZY; + "let", LET; + "match", MATCH; + "method", METHOD; + "module", MODULE; + "mutable", MUTABLE; + "new", NEW; + "nonrec", NONREC; + "object", OBJECT; + "of", OF; + "open", OPEN; + "or", OR; +(* "parser", PARSER; *) + "private", PRIVATE; + "rec", REC; + "sig", SIG; + "struct", STRUCT; + "then", THEN; + "to", TO; + "true", TRUE; + "try", TRY; + "type", TYPE; + "val", VAL; + "virtual", VIRTUAL; + "when", WHEN; + "while", WHILE; + "with", WITH; + + "lor", INFIXOP3("lor"); (* Should be INFIXOP2 *) + "lxor", INFIXOP3("lxor"); (* Should be INFIXOP2 *) + "mod", INFIXOP3("mod"); + "land", INFIXOP3("land"); + "lsl", INFIXOP4("lsl"); + "lsr", INFIXOP4("lsr"); + "asr", INFIXOP4("asr") +] + +(* To buffer string literals *) + +let string_buffer = Buffer.create 256 +let reset_string_buffer () = Buffer.reset string_buffer +let get_stored_string () = Buffer.contents string_buffer + +let store_string_char c = Buffer.add_char string_buffer c +let store_string_utf_8_uchar u = Buffer.add_utf_8_uchar string_buffer u +let store_string s = Buffer.add_string string_buffer s +let store_lexeme lexbuf = store_string (Lexing.lexeme lexbuf) + +(* To store the position of the beginning of a string and comment *) +let string_start_loc = ref Location.none;; +let comment_start_loc = ref [];; +let in_comment () = !comment_start_loc <> [];; +let is_in_string = ref false +let in_string () = !is_in_string +let print_warnings = ref true +let if_then_else = ref Dir_out +let sharp_look_ahead = ref None +let update_if_then_else v = + (* Format.fprintf Format.err_formatter "@[update %s \n@]@." (string_of_dir_conditional v); *) + if_then_else := v + +(* Escaped chars are interpreted in strings unless they are in comments. *) +let store_escaped_char lexbuf c = + if in_comment () then store_lexeme lexbuf else store_string_char c + +let store_escaped_uchar lexbuf u = + if in_comment () then store_lexeme lexbuf else store_string_utf_8_uchar u + +let with_comment_buffer comment lexbuf = + let start_loc = Location.curr lexbuf in + comment_start_loc := [start_loc]; + reset_string_buffer (); + let end_loc = comment lexbuf in + let s = get_stored_string () in + reset_string_buffer (); + let loc = { start_loc with Location.loc_end = end_loc.Location.loc_end } in + s, loc + +(* To translate escape sequences *) + +let hex_digit_value d = (* assert (d in '0'..'9' 'a'..'f' 'A'..'F') *) + let d = Char.code d in + if d >= 97 then d - 87 else + if d >= 65 then d - 55 else + d - 48 + +let hex_num_value lexbuf ~first ~last = + let rec loop acc i = match i > last with + | true -> acc + | false -> + let value = hex_digit_value (Lexing.lexeme_char lexbuf i) in + loop (16 * acc + value) (i + 1) + in + loop 0 first + +let char_for_backslash = function + | 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + +let char_for_decimal_code lexbuf i = + let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + + 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + + (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in + if (c < 0 || c > 255) then + if in_comment () + then 'x' + else raise (Error(Illegal_escape (Lexing.lexeme lexbuf), + Location.curr lexbuf)) + else Char.chr c + +let char_for_octal_code lexbuf i = + let c = 64 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + + 8 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + + (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in + Char.chr c + +let char_for_hexadecimal_code lexbuf i = + let byte = hex_num_value lexbuf ~first:i ~last:(i+1) in + Char.chr byte + +let uchar_for_uchar_escape lexbuf = + let err e = + raise + (Error (Illegal_escape (Lexing.lexeme lexbuf ^ e), Location.curr lexbuf)) + in + let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in + let first = 3 (* skip opening \u{ *) in + let last = len - 2 (* skip closing } *) in + let digit_count = last - first + 1 in + match digit_count > 6 with + | true -> err ", too many digits, expected 1 to 6 hexadecimal digits" + | false -> + let cp = hex_num_value lexbuf ~first ~last in + if Uchar.is_valid cp then Uchar.unsafe_of_int cp else + err (", " ^ Printf.sprintf "%X" cp ^ " is not a Unicode scalar value") + +(* recover the name from a LABEL or OPTLABEL token *) + +let get_label_name lexbuf = + let s = Lexing.lexeme lexbuf in + let name = String.sub s 1 (String.length s - 2) in + if Hashtbl.mem keyword_table name then + raise (Error(Keyword_as_label name, Location.curr lexbuf)); + name +;; + +(* Update the current location with file name and line number. *) + +let update_loc lexbuf file line absolute chars = + let pos = lexbuf.lex_curr_p in + let new_file = match file with + | None -> pos.pos_fname + | Some s -> s + in + lexbuf.lex_curr_p <- { pos with + pos_fname = new_file; + pos_lnum = if absolute then line else pos.pos_lnum + line; + pos_bol = pos.pos_cnum - chars; + } +;; + +let preprocessor = ref None + +let escaped_newlines = ref false + +(* Warn about Latin-1 characters used in idents *) + +let warn_latin1 lexbuf = + Location.deprecated (Location.curr lexbuf)"ISO-Latin1 characters in identifiers" + +let handle_docstrings = ref true +let comment_list = ref [] + +let add_comment com = + comment_list := com :: !comment_list + +let add_docstring_comment ds = + let com = + ("*" ^ Docstrings.docstring_body ds, Docstrings.docstring_loc ds) + in + add_comment com + +let comments () = List.rev !comment_list + +(* Error report *) + +open Format + +let report_error ppf = function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_escape s -> + fprintf ppf "Illegal backslash escape in string or character (%s)" s + | Unterminated_comment _ -> + fprintf ppf "Comment not terminated" + | Unterminated_string -> + fprintf ppf "String literal not terminated" + | Unterminated_string_in_comment (_, loc) -> + fprintf ppf "This comment contains an unterminated string literal@.\ + %aString literal begins here" + Location.print_error loc + | Keyword_as_label kwd -> + fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd + | Invalid_literal s -> + fprintf ppf "Invalid literal %s" s + | Invalid_directive (dir, explanation) -> + fprintf ppf "Invalid lexer directive %S" dir; + begin match explanation with + | None -> () + | Some expl -> fprintf ppf ": %s" expl + end + | Unterminated_if -> + fprintf ppf "#if not terminated" + | Unterminated_else -> + fprintf ppf "#else not terminated" + | Unexpected_directive -> fprintf ppf "Unexpected directive" + | Unexpected_token_in_conditional -> + fprintf ppf "Unexpected token in conditional predicate" + | Unterminated_paren_in_conditional -> + fprintf ppf "Unterminated parens in conditional predicate" + | Expect_hash_then_in_conditional -> + fprintf ppf "Expect `then` after conditional predicate" + | Conditional_expr_expected_type (a,b) -> + fprintf ppf "Conditional expression type mismatch (%s,%s)" + (string_of_type_directive a ) + (string_of_type_directive b ) + | Illegal_semver s -> + fprintf ppf "Illegal semantic version string %s" s + +let () = + Location.register_error_of_exn + (function + | Error (err, loc) -> + Some (Location.error_of_printer loc report_error err) + | _ -> + None + ) + + +# 717 "parsing/lexer.ml" +let __ocaml_lex_tables = { + Lexing.lex_base = + "\000\000\162\255\163\255\224\000\003\001\038\001\073\001\108\001\ + \143\001\186\255\178\001\215\001\194\255\091\000\252\001\031\002\ + \068\000\071\000\065\002\100\002\212\255\214\255\217\255\135\002\ + \230\002\009\003\088\000\255\000\039\003\236\255\123\003\207\003\ + \035\004\243\004\195\005\147\006\114\007\206\007\158\008\122\000\ + \254\255\001\000\005\000\255\255\006\000\007\000\125\009\155\009\ + \107\010\250\255\249\255\059\011\011\012\247\255\246\255\219\012\ + \047\013\131\013\215\013\043\014\127\014\211\014\039\015\123\015\ + \207\015\035\016\087\000\119\016\203\016\031\017\115\017\199\017\ + \108\000\192\255\235\255\007\003\034\018\106\000\107\000\011\000\ + \234\255\233\255\228\255\152\002\099\000\118\000\113\000\232\255\ + \128\000\147\000\231\255\224\000\003\001\148\000\230\255\110\004\ + \149\000\229\255\148\000\224\255\217\000\223\255\222\000\034\018\ + \222\255\073\018\101\005\009\003\221\255\012\000\014\001\080\001\ + \115\001\024\001\221\255\013\000\119\018\158\018\193\018\231\018\ + \010\019\209\255\204\255\205\255\206\255\202\255\045\019\154\000\ + \183\000\195\255\196\255\197\255\217\000\182\255\180\255\189\255\ + \080\019\185\255\187\255\115\019\150\019\185\019\220\019\130\005\ + \243\255\244\255\017\000\245\255\174\001\223\005\253\255\248\000\ + \249\000\255\255\254\255\252\255\005\006\238\019\003\001\004\001\ + \018\000\251\255\250\255\249\255\222\006\026\003\005\001\248\255\ + \036\003\008\001\247\255\066\008\020\001\246\255\059\001\234\001\ + \245\255\246\255\247\255\060\001\055\020\255\255\248\255\193\000\ + \233\008\038\001\133\004\253\255\073\001\094\001\113\001\143\004\ + \252\255\192\002\027\004\251\255\230\009\250\255\182\010\089\020\ + \249\255\129\001\130\001\252\255\085\007\254\255\255\255\146\001\ + \147\001\253\255\177\007\033\001\044\001\148\001\151\001\045\001\ + \153\001\044\001\019\000\255\255"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\090\000\089\000\086\000\085\000\078\000\ + \076\000\255\255\067\000\064\000\255\255\057\000\056\000\054\000\ + \052\000\048\000\045\000\081\000\255\255\255\255\255\255\036\000\ + \035\000\042\000\040\000\039\000\062\000\255\255\014\000\014\000\ + \013\000\012\000\011\000\010\000\007\000\004\000\003\000\002\000\ + \255\255\093\000\093\000\255\255\255\255\255\255\084\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\018\000\ + \018\000\016\000\015\000\018\000\015\000\015\000\014\000\016\000\ + \015\000\016\000\255\255\017\000\017\000\014\000\014\000\016\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\027\000\027\000\027\000\027\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\028\000\255\255\029\000\255\255\030\000\088\000\ + \255\255\091\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\037\000\087\000\082\000\044\000\ + \047\000\255\255\255\255\255\255\255\255\255\255\055\000\074\000\ + \071\000\255\255\255\255\255\255\072\000\255\255\255\255\255\255\ + \065\000\255\255\255\255\083\000\077\000\080\000\079\000\255\255\ + \255\255\255\255\012\000\255\255\012\000\012\000\255\255\012\000\ + \012\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\010\000\010\000\255\255\255\255\007\000\ + \007\000\007\000\007\000\255\255\001\000\007\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\003\000\255\255\255\255\003\000\ + \255\255\255\255\255\255\002\000\255\255\255\255\001\000\255\255\ + \255\255\255\255\255\255\255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\255\255\255\255\000\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\000\000\000\000\000\000\255\255\ + \255\255\255\255\255\255\077\000\255\255\000\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \000\000\255\255\255\255\000\000\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\255\255\255\255\000\000\000\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\255\255\082\000\255\255\255\255\255\255\ + \000\000\000\000\000\000\255\255\255\255\255\255\255\255\000\000\ + \255\255\255\255\000\000\255\255\255\255\255\255\000\000\255\255\ + \255\255\000\000\255\255\000\000\255\255\000\000\255\255\255\255\ + \000\000\255\255\110\000\255\255\000\000\255\255\110\000\111\000\ + \110\000\113\000\000\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\000\000\000\000\000\000\255\255\255\255\ + \255\255\000\000\000\000\000\000\255\255\000\000\000\000\000\000\ + \255\255\000\000\000\000\255\255\255\255\255\255\255\255\144\000\ + \000\000\000\000\255\255\000\000\158\000\255\255\000\000\255\255\ + \255\255\000\000\000\000\000\000\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\000\000\255\255\255\255\255\255\000\000\ + \255\255\255\255\000\000\255\255\255\255\000\000\255\255\176\000\ + \000\000\000\000\000\000\255\255\182\000\000\000\000\000\255\255\ + \255\255\255\255\255\255\000\000\255\255\255\255\255\255\255\255\ + \000\000\255\255\255\255\000\000\255\255\000\000\255\255\255\255\ + \000\000\255\255\203\000\000\000\255\255\000\000\000\000\255\255\ + \255\255\000\000\255\255\255\255\255\255\213\000\216\000\255\255\ + \216\000\255\255\255\255\000\000"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\039\000\040\000\040\000\039\000\041\000\045\000\043\000\ + \043\000\040\000\044\000\044\000\045\000\078\000\108\000\114\000\ + \079\000\109\000\115\000\145\000\159\000\219\000\174\000\160\000\ + \039\000\008\000\029\000\024\000\006\000\004\000\023\000\027\000\ + \026\000\021\000\025\000\007\000\020\000\019\000\018\000\003\000\ + \031\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\017\000\016\000\015\000\014\000\010\000\036\000\ + \005\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\013\000\042\000\012\000\005\000\038\000\ + \022\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\028\000\011\000\009\000\037\000\125\000\ + \127\000\124\000\098\000\039\000\123\000\122\000\039\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\081\000\080\000\091\000\091\000\091\000\091\000\130\000\ + \087\000\129\000\039\000\128\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\090\000\094\000\097\000\099\000\100\000\134\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\131\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\132\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \002\000\003\000\101\000\102\000\003\000\003\000\003\000\101\000\ + \102\000\078\000\003\000\003\000\079\000\003\000\003\000\003\000\ + \092\000\092\000\092\000\092\000\092\000\092\000\092\000\092\000\ + \108\000\133\000\003\000\109\000\003\000\003\000\003\000\003\000\ + \003\000\154\000\114\000\153\000\003\000\115\000\255\255\003\000\ + \003\000\003\000\163\000\162\000\167\000\003\000\003\000\170\000\ + \003\000\003\000\003\000\093\000\093\000\093\000\093\000\093\000\ + \093\000\093\000\093\000\173\000\198\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\212\000\145\000\178\000\005\000\ + \174\000\201\000\005\000\005\000\005\000\213\000\217\000\218\000\ + \005\000\005\000\188\000\005\000\005\000\005\000\193\000\193\000\ + \193\000\193\000\108\000\076\000\003\000\109\000\003\000\000\000\ + \005\000\003\000\005\000\005\000\005\000\005\000\005\000\000\000\ + \188\000\188\000\006\000\190\000\000\000\006\000\006\000\006\000\ + \000\000\000\000\113\000\006\000\006\000\000\000\006\000\006\000\ + \006\000\000\000\000\000\188\000\112\000\108\000\190\000\003\000\ + \109\000\003\000\000\000\006\000\005\000\006\000\006\000\006\000\ + \006\000\006\000\000\000\178\000\206\000\117\000\201\000\207\000\ + \117\000\117\000\117\000\112\000\000\000\111\000\117\000\117\000\ + \000\000\117\000\142\000\117\000\206\000\206\000\214\000\208\000\ + \208\000\215\000\005\000\215\000\005\000\000\000\117\000\006\000\ + \117\000\141\000\117\000\117\000\117\000\000\000\000\000\000\000\ + \139\000\000\000\000\000\139\000\139\000\139\000\000\000\000\000\ + \159\000\139\000\139\000\160\000\139\000\139\000\139\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\006\000\000\000\006\000\ + \000\000\139\000\117\000\139\000\140\000\139\000\139\000\139\000\ + \000\000\000\000\000\000\006\000\000\000\161\000\006\000\006\000\ + \006\000\000\000\000\000\000\000\006\000\006\000\000\000\006\000\ + \006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \117\000\000\000\117\000\000\000\006\000\139\000\006\000\006\000\ + \006\000\006\000\006\000\000\000\178\000\000\000\000\000\179\000\ + \006\000\000\000\000\000\006\000\006\000\006\000\204\000\255\255\ + \000\000\006\000\006\000\000\000\006\000\006\000\006\000\000\000\ + \000\000\000\000\157\000\139\000\181\000\139\000\255\255\138\000\ + \006\000\006\000\000\000\006\000\006\000\006\000\006\000\006\000\ + \255\255\000\000\000\000\000\000\000\000\006\000\000\000\000\000\ + \006\000\006\000\006\000\000\000\000\000\000\000\006\000\006\000\ + \000\000\006\000\006\000\006\000\000\000\000\000\006\000\137\000\ + \006\000\000\000\000\000\000\000\135\000\006\000\006\000\000\000\ + \006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\ + \006\000\000\000\000\000\006\000\006\000\006\000\180\000\000\000\ + \000\000\006\000\006\000\000\000\126\000\006\000\006\000\000\000\ + \255\255\000\000\000\000\136\000\000\000\006\000\000\000\000\000\ + \000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\ + \000\000\000\000\120\000\000\000\000\000\120\000\120\000\120\000\ + \000\000\000\000\000\000\120\000\120\000\000\000\120\000\121\000\ + \120\000\000\000\000\000\255\255\000\000\000\000\000\000\000\000\ + \006\000\000\000\006\000\120\000\000\000\006\000\120\000\120\000\ + \120\000\120\000\205\000\000\000\000\000\117\000\000\000\000\000\ + \117\000\117\000\117\000\000\000\000\000\000\000\117\000\117\000\ + \000\000\117\000\118\000\117\000\255\255\000\000\000\000\255\255\ + \000\000\255\255\000\000\006\000\000\000\006\000\117\000\120\000\ + \117\000\117\000\119\000\117\000\117\000\000\000\000\000\000\000\ + \006\000\000\000\000\000\006\000\006\000\116\000\255\255\000\000\ + \000\000\006\000\006\000\000\000\006\000\006\000\006\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\120\000\000\000\120\000\ + \000\000\006\000\117\000\006\000\006\000\006\000\006\000\006\000\ + \095\000\095\000\095\000\095\000\095\000\095\000\095\000\095\000\ + \095\000\095\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\095\000\095\000\095\000\095\000\095\000\095\000\000\000\ + \117\000\000\000\117\000\000\000\000\000\006\000\000\000\000\000\ + \000\000\000\000\177\000\000\000\000\000\000\000\000\000\107\000\ + \194\000\194\000\194\000\194\000\194\000\194\000\194\000\194\000\ + \000\000\095\000\095\000\095\000\095\000\095\000\095\000\000\000\ + \000\000\000\000\000\000\006\000\000\000\006\000\107\000\105\000\ + \000\000\105\000\105\000\105\000\105\000\000\000\000\000\000\000\ + \105\000\105\000\107\000\105\000\105\000\105\000\106\000\106\000\ + \106\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ + \105\000\000\000\105\000\105\000\105\000\105\000\105\000\000\000\ + \000\000\107\000\003\000\000\000\000\000\003\000\003\000\003\000\ + \000\000\000\000\104\000\103\000\003\000\000\000\003\000\003\000\ + \003\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ + \106\000\106\000\106\000\003\000\105\000\003\000\003\000\003\000\ + \003\000\003\000\168\000\168\000\168\000\168\000\168\000\168\000\ + \168\000\168\000\168\000\168\000\169\000\169\000\169\000\169\000\ + \169\000\169\000\169\000\169\000\169\000\169\000\000\000\000\000\ + \000\000\000\000\105\000\073\000\105\000\000\000\075\000\003\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\000\000\074\000\000\000\003\000\075\000\003\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\055\000\074\000\000\000\000\000\000\000\000\000\ + \000\000\057\000\000\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \056\000\055\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\000\000\000\000\ + \000\000\000\000\030\000\000\000\055\000\055\000\055\000\055\000\ + \056\000\055\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\057\000\000\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\059\000\055\000\055\000\056\000\055\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\060\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\061\000\ + \058\000\058\000\000\000\000\000\000\000\000\000\030\000\000\000\ + \055\000\059\000\055\000\055\000\056\000\055\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\060\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\061\000\ + \058\000\058\000\032\000\195\000\195\000\195\000\195\000\195\000\ + \195\000\195\000\195\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\000\000\000\000\ + \000\000\000\000\032\000\000\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\096\000\096\000\ + \096\000\096\000\096\000\096\000\096\000\096\000\096\000\096\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\096\000\ + \096\000\096\000\096\000\096\000\096\000\191\000\191\000\191\000\ + \191\000\191\000\191\000\191\000\191\000\191\000\191\000\192\000\ + \192\000\192\000\192\000\192\000\192\000\192\000\192\000\192\000\ + \192\000\000\000\000\000\000\000\000\000\000\000\000\000\096\000\ + \096\000\096\000\096\000\096\000\096\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\000\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\033\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\000\000\000\000\ + \000\000\000\000\033\000\000\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\112\000\108\000\ + \000\000\000\000\109\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\112\000\000\000\111\000\ + \000\000\000\000\000\000\000\000\145\000\000\000\000\000\146\000\ + \000\000\000\000\000\000\000\000\000\000\106\000\106\000\106\000\ + \106\000\106\000\106\000\106\000\106\000\106\000\106\000\000\000\ + \000\000\000\000\000\000\000\000\150\000\000\000\000\000\000\000\ + \000\000\148\000\152\000\000\000\151\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\000\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\034\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\149\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\000\000\000\000\ + \000\000\000\000\034\000\000\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\156\000\000\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\000\000\155\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\156\000\255\255\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \000\000\155\000\147\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\000\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\035\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\000\000\000\000\ + \000\000\000\000\035\000\000\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\171\000\171\000\ + \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\171\000\ + \171\000\171\000\171\000\171\000\171\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\171\000\ + \171\000\171\000\171\000\171\000\171\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\000\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\000\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\046\000\000\000\000\000\046\000\046\000\ + \046\000\000\000\000\000\000\000\046\000\046\000\000\000\046\000\ + \046\000\046\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\046\000\000\000\046\000\046\000\ + \046\000\046\000\046\000\000\000\210\000\000\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \046\000\052\000\209\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\000\000\046\000\046\000\ + \046\000\000\000\046\000\046\000\046\000\000\000\000\000\000\000\ + \046\000\046\000\000\000\046\000\046\000\046\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \046\000\000\000\046\000\046\000\046\000\046\000\046\000\000\000\ + \210\000\000\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\046\000\048\000\209\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\000\000\046\000\000\000\046\000\000\000\000\000\000\000\ + \000\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\000\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\172\000\172\000\172\000\172\000\172\000\172\000\ + \172\000\172\000\172\000\172\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\172\000\172\000\172\000\172\000\172\000\ + \172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\172\000\172\000\172\000\172\000\172\000\ + \172\000\000\000\000\000\000\000\000\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\035\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\000\000\000\000\000\000\000\000\035\000\000\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\196\000\196\000\196\000\196\000\196\000\196\000\196\000\ + \196\000\196\000\196\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\196\000\196\000\196\000\196\000\196\000\196\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\196\000\196\000\196\000\196\000\196\000\196\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\000\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\000\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\046\000\000\000\ + \000\000\046\000\046\000\046\000\000\000\000\000\000\000\046\000\ + \046\000\000\000\046\000\046\000\046\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\000\ + \000\000\046\000\046\000\046\000\046\000\046\000\000\000\000\000\ + \000\000\000\000\047\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\050\000\000\000\000\000\ + \000\000\000\000\000\000\046\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\000\000\000\000\ + \000\000\046\000\047\000\046\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\197\000\197\000\ + \197\000\197\000\197\000\197\000\197\000\197\000\197\000\197\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\ + \197\000\197\000\197\000\197\000\197\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\ + \197\000\197\000\197\000\197\000\197\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\000\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\048\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\049\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\000\000\000\000\ + \000\000\000\000\048\000\000\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\199\000\199\000\ + \199\000\199\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\199\000\ + \199\000\199\000\199\000\199\000\199\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\199\000\ + \199\000\199\000\199\000\199\000\199\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\000\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\051\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\054\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\000\000\000\000\ + \000\000\000\000\051\000\000\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\000\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\052\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\053\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\000\000\000\000\ + \000\000\000\000\052\000\000\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\000\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\055\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\000\000\000\000\ + \000\000\000\000\055\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\000\000\ + \000\000\000\000\072\000\000\000\072\000\000\000\000\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \056\000\055\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\000\000\000\000\ + \000\000\000\000\057\000\000\000\055\000\055\000\055\000\055\000\ + \056\000\055\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\070\000\070\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\000\000\000\000\ + \000\000\000\000\055\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\055\000\ + \055\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\000\000\000\000\ + \000\000\000\000\055\000\000\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\063\000\000\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\064\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\000\000\000\000\000\000\000\000\062\000\000\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\064\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\068\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\000\000\000\000\ + \000\000\000\000\063\000\000\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\068\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\055\000\000\000\ + \000\000\000\000\066\000\000\000\066\000\000\000\000\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\000\000\000\000\ + \000\000\000\000\065\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\000\000\000\000\000\000\066\000\000\000\ + \066\000\000\000\000\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\000\000\000\000\ + \000\000\000\000\055\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\055\000\ + \055\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\000\000\000\000\000\000\000\000\069\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\055\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\070\000\070\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\000\000\000\000\ + \000\000\000\000\070\000\000\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\055\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\000\000\000\000\000\000\000\000\071\000\000\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\086\000\103\000\086\000\000\000\103\000\103\000\ + \103\000\086\000\000\000\000\000\103\000\103\000\000\000\103\000\ + \103\000\103\000\085\000\085\000\085\000\085\000\085\000\085\000\ + \085\000\085\000\085\000\085\000\103\000\000\000\103\000\103\000\ + \103\000\103\000\103\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\105\000\000\000\105\000\105\000\105\000\105\000\ + \000\000\000\000\000\000\105\000\105\000\000\000\105\000\105\000\ + \105\000\000\000\000\000\000\000\000\000\000\000\086\000\000\000\ + \103\000\000\000\000\000\105\000\086\000\105\000\105\000\105\000\ + \105\000\105\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \086\000\084\000\000\000\000\000\086\000\000\000\086\000\000\000\ + \006\000\000\000\083\000\006\000\006\000\006\000\103\000\000\000\ + \103\000\006\000\006\000\000\000\006\000\006\000\006\000\105\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\006\000\000\000\006\000\006\000\006\000\006\000\006\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\117\000\ + \000\000\000\000\117\000\117\000\117\000\105\000\000\000\105\000\ + \117\000\117\000\000\000\117\000\117\000\117\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\ + \117\000\000\000\117\000\117\000\117\000\117\000\117\000\000\000\ + \000\000\000\000\117\000\000\000\000\000\117\000\117\000\117\000\ + \000\000\000\000\000\000\117\000\117\000\000\000\117\000\117\000\ + \117\000\000\000\000\000\006\000\000\000\006\000\000\000\000\000\ + \000\000\000\000\000\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \117\000\000\000\000\000\117\000\117\000\117\000\000\000\000\000\ + \000\000\117\000\117\000\000\000\117\000\117\000\117\000\000\000\ + \000\000\000\000\117\000\000\000\117\000\000\000\000\000\117\000\ + \000\000\117\000\255\255\117\000\117\000\117\000\117\000\117\000\ + \000\000\000\000\000\000\120\000\000\000\000\000\120\000\120\000\ + \120\000\000\000\000\000\000\000\120\000\120\000\000\000\120\000\ + \120\000\120\000\000\000\000\000\000\000\117\000\000\000\117\000\ + \000\000\000\000\000\000\000\000\120\000\117\000\120\000\120\000\ + \120\000\120\000\120\000\000\000\000\000\000\000\006\000\000\000\ + \000\000\006\000\006\000\006\000\000\000\000\000\000\000\006\000\ + \006\000\000\000\006\000\006\000\006\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\117\000\000\000\117\000\000\000\006\000\ + \120\000\006\000\006\000\006\000\006\000\006\000\000\000\000\000\ + \000\000\006\000\000\000\000\000\006\000\006\000\006\000\000\000\ + \000\000\000\000\006\000\006\000\000\000\006\000\006\000\006\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\120\000\000\000\ + \120\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\ + \006\000\000\000\000\000\000\000\139\000\000\000\000\000\139\000\ + \139\000\139\000\000\000\000\000\000\000\139\000\139\000\000\000\ + \139\000\139\000\139\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\006\000\000\000\006\000\000\000\139\000\006\000\139\000\ + \139\000\139\000\139\000\139\000\000\000\000\000\000\000\139\000\ + \000\000\000\000\139\000\139\000\139\000\000\000\000\000\000\000\ + \139\000\139\000\000\000\139\000\139\000\139\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\006\000\000\000\006\000\000\000\ + \139\000\139\000\139\000\139\000\139\000\139\000\139\000\000\000\ + \000\000\000\000\117\000\000\000\000\000\117\000\117\000\117\000\ + \000\000\000\000\000\000\117\000\117\000\000\000\117\000\117\000\ + \117\000\000\000\000\000\000\000\000\000\000\000\000\000\139\000\ + \000\000\139\000\000\000\117\000\139\000\117\000\117\000\117\000\ + \117\000\117\000\000\000\000\000\000\000\117\000\000\000\000\000\ + \117\000\117\000\117\000\000\000\000\000\000\000\117\000\117\000\ + \000\000\117\000\117\000\117\000\000\000\000\000\166\000\000\000\ + \166\000\000\000\139\000\000\000\139\000\166\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\000\000\165\000\165\000\ + \165\000\165\000\165\000\165\000\165\000\165\000\165\000\165\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\117\000\000\000\117\000\ + \000\000\000\000\117\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\188\000\000\000\000\000\189\000\000\000\000\000\000\000\ + \000\000\000\000\166\000\000\000\000\000\000\000\000\000\000\000\ + \166\000\000\000\000\000\000\000\000\000\000\000\000\000\187\000\ + \117\000\187\000\117\000\000\000\166\000\000\000\187\000\000\000\ + \166\000\000\000\166\000\000\000\000\000\000\000\164\000\186\000\ + \186\000\186\000\186\000\186\000\186\000\186\000\186\000\186\000\ + \186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\199\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \199\000\199\000\199\000\187\000\000\000\000\000\000\000\000\000\ + \000\000\187\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \000\000\000\000\000\000\000\000\000\000\187\000\185\000\000\000\ + \000\000\187\000\000\000\187\000\183\000\000\000\000\000\184\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\200\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\041\000\000\000\000\000\041\000\042\000\ + \044\000\045\000\042\000\044\000\045\000\079\000\109\000\115\000\ + \079\000\109\000\115\000\146\000\160\000\218\000\146\000\160\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\ + \013\000\017\000\026\000\039\000\017\000\017\000\039\000\066\000\ + \066\000\066\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \066\000\077\000\078\000\084\000\084\000\084\000\084\000\013\000\ + \086\000\013\000\039\000\013\000\072\000\072\000\072\000\072\000\ + \072\000\072\000\072\000\072\000\072\000\072\000\085\000\085\000\ + \085\000\085\000\085\000\085\000\085\000\085\000\085\000\085\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\089\000\093\000\096\000\098\000\098\000\127\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\013\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\003\000\100\000\100\000\003\000\003\000\003\000\102\000\ + \102\000\027\000\003\000\003\000\027\000\003\000\003\000\003\000\ + \091\000\091\000\091\000\091\000\091\000\091\000\091\000\091\000\ + \110\000\132\000\003\000\110\000\003\000\003\000\003\000\003\000\ + \003\000\151\000\113\000\152\000\004\000\113\000\027\000\004\000\ + \004\000\004\000\158\000\159\000\166\000\004\000\004\000\169\000\ + \004\000\004\000\004\000\092\000\092\000\092\000\092\000\092\000\ + \092\000\092\000\092\000\172\000\183\000\004\000\003\000\004\000\ + \004\000\004\000\004\000\004\000\211\000\174\000\179\000\005\000\ + \174\000\179\000\005\000\005\000\005\000\212\000\215\000\217\000\ + \005\000\005\000\188\000\005\000\005\000\005\000\185\000\185\000\ + \185\000\185\000\111\000\027\000\003\000\111\000\003\000\255\255\ + \005\000\004\000\005\000\005\000\005\000\005\000\005\000\255\255\ + \189\000\188\000\006\000\189\000\255\255\006\000\006\000\006\000\ + \255\255\255\255\111\000\006\000\006\000\255\255\006\000\006\000\ + \006\000\255\255\255\255\190\000\112\000\112\000\190\000\004\000\ + \112\000\004\000\255\255\006\000\005\000\006\000\006\000\006\000\ + \006\000\006\000\255\255\201\000\202\000\007\000\201\000\202\000\ + \007\000\007\000\007\000\112\000\255\255\112\000\007\000\007\000\ + \255\255\007\000\007\000\007\000\207\000\208\000\213\000\207\000\ + \208\000\214\000\005\000\216\000\005\000\255\255\007\000\006\000\ + \007\000\007\000\007\000\007\000\007\000\255\255\255\255\255\255\ + \008\000\255\255\255\255\008\000\008\000\008\000\255\255\255\255\ + \148\000\008\000\008\000\148\000\008\000\008\000\008\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\006\000\255\255\006\000\ + \255\255\008\000\007\000\008\000\008\000\008\000\008\000\008\000\ + \255\255\255\255\255\255\010\000\255\255\148\000\010\000\010\000\ + \010\000\255\255\255\255\255\255\010\000\010\000\255\255\010\000\ + \010\000\010\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \007\000\255\255\007\000\255\255\010\000\008\000\010\000\010\000\ + \010\000\010\000\010\000\255\255\175\000\255\255\255\255\175\000\ + \011\000\255\255\255\255\011\000\011\000\011\000\202\000\027\000\ + \255\255\011\000\011\000\255\255\011\000\011\000\011\000\255\255\ + \255\255\255\255\148\000\008\000\175\000\008\000\110\000\010\000\ + \010\000\011\000\255\255\011\000\011\000\011\000\011\000\011\000\ + \113\000\255\255\255\255\255\255\255\255\014\000\255\255\255\255\ + \014\000\014\000\014\000\255\255\255\255\255\255\014\000\014\000\ + \255\255\014\000\014\000\014\000\255\255\255\255\010\000\010\000\ + \010\000\255\255\255\255\255\255\011\000\011\000\014\000\255\255\ + \014\000\014\000\014\000\014\000\014\000\255\255\255\255\255\255\ + \015\000\255\255\255\255\015\000\015\000\015\000\175\000\255\255\ + \255\255\015\000\015\000\255\255\015\000\015\000\015\000\255\255\ + \111\000\255\255\255\255\011\000\255\255\011\000\255\255\255\255\ + \255\255\015\000\014\000\015\000\015\000\015\000\015\000\015\000\ + \255\255\255\255\018\000\255\255\255\255\018\000\018\000\018\000\ + \255\255\255\255\255\255\018\000\018\000\255\255\018\000\018\000\ + \018\000\255\255\255\255\112\000\255\255\255\255\255\255\255\255\ + \014\000\255\255\014\000\018\000\255\255\015\000\018\000\018\000\ + \018\000\018\000\202\000\255\255\255\255\019\000\255\255\255\255\ + \019\000\019\000\019\000\255\255\255\255\255\255\019\000\019\000\ + \255\255\019\000\019\000\019\000\213\000\255\255\255\255\214\000\ + \255\255\216\000\255\255\015\000\255\255\015\000\019\000\018\000\ + \019\000\019\000\019\000\019\000\019\000\255\255\255\255\255\255\ + \023\000\255\255\255\255\023\000\023\000\023\000\148\000\255\255\ + \255\255\023\000\023\000\255\255\023\000\023\000\023\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\018\000\255\255\018\000\ + \255\255\023\000\019\000\023\000\023\000\023\000\023\000\023\000\ + \083\000\083\000\083\000\083\000\083\000\083\000\083\000\083\000\ + \083\000\083\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\083\000\083\000\083\000\083\000\083\000\083\000\255\255\ + \019\000\255\255\019\000\255\255\255\255\023\000\255\255\255\255\ + \255\255\255\255\175\000\255\255\255\255\255\255\255\255\024\000\ + \193\000\193\000\193\000\193\000\193\000\193\000\193\000\193\000\ + \255\255\083\000\083\000\083\000\083\000\083\000\083\000\255\255\ + \255\255\255\255\255\255\023\000\255\255\023\000\024\000\024\000\ + \255\255\024\000\024\000\024\000\024\000\255\255\255\255\255\255\ + \024\000\024\000\107\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\255\255\024\000\024\000\024\000\024\000\024\000\255\255\ + \255\255\107\000\025\000\255\255\255\255\025\000\025\000\025\000\ + \255\255\255\255\025\000\025\000\025\000\255\255\025\000\025\000\ + \025\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ + \107\000\107\000\107\000\025\000\024\000\025\000\025\000\025\000\ + \025\000\025\000\165\000\165\000\165\000\165\000\165\000\165\000\ + \165\000\165\000\165\000\165\000\168\000\168\000\168\000\168\000\ + \168\000\168\000\168\000\168\000\168\000\168\000\255\255\255\255\ + \255\255\255\255\024\000\028\000\024\000\255\255\075\000\025\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\ + \075\000\075\000\255\255\075\000\255\255\025\000\028\000\025\000\ + \028\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\ + \028\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\ + \028\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\ + \028\000\028\000\030\000\028\000\255\255\255\255\255\255\255\255\ + \255\255\030\000\255\255\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\255\255\255\255\ + \255\255\255\255\030\000\255\255\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\030\000\030\000\ + \030\000\030\000\030\000\030\000\030\000\030\000\031\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\031\000\255\255\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\255\255\255\255\255\255\255\255\031\000\255\255\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\032\000\194\000\194\000\194\000\194\000\194\000\ + \194\000\194\000\194\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\255\255\255\255\ + \255\255\255\255\032\000\255\255\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\095\000\095\000\ + \095\000\095\000\095\000\095\000\095\000\095\000\095\000\095\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\095\000\ + \095\000\095\000\095\000\095\000\095\000\186\000\186\000\186\000\ + \186\000\186\000\186\000\186\000\186\000\186\000\186\000\191\000\ + \191\000\191\000\191\000\191\000\191\000\191\000\191\000\191\000\ + \191\000\255\255\255\255\255\255\255\255\255\255\255\255\095\000\ + \095\000\095\000\095\000\095\000\095\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\255\255\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\033\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\255\255\255\255\ + \255\255\255\255\033\000\255\255\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\106\000\106\000\ + \255\255\255\255\106\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\106\000\255\255\106\000\ + \255\255\255\255\255\255\255\255\143\000\255\255\255\255\143\000\ + \255\255\255\255\255\255\255\255\255\255\106\000\106\000\106\000\ + \106\000\106\000\106\000\106\000\106\000\106\000\106\000\255\255\ + \255\255\255\255\255\255\255\255\143\000\255\255\255\255\255\255\ + \255\255\143\000\143\000\255\255\143\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\255\255\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\034\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\143\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\255\255\255\255\ + \255\255\255\255\034\000\255\255\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\149\000\255\255\ + \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ + \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ + \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ + \149\000\149\000\255\255\149\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\156\000\106\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \156\000\156\000\156\000\156\000\156\000\156\000\156\000\156\000\ + \255\255\156\000\143\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\255\255\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\035\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\255\255\255\255\ + \255\255\255\255\035\000\255\255\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\164\000\164\000\ + \164\000\164\000\164\000\164\000\164\000\164\000\164\000\164\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\164\000\ + \164\000\164\000\164\000\164\000\164\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\164\000\ + \164\000\164\000\164\000\164\000\164\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\255\255\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\255\255\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\036\000\255\255\255\255\036\000\036\000\ + \036\000\255\255\255\255\255\255\036\000\036\000\255\255\036\000\ + \036\000\036\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\036\000\255\255\036\000\036\000\ + \036\000\036\000\036\000\255\255\204\000\255\255\204\000\204\000\ + \204\000\204\000\204\000\204\000\204\000\204\000\204\000\204\000\ + \204\000\204\000\204\000\204\000\204\000\204\000\204\000\204\000\ + \204\000\204\000\204\000\204\000\204\000\204\000\204\000\204\000\ + \036\000\036\000\204\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\255\255\036\000\037\000\ + \036\000\255\255\037\000\037\000\037\000\255\255\255\255\255\255\ + \037\000\037\000\255\255\037\000\037\000\037\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \037\000\255\255\037\000\037\000\037\000\037\000\037\000\255\255\ + \210\000\255\255\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\210\000\210\000\210\000\210\000\ + \210\000\210\000\210\000\210\000\037\000\037\000\210\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\255\255\037\000\255\255\037\000\255\255\255\255\255\255\ + \255\255\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\255\255\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\171\000\171\000\171\000\171\000\171\000\171\000\ + \171\000\171\000\171\000\171\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\171\000\171\000\171\000\171\000\171\000\ + \171\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\171\000\171\000\171\000\171\000\171\000\ + \171\000\255\255\255\255\255\255\255\255\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\038\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\255\255\255\255\255\255\255\255\038\000\255\255\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\184\000\184\000\184\000\184\000\184\000\184\000\184\000\ + \184\000\184\000\184\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\184\000\184\000\184\000\184\000\184\000\184\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\184\000\184\000\184\000\184\000\184\000\184\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\255\255\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\255\255\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\046\000\255\255\ + \255\255\046\000\046\000\046\000\255\255\255\255\255\255\046\000\ + \046\000\255\255\046\000\046\000\046\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\046\000\ + \255\255\046\000\046\000\046\000\046\000\046\000\255\255\255\255\ + \255\255\255\255\047\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\255\255\255\255\ + \255\255\255\255\255\255\046\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\255\255\255\255\ + \255\255\046\000\047\000\046\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\196\000\196\000\ + \196\000\196\000\196\000\196\000\196\000\196\000\196\000\196\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\196\000\ + \196\000\196\000\196\000\196\000\196\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\196\000\ + \196\000\196\000\196\000\196\000\196\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\255\255\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\048\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\255\255\255\255\ + \255\255\255\255\048\000\255\255\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\198\000\198\000\ + \198\000\198\000\198\000\198\000\198\000\198\000\198\000\198\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\198\000\ + \198\000\198\000\198\000\198\000\198\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\198\000\ + \198\000\198\000\198\000\198\000\198\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\255\255\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\051\000\048\000\048\000\048\000\048\000\048\000\ + \048\000\048\000\048\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\255\255\255\255\ + \255\255\255\255\051\000\255\255\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\255\255\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\052\000\051\000\051\000\051\000\051\000\051\000\ + \051\000\051\000\051\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\255\255\255\255\ + \255\255\255\255\052\000\255\255\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\255\255\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\055\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\255\255\255\255\ + \255\255\255\255\055\000\255\255\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\055\000\055\000\ + \055\000\055\000\055\000\055\000\055\000\055\000\056\000\255\255\ + \255\255\255\255\056\000\255\255\056\000\255\255\255\255\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\255\255\255\255\255\255\255\255\056\000\255\255\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\057\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\255\255\255\255\ + \255\255\255\255\057\000\255\255\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\058\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\255\255\255\255\255\255\255\255\058\000\255\255\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\059\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\255\255\255\255\ + \255\255\255\255\059\000\255\255\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\059\000\059\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\255\255\255\255\255\255\255\255\060\000\255\255\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\061\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\255\255\255\255\ + \255\255\255\255\061\000\255\255\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\062\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\062\000\255\255\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\255\255\255\255\255\255\255\255\062\000\255\255\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\062\000\062\000\062\000\062\000\062\000\062\000\ + \062\000\062\000\063\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\255\255\255\255\ + \255\255\255\255\063\000\255\255\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\063\000\063\000\ + \063\000\063\000\063\000\063\000\063\000\063\000\064\000\255\255\ + \255\255\255\255\064\000\255\255\064\000\255\255\255\255\064\000\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\255\255\255\255\255\255\255\255\064\000\255\255\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\064\000\064\000\064\000\064\000\064\000\064\000\ + \064\000\064\000\065\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\255\255\255\255\ + \255\255\255\255\065\000\255\255\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\065\000\065\000\ + \065\000\065\000\065\000\065\000\065\000\065\000\067\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\255\255\255\255\255\255\255\255\067\000\255\255\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\067\000\068\000\255\255\255\255\255\255\068\000\255\255\ + \068\000\255\255\255\255\068\000\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\255\255\255\255\ + \255\255\255\255\068\000\255\255\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\068\000\068\000\ + \068\000\068\000\068\000\068\000\068\000\068\000\069\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\255\255\255\255\255\255\255\255\069\000\255\255\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\069\000\069\000\069\000\069\000\069\000\069\000\ + \069\000\069\000\070\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\070\000\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\255\255\255\255\ + \255\255\255\255\070\000\255\255\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\070\000\070\000\ + \070\000\070\000\070\000\070\000\070\000\070\000\071\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\255\255\255\255\255\255\255\255\071\000\255\255\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\071\000\071\000\071\000\071\000\071\000\071\000\ + \071\000\071\000\076\000\103\000\076\000\255\255\103\000\103\000\ + \103\000\076\000\255\255\255\255\103\000\103\000\255\255\103\000\ + \103\000\103\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\103\000\255\255\103\000\103\000\ + \103\000\103\000\103\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\105\000\255\255\105\000\105\000\105\000\105\000\ + \255\255\255\255\255\255\105\000\105\000\255\255\105\000\105\000\ + \105\000\255\255\255\255\255\255\255\255\255\255\076\000\255\255\ + \103\000\255\255\255\255\105\000\076\000\105\000\105\000\105\000\ + \105\000\105\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \076\000\076\000\255\255\255\255\076\000\255\255\076\000\255\255\ + \116\000\255\255\076\000\116\000\116\000\116\000\103\000\255\255\ + \103\000\116\000\116\000\255\255\116\000\116\000\116\000\105\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\116\000\255\255\116\000\116\000\116\000\116\000\116\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\117\000\ + \255\255\255\255\117\000\117\000\117\000\105\000\255\255\105\000\ + \117\000\117\000\255\255\117\000\117\000\117\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\116\000\255\255\255\255\ + \117\000\255\255\117\000\117\000\117\000\117\000\117\000\255\255\ + \255\255\255\255\118\000\255\255\255\255\118\000\118\000\118\000\ + \255\255\255\255\255\255\118\000\118\000\255\255\118\000\118\000\ + \118\000\255\255\255\255\116\000\255\255\116\000\255\255\255\255\ + \255\255\255\255\255\255\118\000\117\000\118\000\118\000\118\000\ + \118\000\118\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \119\000\255\255\255\255\119\000\119\000\119\000\255\255\255\255\ + \255\255\119\000\119\000\255\255\119\000\119\000\119\000\255\255\ + \255\255\255\255\117\000\255\255\117\000\255\255\255\255\118\000\ + \255\255\119\000\076\000\119\000\119\000\119\000\119\000\119\000\ + \255\255\255\255\255\255\120\000\255\255\255\255\120\000\120\000\ + \120\000\255\255\255\255\255\255\120\000\120\000\255\255\120\000\ + \120\000\120\000\255\255\255\255\255\255\118\000\255\255\118\000\ + \255\255\255\255\255\255\255\255\120\000\119\000\120\000\120\000\ + \120\000\120\000\120\000\255\255\255\255\255\255\126\000\255\255\ + \255\255\126\000\126\000\126\000\255\255\255\255\255\255\126\000\ + \126\000\255\255\126\000\126\000\126\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\119\000\255\255\119\000\255\255\126\000\ + \120\000\126\000\126\000\126\000\126\000\126\000\255\255\255\255\ + \255\255\136\000\255\255\255\255\136\000\136\000\136\000\255\255\ + \255\255\255\255\136\000\136\000\255\255\136\000\136\000\136\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\120\000\255\255\ + \120\000\255\255\136\000\126\000\136\000\136\000\136\000\136\000\ + \136\000\255\255\255\255\255\255\139\000\255\255\255\255\139\000\ + \139\000\139\000\255\255\255\255\255\255\139\000\139\000\255\255\ + \139\000\139\000\139\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\126\000\255\255\126\000\255\255\139\000\136\000\139\000\ + \139\000\139\000\139\000\139\000\255\255\255\255\255\255\140\000\ + \255\255\255\255\140\000\140\000\140\000\255\255\255\255\255\255\ + \140\000\140\000\255\255\140\000\140\000\140\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\136\000\255\255\136\000\255\255\ + \140\000\139\000\140\000\140\000\140\000\140\000\140\000\255\255\ + \255\255\255\255\141\000\255\255\255\255\141\000\141\000\141\000\ + \255\255\255\255\255\255\141\000\141\000\255\255\141\000\141\000\ + \141\000\255\255\255\255\255\255\255\255\255\255\255\255\139\000\ + \255\255\139\000\255\255\141\000\140\000\141\000\141\000\141\000\ + \141\000\141\000\255\255\255\255\255\255\142\000\255\255\255\255\ + \142\000\142\000\142\000\255\255\255\255\255\255\142\000\142\000\ + \255\255\142\000\142\000\142\000\255\255\255\255\157\000\255\255\ + \157\000\255\255\140\000\255\255\140\000\157\000\142\000\141\000\ + \142\000\142\000\142\000\142\000\142\000\255\255\157\000\157\000\ + \157\000\157\000\157\000\157\000\157\000\157\000\157\000\157\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\141\000\255\255\141\000\ + \255\255\255\255\142\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\180\000\255\255\255\255\180\000\255\255\255\255\255\255\ + \255\255\255\255\157\000\255\255\255\255\255\255\255\255\255\255\ + \157\000\255\255\255\255\255\255\255\255\255\255\255\255\180\000\ + \142\000\180\000\142\000\255\255\157\000\255\255\180\000\255\255\ + \157\000\255\255\157\000\255\255\255\255\255\255\157\000\180\000\ + \180\000\180\000\180\000\180\000\180\000\180\000\180\000\180\000\ + \180\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\199\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \199\000\199\000\199\000\180\000\255\255\255\255\255\255\255\255\ + \255\255\180\000\199\000\199\000\199\000\199\000\199\000\199\000\ + \255\255\255\255\255\255\255\255\255\255\180\000\180\000\255\255\ + \255\255\180\000\255\255\180\000\180\000\255\255\255\255\180\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\199\000\199\000\199\000\199\000\199\000\199\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\199\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\180\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255"; + Lexing.lex_base_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\010\000\036\000\022\000\000\000\000\000\000\000\ + \005\000\000\000\039\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\002\000\005\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000"; + Lexing.lex_backtrk_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\053\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000"; + Lexing.lex_default_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\031\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000"; + Lexing.lex_trans_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\001\000\000\000\050\000\050\000\000\000\009\000\050\000\ + \000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \001\000\000\000\009\000\001\000\000\000\009\000\000\000\034\000\ + \000\000\000\000\009\000\000\000\012\000\001\000\000\000\000\000\ + \004\000\004\000\004\000\004\000\004\000\004\000\004\000\004\000\ + \004\000\004\000\017\000\017\000\017\000\017\000\017\000\017\000\ + \017\000\017\000\017\000\017\000\001\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\017\000\017\000\017\000\017\000\ + \017\000\017\000\017\000\017\000\017\000\017\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000"; + Lexing.lex_check_code = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\024\000\111\000\180\000\189\000\111\000\112\000\190\000\ + \255\255\255\255\255\255\106\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \024\000\255\255\111\000\000\000\255\255\112\000\255\255\112\000\ + \255\255\255\255\106\000\255\255\106\000\107\000\255\255\255\255\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\106\000\106\000\106\000\106\000\106\000\106\000\ + \106\000\106\000\106\000\106\000\107\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\107\000\107\000\107\000\107\000\ + \107\000\107\000\107\000\107\000\107\000\107\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \111\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255"; + Lexing.lex_code = + "\255\005\255\255\007\255\006\255\255\007\255\255\009\255\008\255\ + \255\006\255\007\255\255\004\255\000\005\001\006\002\007\255\009\ + \255\255\008\255\009\255\255\000\005\001\006\004\008\003\009\002\ + \007\255\001\255\255\000\001\255"; +} + +let rec token lexbuf = + lexbuf.Lexing.lex_mem <- Array.make 10 (-1); __ocaml_lex_token_rec lexbuf 0 +and __ocaml_lex_token_rec lexbuf __ocaml_lex_state = + match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 770 "parsing/lexer.mll" + ( + if not !escaped_newlines then + raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), + Location.curr lexbuf)); + update_loc lexbuf None 1 false 0; + token lexbuf ) +# 2358 "parsing/lexer.ml" + + | 1 -> +# 777 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 0; + EOL ) +# 2364 "parsing/lexer.ml" + + | 2 -> +# 780 "parsing/lexer.mll" + ( token lexbuf ) +# 2369 "parsing/lexer.ml" + + | 3 -> +# 782 "parsing/lexer.mll" + ( UNDERSCORE ) +# 2374 "parsing/lexer.ml" + + | 4 -> +# 784 "parsing/lexer.mll" + ( TILDE ) +# 2379 "parsing/lexer.ml" + + | 5 -> +# 786 "parsing/lexer.mll" + ( LABEL (get_label_name lexbuf) ) +# 2384 "parsing/lexer.ml" + + | 6 -> +# 788 "parsing/lexer.mll" + ( warn_latin1 lexbuf; LABEL (get_label_name lexbuf) ) +# 2389 "parsing/lexer.ml" + + | 7 -> +# 790 "parsing/lexer.mll" + ( QUESTION ) +# 2394 "parsing/lexer.ml" + + | 8 -> +# 792 "parsing/lexer.mll" + ( OPTLABEL (get_label_name lexbuf) ) +# 2399 "parsing/lexer.ml" + + | 9 -> +# 794 "parsing/lexer.mll" + ( warn_latin1 lexbuf; OPTLABEL (get_label_name lexbuf) ) +# 2404 "parsing/lexer.ml" + + | 10 -> +# 796 "parsing/lexer.mll" + ( let s = Lexing.lexeme lexbuf in + try Hashtbl.find keyword_table s + with Not_found -> LIDENT s ) +# 2411 "parsing/lexer.ml" + + | 11 -> +# 800 "parsing/lexer.mll" + ( warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) ) +# 2416 "parsing/lexer.ml" + + | 12 -> +# 802 "parsing/lexer.mll" + ( UIDENT(Lexing.lexeme lexbuf) ) +# 2421 "parsing/lexer.ml" + + | 13 -> +# 804 "parsing/lexer.mll" + ( warn_latin1 lexbuf; UIDENT(Lexing.lexeme lexbuf) ) +# 2426 "parsing/lexer.ml" + + | 14 -> +# 805 "parsing/lexer.mll" + ( INT (Lexing.lexeme lexbuf, None) ) +# 2431 "parsing/lexer.ml" + + | 15 -> +let +# 806 "parsing/lexer.mll" + lit +# 2437 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + -1) +and +# 806 "parsing/lexer.mll" + modif +# 2442 "parsing/lexer.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_curr_pos + -1) in +# 807 "parsing/lexer.mll" + ( INT (lit, Some modif) ) +# 2446 "parsing/lexer.ml" + + | 16 -> +# 809 "parsing/lexer.mll" + ( FLOAT (Lexing.lexeme lexbuf, None) ) +# 2451 "parsing/lexer.ml" + + | 17 -> +let +# 810 "parsing/lexer.mll" + lit +# 2457 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_curr_pos + -1) +and +# 810 "parsing/lexer.mll" + modif +# 2462 "parsing/lexer.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_curr_pos + -1) in +# 811 "parsing/lexer.mll" + ( FLOAT (lit, Some modif) ) +# 2466 "parsing/lexer.ml" + + | 18 -> +# 813 "parsing/lexer.mll" + ( raise (Error(Invalid_literal (Lexing.lexeme lexbuf), + Location.curr lexbuf)) ) +# 2472 "parsing/lexer.ml" + + | 19 -> +# 816 "parsing/lexer.mll" + ( reset_string_buffer(); + is_in_string := true; + let string_start = lexbuf.lex_start_p in + string_start_loc := Location.curr lexbuf; + string lexbuf; + is_in_string := false; + lexbuf.lex_start_p <- string_start; + STRING (get_stored_string(), None) ) +# 2484 "parsing/lexer.ml" + + | 20 -> +# 825 "parsing/lexer.mll" + ( reset_string_buffer(); + let delim = Lexing.lexeme lexbuf in + let delim = String.sub delim 1 (String.length delim - 2) in + is_in_string := true; + let string_start = lexbuf.lex_start_p in + string_start_loc := Location.curr lexbuf; + quoted_string delim lexbuf; + is_in_string := false; + lexbuf.lex_start_p <- string_start; + STRING (get_stored_string(), Some delim) ) +# 2498 "parsing/lexer.ml" + + | 21 -> +# 836 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 1; + CHAR (Lexing.lexeme_char lexbuf 1) ) +# 2504 "parsing/lexer.ml" + + | 22 -> +# 839 "parsing/lexer.mll" + ( CHAR(Lexing.lexeme_char lexbuf 1) ) +# 2509 "parsing/lexer.ml" + + | 23 -> +# 841 "parsing/lexer.mll" + ( CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) ) +# 2514 "parsing/lexer.ml" + + | 24 -> +# 843 "parsing/lexer.mll" + ( CHAR(char_for_decimal_code lexbuf 2) ) +# 2519 "parsing/lexer.ml" + + | 25 -> +# 845 "parsing/lexer.mll" + ( CHAR(char_for_octal_code lexbuf 3) ) +# 2524 "parsing/lexer.ml" + + | 26 -> +# 847 "parsing/lexer.mll" + ( CHAR(char_for_hexadecimal_code lexbuf 3) ) +# 2529 "parsing/lexer.ml" + + | 27 -> +# 849 "parsing/lexer.mll" + ( let l = Lexing.lexeme lexbuf in + let esc = String.sub l 1 (String.length l - 1) in + raise (Error(Illegal_escape esc, Location.curr lexbuf)) + ) +# 2537 "parsing/lexer.ml" + + | 28 -> +# 854 "parsing/lexer.mll" + ( let s, loc = with_comment_buffer comment lexbuf in + COMMENT (s, loc) ) +# 2543 "parsing/lexer.ml" + + | 29 -> +# 857 "parsing/lexer.mll" + ( let s, loc = with_comment_buffer comment lexbuf in + if !handle_docstrings then + DOCSTRING (Docstrings.docstring s loc) + else + COMMENT ("*" ^ s, loc) + ) +# 2553 "parsing/lexer.ml" + + | 30 -> +let +# 863 "parsing/lexer.mll" + stars +# 2559 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 3) lexbuf.Lexing.lex_curr_pos in +# 864 "parsing/lexer.mll" + ( let s, loc = + with_comment_buffer + (fun lexbuf -> + store_string ("*" ^ stars); + comment lexbuf) + lexbuf + in + COMMENT (s, loc) ) +# 2570 "parsing/lexer.ml" + + | 31 -> +# 873 "parsing/lexer.mll" + ( if !print_warnings then + Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start; + let s, loc = with_comment_buffer comment lexbuf in + COMMENT (s, loc) ) +# 2578 "parsing/lexer.ml" + + | 32 -> +let +# 877 "parsing/lexer.mll" + stars +# 2584 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 2) (lexbuf.Lexing.lex_curr_pos + -2) in +# 878 "parsing/lexer.mll" + ( if !handle_docstrings && stars="" then + (* (**) is an empty docstring *) + DOCSTRING(Docstrings.docstring "" (Location.curr lexbuf)) + else + COMMENT (stars, Location.curr lexbuf) ) +# 2592 "parsing/lexer.ml" + + | 33 -> +# 884 "parsing/lexer.mll" + ( let loc = Location.curr lexbuf in + Location.prerr_warning loc Warnings.Comment_not_end; + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; + let curpos = lexbuf.lex_curr_p in + lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 }; + STAR + ) +# 2603 "parsing/lexer.ml" + + | 34 -> +let +# 891 "parsing/lexer.mll" + num +# 2609 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_mem.(1) +and +# 892 "parsing/lexer.mll" + name +# 2614 "parsing/lexer.ml" += Lexing.sub_lexeme_opt lexbuf lexbuf.Lexing.lex_mem.(4) lexbuf.Lexing.lex_mem.(3) +and +# 892 "parsing/lexer.mll" + directive +# 2619 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_mem.(2) in +# 894 "parsing/lexer.mll" + ( + match int_of_string num with + | exception _ -> + (* PR#7165 *) + let loc = Location.curr lexbuf in + let explanation = "line number out of range" in + let error = Invalid_directive (directive, Some explanation) in + raise (Error (error, loc)) + | line_num -> + (* Documentation says that the line number should be + positive, but we have never guarded against this and it + might have useful hackish uses. *) + update_loc lexbuf name line_num true 0; + token lexbuf + ) +# 2637 "parsing/lexer.ml" + + | 35 -> +# 909 "parsing/lexer.mll" + ( HASH ) +# 2642 "parsing/lexer.ml" + + | 36 -> +# 910 "parsing/lexer.mll" + ( AMPERSAND ) +# 2647 "parsing/lexer.ml" + + | 37 -> +# 911 "parsing/lexer.mll" + ( AMPERAMPER ) +# 2652 "parsing/lexer.ml" + + | 38 -> +# 912 "parsing/lexer.mll" + ( BACKQUOTE ) +# 2657 "parsing/lexer.ml" + + | 39 -> +# 913 "parsing/lexer.mll" + ( QUOTE ) +# 2662 "parsing/lexer.ml" + + | 40 -> +# 914 "parsing/lexer.mll" + ( LPAREN ) +# 2667 "parsing/lexer.ml" + + | 41 -> +# 915 "parsing/lexer.mll" + ( RPAREN ) +# 2672 "parsing/lexer.ml" + + | 42 -> +# 916 "parsing/lexer.mll" + ( STAR ) +# 2677 "parsing/lexer.ml" + + | 43 -> +# 917 "parsing/lexer.mll" + ( COMMA ) +# 2682 "parsing/lexer.ml" + + | 44 -> +# 918 "parsing/lexer.mll" + ( MINUSGREATER ) +# 2687 "parsing/lexer.ml" + + | 45 -> +# 919 "parsing/lexer.mll" + ( DOT ) +# 2692 "parsing/lexer.ml" + + | 46 -> +# 920 "parsing/lexer.mll" + ( DOTDOT ) +# 2697 "parsing/lexer.ml" + + | 47 -> +let +# 921 "parsing/lexer.mll" + s +# 2703 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 1) lexbuf.Lexing.lex_curr_pos in +# 921 "parsing/lexer.mll" + ( DOTOP s ) +# 2707 "parsing/lexer.ml" + + | 48 -> +# 922 "parsing/lexer.mll" + ( COLON ) +# 2712 "parsing/lexer.ml" + + | 49 -> +# 923 "parsing/lexer.mll" + ( COLONCOLON ) +# 2717 "parsing/lexer.ml" + + | 50 -> +# 924 "parsing/lexer.mll" + ( COLONEQUAL ) +# 2722 "parsing/lexer.ml" + + | 51 -> +# 925 "parsing/lexer.mll" + ( COLONGREATER ) +# 2727 "parsing/lexer.ml" + + | 52 -> +# 926 "parsing/lexer.mll" + ( SEMI ) +# 2732 "parsing/lexer.ml" + + | 53 -> +# 927 "parsing/lexer.mll" + ( SEMISEMI ) +# 2737 "parsing/lexer.ml" + + | 54 -> +# 928 "parsing/lexer.mll" + ( LESS ) +# 2742 "parsing/lexer.ml" + + | 55 -> +# 929 "parsing/lexer.mll" + ( LESSMINUS ) +# 2747 "parsing/lexer.ml" + + | 56 -> +# 930 "parsing/lexer.mll" + ( EQUAL ) +# 2752 "parsing/lexer.ml" + + | 57 -> +# 931 "parsing/lexer.mll" + ( LBRACKET ) +# 2757 "parsing/lexer.ml" + + | 58 -> +# 932 "parsing/lexer.mll" + ( LBRACKETBAR ) +# 2762 "parsing/lexer.ml" + + | 59 -> +# 933 "parsing/lexer.mll" + ( LBRACKETLESS ) +# 2767 "parsing/lexer.ml" + + | 60 -> +# 934 "parsing/lexer.mll" + ( LBRACKETGREATER ) +# 2772 "parsing/lexer.ml" + + | 61 -> +# 935 "parsing/lexer.mll" + ( RBRACKET ) +# 2777 "parsing/lexer.ml" + + | 62 -> +# 936 "parsing/lexer.mll" + ( LBRACE ) +# 2782 "parsing/lexer.ml" + + | 63 -> +# 937 "parsing/lexer.mll" + ( LBRACELESS ) +# 2787 "parsing/lexer.ml" + + | 64 -> +# 938 "parsing/lexer.mll" + ( BAR ) +# 2792 "parsing/lexer.ml" + + | 65 -> +# 939 "parsing/lexer.mll" + ( BARBAR ) +# 2797 "parsing/lexer.ml" + + | 66 -> +# 940 "parsing/lexer.mll" + ( BARRBRACKET ) +# 2802 "parsing/lexer.ml" + + | 67 -> +# 941 "parsing/lexer.mll" + ( GREATER ) +# 2807 "parsing/lexer.ml" + + | 68 -> +# 942 "parsing/lexer.mll" + ( GREATERRBRACKET ) +# 2812 "parsing/lexer.ml" + + | 69 -> +# 943 "parsing/lexer.mll" + ( RBRACE ) +# 2817 "parsing/lexer.ml" + + | 70 -> +# 944 "parsing/lexer.mll" + ( GREATERRBRACE ) +# 2822 "parsing/lexer.ml" + + | 71 -> +# 945 "parsing/lexer.mll" + ( LBRACKETAT ) +# 2827 "parsing/lexer.ml" + + | 72 -> +# 946 "parsing/lexer.mll" + ( LBRACKETATAT ) +# 2832 "parsing/lexer.ml" + + | 73 -> +# 947 "parsing/lexer.mll" + ( LBRACKETATATAT ) +# 2837 "parsing/lexer.ml" + + | 74 -> +# 948 "parsing/lexer.mll" + ( LBRACKETPERCENT ) +# 2842 "parsing/lexer.ml" + + | 75 -> +# 949 "parsing/lexer.mll" + ( LBRACKETPERCENTPERCENT ) +# 2847 "parsing/lexer.ml" + + | 76 -> +# 950 "parsing/lexer.mll" + ( BANG ) +# 2852 "parsing/lexer.ml" + + | 77 -> +# 951 "parsing/lexer.mll" + ( INFIXOP0 "!=" ) +# 2857 "parsing/lexer.ml" + + | 78 -> +# 952 "parsing/lexer.mll" + ( PLUS ) +# 2862 "parsing/lexer.ml" + + | 79 -> +# 953 "parsing/lexer.mll" + ( PLUSDOT ) +# 2867 "parsing/lexer.ml" + + | 80 -> +# 954 "parsing/lexer.mll" + ( PLUSEQ ) +# 2872 "parsing/lexer.ml" + + | 81 -> +# 955 "parsing/lexer.mll" + ( MINUS ) +# 2877 "parsing/lexer.ml" + + | 82 -> +# 956 "parsing/lexer.mll" + ( MINUSDOT ) +# 2882 "parsing/lexer.ml" + + | 83 -> +# 959 "parsing/lexer.mll" + ( PREFIXOP(Lexing.lexeme lexbuf) ) +# 2887 "parsing/lexer.ml" + + | 84 -> +# 961 "parsing/lexer.mll" + ( PREFIXOP(Lexing.lexeme lexbuf) ) +# 2892 "parsing/lexer.ml" + + | 85 -> +# 963 "parsing/lexer.mll" + ( INFIXOP0(Lexing.lexeme lexbuf) ) +# 2897 "parsing/lexer.ml" + + | 86 -> +# 965 "parsing/lexer.mll" + ( INFIXOP1(Lexing.lexeme lexbuf) ) +# 2902 "parsing/lexer.ml" + + | 87 -> +# 967 "parsing/lexer.mll" + ( INFIXOP2(Lexing.lexeme lexbuf) ) +# 2907 "parsing/lexer.ml" + + | 88 -> +# 969 "parsing/lexer.mll" + ( INFIXOP4(Lexing.lexeme lexbuf) ) +# 2912 "parsing/lexer.ml" + + | 89 -> +# 970 "parsing/lexer.mll" + ( PERCENT ) +# 2917 "parsing/lexer.ml" + + | 90 -> +# 972 "parsing/lexer.mll" + ( INFIXOP3(Lexing.lexeme lexbuf) ) +# 2922 "parsing/lexer.ml" + + | 91 -> +# 974 "parsing/lexer.mll" + ( HASHOP(Lexing.lexeme lexbuf) ) +# 2927 "parsing/lexer.ml" + + | 92 -> +# 975 "parsing/lexer.mll" + ( + if !if_then_else <> Dir_out then + if !if_then_else = Dir_if_true then + raise (Error (Unterminated_if, Location.curr lexbuf)) + else raise (Error(Unterminated_else, Location.curr lexbuf)) + else + EOF + + ) +# 2940 "parsing/lexer.ml" + + | 93 -> +# 985 "parsing/lexer.mll" + ( raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), + Location.curr lexbuf)) + ) +# 2947 "parsing/lexer.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_token_rec lexbuf __ocaml_lex_state + +and comment lexbuf = + __ocaml_lex_comment_rec lexbuf 143 +and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 991 "parsing/lexer.mll" + ( comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc; + store_lexeme lexbuf; + comment lexbuf + ) +# 2962 "parsing/lexer.ml" + + | 1 -> +# 996 "parsing/lexer.mll" + ( match !comment_start_loc with + | [] -> assert false + | [_] -> comment_start_loc := []; Location.curr lexbuf + | _ :: l -> comment_start_loc := l; + store_lexeme lexbuf; + comment lexbuf + ) +# 2973 "parsing/lexer.ml" + + | 2 -> +# 1004 "parsing/lexer.mll" + ( + string_start_loc := Location.curr lexbuf; + store_string_char '\"'; + is_in_string := true; + begin try string lexbuf + with Error (Unterminated_string, str_start) -> + match !comment_start_loc with + | [] -> assert false + | loc :: _ -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unterminated_string_in_comment (start, str_start), + loc)) + end; + is_in_string := false; + store_string_char '\"'; + comment lexbuf ) +# 2994 "parsing/lexer.ml" + + | 3 -> +# 1022 "parsing/lexer.mll" + ( + let delim = Lexing.lexeme lexbuf in + let delim = String.sub delim 1 (String.length delim - 2) in + string_start_loc := Location.curr lexbuf; + store_lexeme lexbuf; + is_in_string := true; + begin try quoted_string delim lexbuf + with Error (Unterminated_string, str_start) -> + match !comment_start_loc with + | [] -> assert false + | loc :: _ -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unterminated_string_in_comment (start, str_start), + loc)) + end; + is_in_string := false; + store_string_char '|'; + store_string delim; + store_string_char '}'; + comment lexbuf ) +# 3019 "parsing/lexer.ml" + + | 4 -> +# 1045 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3024 "parsing/lexer.ml" + + | 5 -> +# 1047 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 1; + store_lexeme lexbuf; + comment lexbuf + ) +# 3032 "parsing/lexer.ml" + + | 6 -> +# 1052 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3037 "parsing/lexer.ml" + + | 7 -> +# 1054 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3042 "parsing/lexer.ml" + + | 8 -> +# 1056 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3047 "parsing/lexer.ml" + + | 9 -> +# 1058 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3052 "parsing/lexer.ml" + + | 10 -> +# 1060 "parsing/lexer.mll" + ( match !comment_start_loc with + | [] -> assert false + | loc :: _ -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unterminated_comment start, loc)) + ) +# 3063 "parsing/lexer.ml" + + | 11 -> +# 1068 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 0; + store_lexeme lexbuf; + comment lexbuf + ) +# 3071 "parsing/lexer.ml" + + | 12 -> +# 1073 "parsing/lexer.mll" + ( store_lexeme lexbuf; comment lexbuf ) +# 3076 "parsing/lexer.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec lexbuf __ocaml_lex_state + +and string lexbuf = + lexbuf.Lexing.lex_mem <- Array.make 2 (-1); __ocaml_lex_string_rec lexbuf 175 +and __ocaml_lex_string_rec lexbuf __ocaml_lex_state = + match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 1077 "parsing/lexer.mll" + ( () ) +# 3088 "parsing/lexer.ml" + + | 1 -> +let +# 1078 "parsing/lexer.mll" + space +# 3094 "parsing/lexer.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_curr_pos in +# 1079 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false (String.length space); + if in_comment () then store_lexeme lexbuf; + string lexbuf + ) +# 3101 "parsing/lexer.ml" + + | 2 -> +# 1084 "parsing/lexer.mll" + ( store_escaped_char lexbuf + (char_for_backslash(Lexing.lexeme_char lexbuf 1)); + string lexbuf ) +# 3108 "parsing/lexer.ml" + + | 3 -> +# 1088 "parsing/lexer.mll" + ( store_escaped_char lexbuf (char_for_decimal_code lexbuf 1); + string lexbuf ) +# 3114 "parsing/lexer.ml" + + | 4 -> +# 1091 "parsing/lexer.mll" + ( store_escaped_char lexbuf (char_for_octal_code lexbuf 2); + string lexbuf ) +# 3120 "parsing/lexer.ml" + + | 5 -> +# 1094 "parsing/lexer.mll" + ( store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2); + string lexbuf ) +# 3126 "parsing/lexer.ml" + + | 6 -> +# 1097 "parsing/lexer.mll" + ( store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf); + string lexbuf ) +# 3132 "parsing/lexer.ml" + + | 7 -> +# 1100 "parsing/lexer.mll" + ( if not (in_comment ()) then begin +(* Should be an error, but we are very lax. + raise (Error (Illegal_escape (Lexing.lexeme lexbuf), + Location.curr lexbuf)) +*) + let loc = Location.curr lexbuf in + Location.prerr_warning loc Warnings.Illegal_backslash; + end; + store_lexeme lexbuf; + string lexbuf + ) +# 3147 "parsing/lexer.ml" + + | 8 -> +# 1112 "parsing/lexer.mll" + ( if not (in_comment ()) then + Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string; + update_loc lexbuf None 1 false 0; + store_lexeme lexbuf; + string lexbuf + ) +# 3157 "parsing/lexer.ml" + + | 9 -> +# 1119 "parsing/lexer.mll" + ( is_in_string := false; + raise (Error (Unterminated_string, !string_start_loc)) ) +# 3163 "parsing/lexer.ml" + + | 10 -> +# 1122 "parsing/lexer.mll" + ( store_string_char(Lexing.lexeme_char lexbuf 0); + string lexbuf ) +# 3169 "parsing/lexer.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_string_rec lexbuf __ocaml_lex_state + +and quoted_string delim lexbuf = + __ocaml_lex_quoted_string_rec delim lexbuf 202 +and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 1127 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 0; + store_lexeme lexbuf; + quoted_string delim lexbuf + ) +# 3184 "parsing/lexer.ml" + + | 1 -> +# 1132 "parsing/lexer.mll" + ( is_in_string := false; + raise (Error (Unterminated_string, !string_start_loc)) ) +# 3190 "parsing/lexer.ml" + + | 2 -> +# 1135 "parsing/lexer.mll" + ( + let edelim = Lexing.lexeme lexbuf in + let edelim = String.sub edelim 1 (String.length edelim - 2) in + if delim = edelim then () + else (store_lexeme lexbuf; quoted_string delim lexbuf) + ) +# 3200 "parsing/lexer.ml" + + | 3 -> +# 1142 "parsing/lexer.mll" + ( store_string_char(Lexing.lexeme_char lexbuf 0); + quoted_string delim lexbuf ) +# 3206 "parsing/lexer.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state + +and skip_hash_bang lexbuf = + __ocaml_lex_skip_hash_bang_rec lexbuf 211 +and __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 1147 "parsing/lexer.mll" + ( update_loc lexbuf None 3 false 0 ) +# 3218 "parsing/lexer.ml" + + | 1 -> +# 1149 "parsing/lexer.mll" + ( update_loc lexbuf None 1 false 0 ) +# 3223 "parsing/lexer.ml" + + | 2 -> +# 1150 "parsing/lexer.mll" + ( () ) +# 3228 "parsing/lexer.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state + +;; + +# 1152 "parsing/lexer.mll" + + let at_bol lexbuf = + let pos = Lexing.lexeme_start_p lexbuf in + pos.pos_cnum = pos.pos_bol + + let token_with_comments lexbuf = + match !preprocessor with + | None -> token lexbuf + | Some (_init, preprocess) -> preprocess token lexbuf + + type newline_state = + | NoLine (* There have been no blank lines yet. *) + | NewLine + (* There have been no blank lines, and the previous + token was a newline. *) + | BlankLine (* There have been blank lines. *) + + type doc_state = + | Initial (* There have been no docstrings yet *) + | After of docstring list + (* There have been docstrings, none of which were + preceded by a blank line *) + | Before of docstring list * docstring list * docstring list + (* There have been docstrings, some of which were + preceded by a blank line *) + + and docstring = Docstrings.docstring + + let interpret_directive lexbuf cont look_ahead = + let if_then_else = !if_then_else in + begin match token_with_comments lexbuf, if_then_else with + | IF, Dir_out -> + let rec skip_from_if_false () = + let token = token_with_comments lexbuf in + if token = EOF then + raise (Error (Unterminated_if, Location.curr lexbuf)) else + if token = HASH && at_bol lexbuf then + begin + let token = token_with_comments lexbuf in + match token with + | END -> + begin + update_if_then_else Dir_out; + cont lexbuf + end + | ELSE -> + begin + update_if_then_else Dir_if_false; + cont lexbuf + end + | IF -> + raise (Error (Unexpected_directive, Location.curr lexbuf)) + | _ -> + if is_elif token && + directive_parse token_with_comments lexbuf then + begin + update_if_then_else Dir_if_true; + cont lexbuf + end + else skip_from_if_false () + end + else skip_from_if_false () in + if directive_parse token_with_comments lexbuf then + begin + update_if_then_else Dir_if_true (* Next state: ELSE *); + cont lexbuf + end + else + skip_from_if_false () + | IF, (Dir_if_false | Dir_if_true)-> + raise (Error(Unexpected_directive, Location.curr lexbuf)) + | LIDENT "elif", (Dir_if_false | Dir_out) + -> (* when the predicate is false, it will continue eating `elif` *) + raise (Error(Unexpected_directive, Location.curr lexbuf)) + | (LIDENT "elif" | ELSE as token), Dir_if_true -> + (* looking for #end, however, it can not see #if anymore *) + let rec skip_from_if_true else_seen = + let token = token_with_comments lexbuf in + if token = EOF then + raise (Error (Unterminated_else, Location.curr lexbuf)) else + if token = HASH && at_bol lexbuf then + begin + let token = token_with_comments lexbuf in + match token with + | END -> + begin + update_if_then_else Dir_out; + cont lexbuf + end + | IF -> + raise (Error (Unexpected_directive, Location.curr lexbuf)) + | ELSE -> + if else_seen then + raise (Error (Unexpected_directive, Location.curr lexbuf)) + else + skip_from_if_true true + | _ -> + if else_seen && is_elif token then + raise (Error (Unexpected_directive, Location.curr lexbuf)) + else + skip_from_if_true else_seen + end + else skip_from_if_true else_seen in + skip_from_if_true (token = ELSE) + | ELSE, Dir_if_false + | ELSE, Dir_out -> + raise (Error(Unexpected_directive, Location.curr lexbuf)) + | END, (Dir_if_false | Dir_if_true ) -> + update_if_then_else Dir_out; + cont lexbuf + | END, Dir_out -> + raise (Error(Unexpected_directive, Location.curr lexbuf)) + | token, (Dir_if_true | Dir_if_false | Dir_out) -> + look_ahead token + end + + let token lexbuf = + let post_pos = lexeme_end_p lexbuf in + let attach lines docs pre_pos = + let open Docstrings in + match docs, lines with + | Initial, _ -> () + | After a, (NoLine | NewLine) -> + set_post_docstrings post_pos (List.rev a); + set_pre_docstrings pre_pos a; + | After a, BlankLine -> + set_post_docstrings post_pos (List.rev a); + set_pre_extra_docstrings pre_pos (List.rev a) + | Before(a, f, b), (NoLine | NewLine) -> + set_post_docstrings post_pos (List.rev a); + set_post_extra_docstrings post_pos + (List.rev_append f (List.rev b)); + set_floating_docstrings pre_pos (List.rev f); + set_pre_extra_docstrings pre_pos (List.rev a); + set_pre_docstrings pre_pos b + | Before(a, f, b), BlankLine -> + set_post_docstrings post_pos (List.rev a); + set_post_extra_docstrings post_pos + (List.rev_append f (List.rev b)); + set_floating_docstrings pre_pos + (List.rev_append f (List.rev b)); + set_pre_extra_docstrings pre_pos (List.rev a) + in + let rec loop lines docs lexbuf = + match token_with_comments lexbuf with + | COMMENT (s, loc) -> + add_comment (s, loc); + let lines' = + match lines with + | NoLine -> NoLine + | NewLine -> NoLine + | BlankLine -> BlankLine + in + loop lines' docs lexbuf + | EOL -> + let lines' = + match lines with + | NoLine -> NewLine + | NewLine -> BlankLine + | BlankLine -> BlankLine + in + loop lines' docs lexbuf + | HASH when at_bol lexbuf -> + interpret_directive lexbuf + (fun lexbuf -> loop lines docs lexbuf) + (fun token -> sharp_look_ahead := Some token; HASH) + | DOCSTRING doc -> + Docstrings.register doc; + add_docstring_comment doc; + let docs' = + if Docstrings.docstring_body doc = "/*" then + match docs with + | Initial -> Before([], [doc], []) + | After a -> Before (a, [doc], []) + | Before(a, f, b) -> Before(a, doc :: b @ f, []) + else + match docs, lines with + | Initial, (NoLine | NewLine) -> After [doc] + | Initial, BlankLine -> Before([], [], [doc]) + | After a, (NoLine | NewLine) -> After (doc :: a) + | After a, BlankLine -> Before (a, [], [doc]) + | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b) + | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc]) + in + loop NoLine docs' lexbuf + | tok -> + attach lines docs (lexeme_start_p lexbuf); + tok + in + match !sharp_look_ahead with + | None -> + loop NoLine Initial lexbuf + | Some token -> + sharp_look_ahead := None ; + token + + let init () = + sharp_look_ahead := None; + update_if_then_else Dir_out; + is_in_string := false; + comment_start_loc := []; + comment_list := []; + match !preprocessor with + | None -> () + | Some (init, _preprocess) -> init () + + let rec filter_directive pos acc lexbuf : (int * int ) list = + match token_with_comments lexbuf with + | HASH when at_bol lexbuf -> + (* ^[start_pos]#if ... #then^[end_pos] *) + let start_pos = Lexing.lexeme_start lexbuf in + interpret_directive lexbuf + (fun lexbuf -> + filter_directive + (Lexing.lexeme_end lexbuf) + ((pos, start_pos) :: acc) + lexbuf + + ) + (fun _token -> filter_directive pos acc lexbuf ) + | EOF -> (pos, Lexing.lexeme_end lexbuf) :: acc + | _ -> filter_directive pos acc lexbuf + + let filter_directive_from_lexbuf lexbuf = + List.rev (filter_directive 0 [] lexbuf ) + + let set_preprocessor init preprocess = + escaped_newlines := true; + preprocessor := Some (init, preprocess) + + +# 3467 "parsing/lexer.ml" + +end +module Parse : sig +#1 "parse.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Entry points in the parser *) + +val implementation : Lexing.lexbuf -> Parsetree.structure +val interface : Lexing.lexbuf -> Parsetree.signature +val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase +val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list +val core_type : Lexing.lexbuf -> Parsetree.core_type +val expression : Lexing.lexbuf -> Parsetree.expression +val pattern : Lexing.lexbuf -> Parsetree.pattern + +end = struct +#1 "parse.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Entry points in the parser *) + +(* Skip tokens to the end of the phrase *) + +let rec skip_phrase lexbuf = + try + match Lexer.token lexbuf with + Parser.SEMISEMI | Parser.EOF -> () + | _ -> skip_phrase lexbuf + with + | Lexer.Error (Lexer.Unterminated_comment _, _) + | Lexer.Error (Lexer.Unterminated_string, _) + | Lexer.Error (Lexer.Unterminated_string_in_comment _, _) + | Lexer.Error (Lexer.Illegal_character _, _) -> skip_phrase lexbuf +;; + +let maybe_skip_phrase lexbuf = + if Parsing.is_current_lookahead Parser.SEMISEMI + || Parsing.is_current_lookahead Parser.EOF + then () + else skip_phrase lexbuf + +let wrap parsing_fun lexbuf = + try + Docstrings.init (); + Lexer.init (); + let ast = parsing_fun Lexer.token lexbuf in + Parsing.clear_parser(); + Docstrings.warn_bad_docstrings (); + ast + with + | Lexer.Error(Lexer.Illegal_character _, _) as err + when !Location.input_name = "//toplevel//"-> + skip_phrase lexbuf; + raise err + | Syntaxerr.Error _ as err + when !Location.input_name = "//toplevel//" -> + maybe_skip_phrase lexbuf; + raise err + | Parsing.Parse_error | Syntaxerr.Escape_error -> + let loc = Location.curr lexbuf in + if !Location.input_name = "//toplevel//" + then maybe_skip_phrase lexbuf; + raise(Syntaxerr.Error(Syntaxerr.Other loc)) + +let implementation = wrap Parser.implementation +and interface = wrap Parser.interface +and toplevel_phrase = wrap Parser.toplevel_phrase +and use_file = wrap Parser.use_file +and core_type = wrap Parser.parse_core_type +and expression = wrap Parser.parse_expression +and pattern = wrap Parser.parse_pattern + +end +module Bspack_main : sig +#1 "bspack_main.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 read_lines : string -> string -> string list +(* example + {[ + Line_process.read_lines "." "./tools/tools.mllib" + ]} + + FIXME: we can only concat (dir/file) not (dir/dir) + {[ + Filename.concat "/bb/x/" "/bb/x/";; + ]} +*) + + +end = struct +#1 "bspack_main.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. *) + + +module L_string_set = Set.Make(String) +(* lexical order *) + +let (@>) (b, v) acc = + if b then + v :: acc + else + acc + +let preprocess_to_buffer fn (str : string) (oc : Buffer.t) : unit = + let lexbuf = Lexing.from_string str in + Lexer.init () ; + Location.init lexbuf fn; + let segments = + Lexer.filter_directive_from_lexbuf lexbuf in + Ext_list.iter segments + (fun (start, pos) -> + Buffer.add_substring oc str start (pos - start) + ) + +let verify_valid_ml (str : string) = + try + ignore @@ Parse.implementation (Lexing.from_string str); + true + with _ -> false + +(* same as {!preprocess_to_buffer} except writing to channel directly *) +let preprocess_string fn (str : string) oc = + let lexbuf = Lexing.from_string str in + Lexer.init () ; + Location.init lexbuf fn; + let segments = + Lexer.filter_directive_from_lexbuf lexbuf in + Ext_list.iter segments + (fun (start, pos) -> + output_substring oc str start (pos - start) + ) + +let (//) = Filename.concat + +let rec process_line cwd filedir line = + let line = Ext_string.trim line in + let len = String.length line in + if len = 0 then [] + else + match line.[0] with + | '#' -> [] + | _ -> + let segments = + Ext_string.split_by ~keep_empty:false (fun x -> x = ' ' || x = '\t' ) line + in + begin + match segments with + | ["include" ; path ] + -> + (* prerr_endline path; *) + read_lines cwd (filedir// path) + | [ x ] -> + let ml = filedir // x ^ ".ml" in + let mli = filedir // x ^ ".mli" in + let ml_exists, mli_exists = Sys.file_exists ml , Sys.file_exists mli in + if not ml_exists && not mli_exists then + begin + prerr_endline (filedir //x ^ " not exists"); + [] + end + else + (ml_exists, ml) @> (mli_exists , mli) @> [] + | _ + -> Ext_pervasives.failwithf ~loc:__LOC__ "invalid line %s" line + end +and read_lines (cwd : string) (file : string) : string list = + Ext_list.fold_left (Ext_io.rev_lines_of_file file) [] (fun acc f -> + let filedir = Filename.dirname file in + let extras = process_line cwd filedir f in + Ext_list.append extras acc + ) +let implementation sourcefile = + let content = Ext_io.load_file sourcefile in + let ast = + let oldname = !Location.input_name in + Location.input_name := sourcefile ; + let lexbuf = Lexing.from_string content in + Location.init lexbuf sourcefile ; + match Parse.implementation lexbuf + with + | exception e -> + Location.input_name := oldname; + raise e + | ast -> + Location.input_name := oldname ; + ast + in + ast, content + +let interface sourcefile = + let content = Ext_io.load_file sourcefile in + let ast = + let oldname = !Location.input_name in + Location.input_name := sourcefile ; + let lexbuf = Lexing.from_string content in + Location.init lexbuf sourcefile; + match Parse.interface lexbuf with + | exception e -> + Location.input_name := oldname ; + raise e + | ast -> + Location.input_name := oldname ; + ast in + ast, content + + +let emit out_chan name = + output_string out_chan "#1 \""; + (*Note here we do this is mostly to avoid leaking user's + information, like private path, in the future, we can have + a flag + *) + output_string out_chan (Filename.basename name) ; + output_string out_chan "\"\n" + +let decorate_module + ?(module_bound=true) + out_chan base mli_name ml_name mli_content ml_content = + if module_bound then begin + let base = Ext_string.capitalize_ascii base in + output_string out_chan "module "; + output_string out_chan base ; + output_string out_chan " : sig \n"; + emit out_chan mli_name ; + preprocess_string mli_name mli_content out_chan; + output_string out_chan "\nend = struct\n"; + emit out_chan ml_name ; + preprocess_string ml_name ml_content out_chan; + output_string out_chan "\nend\n" + end + else + begin + output_string out_chan "include (struct\n"; + emit out_chan ml_name ; + preprocess_string ml_name ml_content out_chan; + output_string out_chan "\nend : sig \n"; + emit out_chan mli_name ; + preprocess_string mli_name mli_content out_chan; + output_string out_chan "\nend)"; + end + +let decorate_module_only + ?(check : unit option) + ?(module_bound=true) + out_chan base ml_name ml_content = + if module_bound then begin + let base = Ext_string.capitalize_ascii base in + output_string out_chan "module "; + output_string out_chan base ; + output_string out_chan "\n= struct\n" + end; + emit out_chan ml_name; + if check <> None then + let buf = Buffer.create 2000 in + preprocess_to_buffer ml_name ml_content buf; + let str = Buffer.contents buf in + if not @@ verify_valid_ml str then + failwith (ml_name ^ " can not be a valid ml module") + else + output_string out_chan str + else + preprocess_string ml_name ml_content out_chan ; + if module_bound then + output_string out_chan "\nend\n" + +(** recursive module is not good for performance, here module type only + has to be pure types otherwise it would not compile any way +*) +let decorate_interface_only out_chan base mli_name mli_content = + output_string out_chan "(** Interface as module *)\n"; + decorate_module_only out_chan base mli_name mli_content ~check:() + +(** set mllib *) +let mllib = ref None +let set_string s = mllib := Some s + +let batch_files = ref [] +let collect_file name = + batch_files := name :: !batch_files + +let output_file = ref None +let set_output file = output_file := Some file +let header_option = ref false + +type main_module = { modulename : string ; export : bool } + +(** set bs-main*) +let main_module : main_module option ref = ref None + +let set_main_module modulename = + main_module := Some {modulename; export = false } + +let set_main_export modulename = + main_module := Some {modulename; export = true } + +let set_mllib_file = ref false + +let prelude = ref None +let set_prelude f = + if Sys.file_exists f then + prelude := Some f + else raise (Arg.Bad ("file " ^ f ^ " don't exist ")) +let prelude_str = ref None +let set_prelude_str f = prelude_str := Some f + +(** + {[ + # process_include "ghsogh?a,b,c";; + - : [> `Dir of string | `Dir_with_excludes of string * string list ] = + `Dir_with_excludes ("ghsogh", ["a"; "b"; "c"]) + # process_include "ghsogh?a";; + - : [> `Dir of string | `Dir_with_excludes of string * string list ] = + `Dir_with_excludes ("ghsogh", ["a"]) + ]} +*) +(* type dir_spec = *) +(* [ `Dir of string | `Dir_with_excludes of string * string list ] *) + +let cwd = Sys.getcwd () + +let normalize s = + Ext_path.normalize_absolute_path (Ext_path.combine cwd s ) + +let process_include s : Ast_extract.dir_spec = + let i = Ext_string.rindex_neg s '?' in + if i < 0 then + { dir = normalize s; excludes = []} + else + let dir = String.sub s 0 i in + { dir = normalize dir; + excludes = Ext_string.split + (String.sub s (i + 1) (String.length s - i - 1) ) + ','} + +let deduplicate_dirs (xs : Ast_extract.dir_spec list) = + let set : Ast_extract.dir_spec String_hashtbl.t = String_hashtbl.create 64 in + List.filter (fun ({Ast_extract.dir ; excludes = new_excludes } as y) -> + match String_hashtbl.find_opt set dir with + | None -> + String_hashtbl.add set dir y; + true + | Some x -> x.excludes <- new_excludes @ x.excludes ; false + ) xs + +let includes : _ list ref = ref [] + +let add_include dir = + includes := process_include dir :: !includes + +let exclude_modules = ref [] +let add_exclude module_ = + exclude_modules := module_ :: !exclude_modules +let no_implicit_include = ref false + +let alias_map = String_hashtbl.create 0 +let alias_map_rev = String_hashtbl.create 0 + +(** + {[ + A -> B + A1 -> B + ]} + print + {[ + + module A = B + module A1 = B + ]} + We don't suppport + {[ + A -> B + A -> C + ]} +*) +let alias_module s = + match Ext_string.split s '=' with + | [a;b] -> + (* Error checking later*) + if String_hashtbl.mem alias_map a then + raise (Arg.Bad ("duplicated module alias " ^ a)) + else + begin + String_hashtbl.add alias_map_rev b a; + String_hashtbl.add alias_map a b + end + | _ -> raise (Arg.Bad "invalid module alias format like A=B") + +let undefine_symbol (s : string) = + Lexer.remove_directive_built_in_value s +let define_symbol (s : string) = + match Ext_string.split ~keep_empty:true s '=' with + | [key; v] -> + if not @@ Lexer.define_key_value key v then + raise (Arg.Bad ("illegal definition: " ^ s)) + | _ -> raise (Arg.Bad ("illegal definition: " ^ s)) + +let specs : (string * Arg.spec * string) list = + [ + "-bs-no-implicit-include", (Arg.Set no_implicit_include), + " Not including cwd as search path"; + "-prelude-str", (Arg.String set_prelude_str), + " Set a prelude string, (before -prelude) option" ; + "-module-alias", (Arg.String alias_module ), + " -module-alis A=B, whenever need A,replace it with B" ; + "-prelude", (Arg.String set_prelude), + " Set a prelude file, literally copy into the beginning"; + "-bs-mllib", (Arg.String set_string), + " Files collected from mllib"; + "-bs-MD", (Arg.Set set_mllib_file), + " Log files into mllib(only effective under -bs-main mode)"; + "-o", (Arg.String set_output), + " Set output file (default to stdout)" ; + "-with-header", (Arg.Set header_option), + " with header of time stamp" ; + "-bs-exclude-I", (Arg.String add_exclude), + " don't read and pack such modules from -I (in the future, we should detect conflicts in mllib or commandline) " + ; + "-bs-main", (Arg.String set_main_module), + " set the main entry module"; + "-main-export", (Arg.String set_main_export), + " Set the main module and respect its exports"; + "-I", (Arg.String add_include), + " add dir to search path"; + "-U", Arg.String undefine_symbol, + " Undefine a symbol when bspacking"; + "-D", Arg.String define_symbol, + " Define a symbol when bspacking" + ] + + +let anonymous filename = + collect_file filename + +let usage = "Usage: bspack \nOptions are:" +let () = + try + (Arg.parse specs anonymous usage; + let command_files = !batch_files in + let mllib = !mllib in + (* emit code now *) + let out_chan = + lazy (match !output_file with + | None -> stdout + | Some file -> open_out_bin file) in + let emit_header out_chan = + let local_time = Unix.(localtime (gettimeofday ())) in + (if !header_option + then + output_string out_chan + (Printf.sprintf "(** Generated by bspack %02d/%02d-%02d:%02d *)\n" + (local_time.tm_mon + 1) local_time.tm_mday + local_time.tm_hour local_time.tm_min)); + (match !prelude_str with + | None -> () + | Some s -> output_string out_chan s; output_string out_chan "\n" ); + match !prelude with + | None -> () + | Some f -> + begin + output_string out_chan (Ext_io.load_file f); + output_string out_chan "\n" + end + in + let close_out_chan out_chan = + (if out_chan != stdout then close_out out_chan) in + let files = + Ext_list.append (match mllib with + | Some s + -> read_lines (Sys.getcwd ()) s + | None -> []) command_files in + + match !main_module, files with + | Some _ , _ :: _ + -> + Ext_pervasives.failwithf ~loc:__LOC__ + "-bs-main conflicts with other flags [ %s ]" + (String.concat ", " files) + | Some {modulename = main_module ; export }, [] + -> + let excludes = + match !exclude_modules with + | [] -> [] + | xs -> + Ext_list.flat_map xs (fun x -> [x ^ ".ml" ; x ^ ".mli"] ) in + let extra_dirs = + deduplicate_dirs @@ + if not !no_implicit_include then {Ast_extract.dir = cwd; excludes = []} :: !includes + else !includes + in + let ast_table, tasks = + Ast_extract.collect_from_main ~excludes ~extra_dirs ~alias_map + Format.err_formatter + (fun _ppf sourcefile -> lazy (implementation sourcefile)) + (fun _ppf sourcefile -> lazy (interface sourcefile)) + (fun (lazy (stru, _)) -> stru) + (fun (lazy (sigi, _)) -> sigi) + main_module + in + if Queue.is_empty tasks then + raise (Arg.Bad (main_module ^ " does not pull in any libs, maybe wrong input")) + ; + let out_chan = Lazy.force out_chan in + let collect_module_by_filenames = !set_mllib_file in + let collection_modules = Queue.create () in + let count = ref 0 in + let task_length = Queue.length tasks in + emit_header out_chan ; + begin + Ast_extract.handle_queue Format.err_formatter tasks ast_table + (fun base ml_name (lazy(_, ml_content)) -> + incr count ; + if collect_module_by_filenames then + Queue.add ml_name collection_modules; + let module_bound = not export || task_length > !count in + decorate_module_only ~module_bound out_chan base ml_name ml_content; + let aliased = Ext_string.capitalize_ascii base in + String_hashtbl.find_all alias_map_rev aliased + |> List.iter + (fun s -> output_string out_chan (Printf.sprintf "module %s = %s \n" s aliased)) + + ) + (fun base mli_name (lazy (_, mli_content)) -> + incr count ; + if collect_module_by_filenames then + Queue.add mli_name collection_modules; + + decorate_interface_only out_chan base mli_name mli_content; + let aliased = Ext_string.capitalize_ascii base in + String_hashtbl.find_all alias_map_rev aliased + |> List.iter + (fun s -> output_string out_chan (Printf.sprintf "module %s = %s \n" s aliased)) + + ) + (fun base mli_name ml_name (lazy (_, mli_content)) (lazy (_, ml_content)) + -> + incr count; + (*TODO: assume mli_name, ml_name are in the same dir, + Needs to be addressed + *) + if collect_module_by_filenames then + begin + Queue.add ml_name collection_modules; + Queue.add mli_name collection_modules + end; + (** if export + print it as + {[inclue (struct end : sig end)]} + *) + let module_bound = not export || task_length > !count in + decorate_module ~module_bound out_chan base mli_name ml_name mli_content ml_content; + let aliased = (Ext_string.capitalize_ascii base) in + String_hashtbl.find_all alias_map_rev aliased + |> List.iter + (fun s -> output_string out_chan (Printf.sprintf "module %s = %s \n" s aliased)) + + ) + end; + close_out_chan out_chan; + begin + if !set_mllib_file then + match !output_file with + | None -> () + | Some file -> + let output = file ^ ".d" in + let sorted_queue = + Queue.fold + (fun acc collection_module -> + L_string_set.add + ( + (*FIXME: now we normalized path, + we need a beautiful output too for relative path + The relative path should be also be normalized.. + *) + Filename.concat + (Ext_path.rel_normalized_absolute_path + ~from:cwd + (Filename.dirname collection_module) + ) (Filename.basename collection_module) + + ) + (* collection_module *) + acc + ) L_string_set.empty collection_modules in + Ext_io.write_file + output + ( + L_string_set.fold + (fun collection_module acc -> + acc ^ + collection_module + ^ "\n" + (* ^ a ^ " : ; touch " ^ output ^ "\n" *) + ) sorted_queue + (file ^ ":\n" ) + (* collection_modules *) + ) + end + | None, _ -> + let ast_table = + Ast_extract.collect_ast_map + Format.err_formatter files + (fun _ppf sourcefile -> implementation sourcefile + ) + (fun _ppf sourcefile -> interface sourcefile) in + let tasks = Ast_extract.sort fst fst ast_table in + let out_chan = (Lazy.force out_chan) in + emit_header out_chan ; + Ast_extract.handle_queue Format.err_formatter tasks ast_table + (fun base ml_name (_, ml_content) -> decorate_module_only out_chan base ml_name ml_content) + (fun base mli_name (_, mli_content) -> decorate_interface_only out_chan base mli_name mli_content ) + (fun base mli_name ml_name (_, mli_content) (_, ml_content) + -> decorate_module out_chan base mli_name ml_name mli_content ml_content); + close_out_chan out_chan + ) + with x -> + begin + Location.report_exception Format.err_formatter x ; + exit 2 + end + +end diff --git a/lib/4.06.1/unstable/bspack.ml.d b/lib/4.06.1/unstable/bspack.ml.d new file mode 100644 index 0000000000..edade67315 --- /dev/null +++ b/lib/4.06.1/unstable/bspack.ml.d @@ -0,0 +1,86 @@ +../lib/4.06.1/unstable/bspack.ml: +../ocaml/parsing/ast_helper.ml +../ocaml/parsing/ast_helper.mli +../ocaml/parsing/asttypes.mli +../ocaml/parsing/builtin_attributes.ml +../ocaml/parsing/builtin_attributes.mli +../ocaml/parsing/depend.ml +../ocaml/parsing/depend.mli +../ocaml/parsing/docstrings.ml +../ocaml/parsing/docstrings.mli +../ocaml/parsing/lexer.ml +../ocaml/parsing/lexer.mli +../ocaml/parsing/location.ml +../ocaml/parsing/location.mli +../ocaml/parsing/longident.ml +../ocaml/parsing/longident.mli +../ocaml/parsing/parse.ml +../ocaml/parsing/parse.mli +../ocaml/parsing/parser.ml +../ocaml/parsing/parser.mli +../ocaml/parsing/parsetree.mli +../ocaml/parsing/syntaxerr.ml +../ocaml/parsing/syntaxerr.mli +../ocaml/utils/arg_helper.ml +../ocaml/utils/arg_helper.mli +../ocaml/utils/clflags.ml +../ocaml/utils/clflags.mli +../ocaml/utils/identifiable.ml +../ocaml/utils/identifiable.mli +../ocaml/utils/misc.ml +../ocaml/utils/misc.mli +../ocaml/utils/numbers.ml +../ocaml/utils/numbers.mli +../ocaml/utils/profile.ml +../ocaml/utils/profile.mli +../ocaml/utils/terminfo.ml +../ocaml/utils/terminfo.mli +../ocaml/utils/warnings.ml +../ocaml/utils/warnings.mli +./common/js_config.ml +./common/js_config.mli +./common/ml_binary.ml +./common/ml_binary.mli +./core/config_whole_compiler.ml +./core/config_whole_compiler.mli +./depends/ast_extract.ml +./depends/ast_extract.mli +./depends/bs_exception.ml +./depends/bs_exception.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_format.ml +./ext/ext_format.mli +./ext/ext_io.ml +./ext/ext_io.mli +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_modulename.ml +./ext/ext_modulename.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_ref.ml +./ext/ext_ref.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hashtbl_gen.ml +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/string_hashtbl.ml +./ext/string_hashtbl.mli +./ext/string_map.ml +./ext/string_map.mli +./main/bspack_main.ml +./main/bspack_main.mli +./stubs/bs_hash_stubs.ml diff --git a/lib/4.06.1/unstable/native_ppx.ml b/lib/4.06.1/unstable/native_ppx.ml new file mode 100644 index 0000000000..59ec2cb083 --- /dev/null +++ b/lib/4.06.1/unstable/native_ppx.ml @@ -0,0 +1,21973 @@ +module Arg_helper : sig +#1 "arg_helper.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Decipher command line arguments of the form + | =[,...] + (as used for example for the specification of inlining parameters + varying by simplification round). +*) + +module Make (S : sig + module Key : sig + type t + + (** The textual representation of a key must not contain '=' or ','. *) + val of_string : string -> t + + module Map : Map.S with type key = t + end + + module Value : sig + type t + + (** The textual representation of a value must not contain ','. *) + val of_string : string -> t + end +end) : sig + type parsed + + val default : S.Value.t -> parsed + + val set_base_default : S.Value.t -> parsed -> parsed + + val add_base_override : S.Key.t -> S.Value.t -> parsed -> parsed + + val reset_base_overrides : parsed -> parsed + + val set_user_default : S.Value.t -> parsed -> parsed + + val add_user_override : S.Key.t -> S.Value.t -> parsed -> parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:S.Key.t -> parsed -> S.Value.t +end + +end = struct +#1 "arg_helper.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2015--2016 OCamlPro SAS *) +(* Copyright 2015--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +let fatal err = + prerr_endline err; + exit 2 + +module Make (S : sig + module Key : sig + type t + val of_string : string -> t + module Map : Map.S with type key = t + end + + module Value : sig + type t + val of_string : string -> t + end +end) = struct + type parsed = { + base_default : S.Value.t; + base_override : S.Value.t S.Key.Map.t; + user_default : S.Value.t option; + user_override : S.Value.t S.Key.Map.t; + } + + let default v = + { base_default = v; + base_override = S.Key.Map.empty; + user_default = None; + user_override = S.Key.Map.empty; } + + let set_base_default value t = + { t with base_default = value } + + let add_base_override key value t = + { t with base_override = S.Key.Map.add key value t.base_override } + + let reset_base_overrides t = + { t with base_override = S.Key.Map.empty } + + let set_user_default value t = + { t with user_default = Some value } + + let add_user_override key value t = + { t with user_override = S.Key.Map.add key value t.user_override } + + exception Parse_failure of exn + + let parse_exn str ~update = + (* Is the removal of empty chunks really relevant here? *) + (* (It has been added to mimic the old Misc.String.split.) *) + let values = String.split_on_char ',' str |> List.filter ((<>) "") in + let parsed = + List.fold_left (fun acc value -> + match String.index value '=' with + | exception Not_found -> + begin match S.Value.of_string value with + | value -> set_user_default value acc + | exception exn -> raise (Parse_failure exn) + end + | equals -> + let key_value_pair = value in + let length = String.length key_value_pair in + assert (equals >= 0 && equals < length); + if equals = 0 then begin + raise (Parse_failure ( + Failure "Missing key in argument specification")) + end; + let key = + let key = String.sub key_value_pair 0 equals in + try S.Key.of_string key + with exn -> raise (Parse_failure exn) + in + let value = + let value = + String.sub key_value_pair (equals + 1) (length - equals - 1) + in + try S.Value.of_string value + with exn -> raise (Parse_failure exn) + in + add_user_override key value acc) + !update + values + in + update := parsed + + let parse str help_text update = + match parse_exn str ~update with + | () -> () + | exception (Parse_failure exn) -> + fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) + + type parse_result = + | Ok + | Parse_failed of exn + + let parse_no_error str update = + match parse_exn str ~update with + | () -> Ok + | exception (Parse_failure exn) -> Parse_failed exn + + let get ~key parsed = + match S.Key.Map.find key parsed.user_override with + | value -> value + | exception Not_found -> + match parsed.user_default with + | Some value -> value + | None -> + match S.Key.Map.find key parsed.base_override with + | value -> value + | exception Not_found -> parsed.base_default + +end + +end +module Config : sig +#1 "config.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* System configuration *) + +val version: string + (* The current version number of the system *) + +val standard_library: string + (* The directory containing the standard libraries *) +val standard_runtime: string + (* The full path to the standard bytecode interpreter ocamlrun *) +val ccomp_type: string + (* The "kind" of the C compiler, assembler and linker used: one of + "cc" (for Unix-style C compilers) + "msvc" (for Microsoft Visual C++ and MASM) *) +val c_compiler: string + (* The compiler to use for compiling C files *) +val c_output_obj: string + (* Name of the option of the C compiler for specifying the output file *) +val ocamlc_cflags : string + (* The flags ocamlc should pass to the C compiler *) +val ocamlc_cppflags : string + (* The flags ocamlc should pass to the C preprocessor *) +val ocamlopt_cflags : string + (* The flags ocamlopt should pass to the C compiler *) +val ocamlopt_cppflags : string + (* The flags ocamlopt should pass to the C preprocessor *) +val bytecomp_c_libraries: string + (* The C libraries to link with custom runtimes *) +val native_c_libraries: string + (* The C libraries to link with native-code programs *) +val native_pack_linker: string + (* The linker to use for packaging (ocamlopt -pack) and for partial + links (ocamlopt -output-obj). *) +val mkdll: string + (* The linker command line to build dynamic libraries. *) +val mkexe: string + (* The linker command line to build executables. *) +val mkmaindll: string + (* The linker command line to build main programs as dlls. *) +val ranlib: string + (* Command to randomize a library, or "" if not needed *) +val ar: string + (* Name of the ar command, or "" if not needed (MSVC) *) +val cc_profile : string + (* The command line option to the C compiler to enable profiling. *) + +val load_path: string list ref + (* Directories in the search path for .cmi and .cmo files *) + +val interface_suffix: string ref + (* Suffix for interface file names *) + +val exec_magic_number: string + (* Magic number for bytecode executable files *) +val cmi_magic_number: string + (* Magic number for compiled interface files *) +val cmo_magic_number: string + (* Magic number for object bytecode files *) +val cma_magic_number: string + (* Magic number for archive files *) +val cmx_magic_number: string + (* Magic number for compilation unit descriptions *) +val cmxa_magic_number: string + (* Magic number for libraries of compilation unit descriptions *) +val ast_intf_magic_number: string + (* Magic number for file holding an interface syntax tree *) +val ast_impl_magic_number: string + (* Magic number for file holding an implementation syntax tree *) +val cmxs_magic_number: string + (* Magic number for dynamically-loadable plugins *) +val cmt_magic_number: string + (* Magic number for compiled interface files *) + +val max_tag: int + (* Biggest tag that can be stored in the header of a regular block. *) +val lazy_tag : int + (* Normally the same as Obj.lazy_tag. Separate definition because + of technical reasons for bootstrapping. *) +val max_young_wosize: int + (* Maximal size of arrays that are directly allocated in the + minor heap *) +val stack_threshold: int + (* Size in words of safe area at bottom of VM stack, + see byterun/config.h *) +val stack_safety_margin: int + (* Size in words of the safety margin between the bottom of + the stack and the stack pointer. This margin can be used by + intermediate computations of some instructions, or the event + handler. *) + +val architecture: string + (* Name of processor type for the native-code compiler *) +val model: string + (* Name of processor submodel for the native-code compiler *) +val system: string + (* Name of operating system for the native-code compiler *) + +val asm: string + (* The assembler (and flags) to use for assembling + ocamlopt-generated code. *) + +val asm_cfi_supported: bool + (* Whether assembler understands CFI directives *) +val with_frame_pointers : bool + (* Whether assembler should maintain frame pointers *) + +val ext_obj: string + (* Extension for object files, e.g. [.o] under Unix. *) +val ext_asm: string + (* Extension for assembler files, e.g. [.s] under Unix. *) +val ext_lib: string + (* Extension for library files, e.g. [.a] under Unix. *) +val ext_dll: string + (* Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*) + +val default_executable_name: string + (* Name of executable produced by linking if none is given with -o, + e.g. [a.out] under Unix. *) + +val systhread_supported : bool + (* Whether the system thread library is implemented *) + +val flexdll_dirs : string list + (* Directories needed for the FlexDLL objects *) + +val host : string + (* Whether the compiler is a cross-compiler *) + +val target : string + (* Whether the compiler is a cross-compiler *) + +val print_config : out_channel -> unit;; + +val profiling : bool + (* Whether profiling with gprof is supported on this platform *) + +val flambda : bool + (* Whether the compiler was configured for flambda *) + +val spacetime : bool + (* Whether the compiler was configured for Spacetime profiling *) +val enable_call_counts : bool + (* Whether call counts are to be available when Spacetime profiling *) +val profinfo : bool + (* Whether the compiler was configured for profiling *) +val profinfo_width : int + (* How many bits are to be used in values' headers for profiling + information *) +val libunwind_available : bool + (* Whether the libunwind library is available on the target *) +val libunwind_link_flags : string + (* Linker flags to use libunwind *) + +val safe_string: bool + (* Whether the compiler was configured with -force-safe-string; + in that case, the -unsafe-string compile-time option is unavailable + + @since 4.05.0 *) +val default_safe_string: bool + (* Whether the compiler was configured to use the -safe-string + or -unsafe-string compile-time option by default. + + @since 4.06.0 *) +val flat_float_array : bool + (* Whether the compiler and runtime automagically flatten float + arrays *) +val windows_unicode: bool + (* Whether Windows Unicode runtime is enabled *) +val afl_instrument : bool + (* Whether afl-fuzz instrumentation is generated by default *) + +end = struct +#1 "config.ml" +#2 "utils/config.mlp" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* The main OCaml version string has moved to ../VERSION *) +let version = Sys.ocaml_version + +let standard_library_default = "/Users/hongbozhang/git/bucklescript/native/4.06.1/lib/ocaml" + +let standard_library = + + try + Sys.getenv "BSLIB" + with Not_found -> + + standard_library_default + +let standard_runtime = "/Users/hongbozhang/git/bucklescript/native/4.06.1/bin/ocamlrun" +let ccomp_type = "cc" +let c_compiler = "gcc" +let c_output_obj = "-o " +let ocamlc_cflags = "-O2 -fno-strict-aliasing -fwrapv " +let ocamlc_cppflags = "-D_FILE_OFFSET_BITS=64" +let ocamlopt_cflags = "-O2 -fno-strict-aliasing -fwrapv" +let ocamlopt_cppflags = "-D_FILE_OFFSET_BITS=64" +let bytecomp_c_libraries = "" +(* bytecomp_c_compiler and native_c_compiler have been supported for a + long time and are retained for backwards compatibility. + For programs that don't need compatibility with older OCaml releases + the recommended approach is to use the constituent variables + c_compiler, ocamlc_cflags, ocamlc_cppflags etc., directly. +*) +let bytecomp_c_compiler = + c_compiler ^ " " ^ ocamlc_cflags ^ " " ^ ocamlc_cppflags +let native_c_compiler = + c_compiler ^ " " ^ ocamlopt_cflags ^ " " ^ ocamlopt_cppflags +let native_c_libraries = "" +let native_pack_linker = "ld -r -arch x86_64 -o\ " +let ranlib = "ranlib" +let ar = "ar" +let cc_profile = "-pg" +let mkdll, mkexe, mkmaindll = + (* @@DRA Cygwin - but only if shared libraries are enabled, which we + should be able to detect? *) + if Sys.os_type = "Win32" then + try + let flexlink = + let flexlink = Sys.getenv "OCAML_FLEXLINK" in + let f i = + let c = flexlink.[i] in + if c = '/' then '\\' else c in + (String.init (String.length flexlink) f) ^ " " in + flexlink, + flexlink ^ " -exe", + flexlink ^ " -maindll" + with Not_found -> + "gcc -shared -flat_namespace -undefined suppress -Wl,-no_compact_unwind", "gcc -O2 -fno-strict-aliasing -fwrapv -Wall -D_FILE_OFFSET_BITS=64 -DCAML_NAME_SPACE -Wl,-no_compact_unwind", "gcc -shared -flat_namespace -undefined suppress -Wl,-no_compact_unwind" + else + "gcc -shared -flat_namespace -undefined suppress -Wl,-no_compact_unwind", "gcc -O2 -fno-strict-aliasing -fwrapv -Wall -D_FILE_OFFSET_BITS=64 -DCAML_NAME_SPACE -Wl,-no_compact_unwind", "gcc -shared -flat_namespace -undefined suppress -Wl,-no_compact_unwind" + +let profiling = true +let flambda = false +let safe_string = false +let default_safe_string = true +let windows_unicode = 0 != 0 + +let flat_float_array = true + +let afl_instrument = false + +let exec_magic_number = "Caml1999X011" +and cmi_magic_number = "Caml1999I022" +and cmo_magic_number = "Caml1999O022" +and cma_magic_number = "Caml1999A022" +and cmx_magic_number = + if flambda then + "Caml1999y022" + else + "Caml1999Y022" +and cmxa_magic_number = + if flambda then + "Caml1999z022" + else + "Caml1999Z022" +and ast_impl_magic_number = "Caml1999M022" +and ast_intf_magic_number = "Caml1999N022" +and cmxs_magic_number = "Caml1999D022" + (* cmxs_magic_number is duplicated in otherlibs/dynlink/natdynlink.ml *) +and cmt_magic_number = "Caml1999T022" + +let load_path = ref ([] : string list) + +let interface_suffix = ref ".mli" + +let max_tag = 245 +(* This is normally the same as in obj.ml, but we have to define it + separately because it can differ when we're in the middle of a + bootstrapping phase. *) +let lazy_tag = 246 + +let max_young_wosize = 256 +let stack_threshold = 256 (* see byterun/config.h *) +let stack_safety_margin = 60 + +let architecture = "amd64" +let model = "default" +let system = "macosx" + +let asm = "clang -arch x86_64 -Wno-trigraphs -c" +let asm_cfi_supported = true +let with_frame_pointers = false +let spacetime = false +let enable_call_counts = true +let libunwind_available = false +let libunwind_link_flags = "" +let profinfo = false +let profinfo_width = 0 + +let ext_exe = "" +let ext_obj = ".o" +let ext_asm = ".s" +let ext_lib = ".a" +let ext_dll = ".so" + +let host = "x86_64-apple-darwin17.7.0" +let target = "x86_64-apple-darwin17.7.0" + +let default_executable_name = + match Sys.os_type with + "Unix" -> "a.out" + | "Win32" | "Cygwin" -> "camlprog.exe" + | _ -> "camlprog" + +let systhread_supported = false;; + +let flexdll_dirs = [];; + +let print_config oc = + let p name valu = Printf.fprintf oc "%s: %s\n" name valu in + let p_int name valu = Printf.fprintf oc "%s: %d\n" name valu in + let p_bool name valu = Printf.fprintf oc "%s: %B\n" name valu in + p "version" version; + p "standard_library_default" standard_library_default; + p "standard_library" standard_library; + p "standard_runtime" standard_runtime; + p "ccomp_type" ccomp_type; + p "c_compiler" c_compiler; + p "ocamlc_cflags" ocamlc_cflags; + p "ocamlc_cppflags" ocamlc_cppflags; + p "ocamlopt_cflags" ocamlopt_cflags; + p "ocamlopt_cppflags" ocamlopt_cppflags; + p "bytecomp_c_compiler" bytecomp_c_compiler; + p "native_c_compiler" native_c_compiler; + p "bytecomp_c_libraries" bytecomp_c_libraries; + p "native_c_libraries" native_c_libraries; + p "native_pack_linker" native_pack_linker; + p "ranlib" ranlib; + p "cc_profile" cc_profile; + p "architecture" architecture; + p "model" model; + p_int "int_size" Sys.int_size; + p_int "word_size" Sys.word_size; + p "system" system; + p "asm" asm; + p_bool "asm_cfi_supported" asm_cfi_supported; + p_bool "with_frame_pointers" with_frame_pointers; + p "ext_exe" ext_exe; + p "ext_obj" ext_obj; + p "ext_asm" ext_asm; + p "ext_lib" ext_lib; + p "ext_dll" ext_dll; + p "os_type" Sys.os_type; + p "default_executable_name" default_executable_name; + p_bool "systhread_supported" systhread_supported; + p "host" host; + p "target" target; + p_bool "profiling" profiling; + p_bool "flambda" flambda; + p_bool "spacetime" spacetime; + p_bool "safe_string" safe_string; + p_bool "default_safe_string" default_safe_string; + p_bool "flat_float_array" flat_float_array; + p_bool "afl_instrument" afl_instrument; + p_bool "windows_unicode" windows_unicode; + + (* print the magic number *) + p "exec_magic_number" exec_magic_number; + p "cmi_magic_number" cmi_magic_number; + p "cmo_magic_number" cmo_magic_number; + p "cma_magic_number" cma_magic_number; + p "cmx_magic_number" cmx_magic_number; + p "cmxa_magic_number" cmxa_magic_number; + p "ast_impl_magic_number" ast_impl_magic_number; + p "ast_intf_magic_number" ast_intf_magic_number; + p "cmxs_magic_number" cmxs_magic_number; + p "cmt_magic_number" cmt_magic_number; + + flush oc; +;; + +end +module Misc : sig +#1 "misc.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Miscellaneous useful types and functions *) + +val fatal_error: string -> 'a +val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a +exception Fatal_error + +val try_finally : (unit -> 'a) -> (unit -> unit) -> 'a;; + +val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list + (* [map_end f l t] is [map f l @ t], just more efficient. *) +val map_left_right: ('a -> 'b) -> 'a list -> 'b list + (* Like [List.map], with guaranteed left-to-right evaluation order *) +val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool + (* Same as [List.for_all] but for a binary predicate. + In addition, this [for_all2] never fails: given two lists + with different lengths, it returns false. *) +val replicate_list: 'a -> int -> 'a list + (* [replicate_list elem n] is the list with [n] elements + all identical to [elem]. *) +val list_remove: 'a -> 'a list -> 'a list + (* [list_remove x l] returns a copy of [l] with the first + element equal to [x] removed. *) +val split_last: 'a list -> 'a list * 'a + (* Return the last element and the other elements of the given list. *) +val may: ('a -> unit) -> 'a option -> unit +val may_map: ('a -> 'b) -> 'a option -> 'b option + +type ref_and_value = R : 'a ref * 'a -> ref_and_value + +val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a +(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l] + while executing [f]. The previous contents of the references is restored + even if [f] raises an exception. *) + +module Stdlib : sig + module List : sig + type 'a t = 'a list + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + (** The lexicographic order supported by the provided order. + There is no constraint on the relative lengths of the lists. *) + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + (** Returns [true] iff the given lists have the same length and content + with respect to the given equality function. *) + + val filter_map : ('a -> 'b option) -> 'a t -> 'b t + (** [filter_map f l] applies [f] to every element of [l], filters + out the [None] elements and returns the list of the arguments of + the [Some] elements. *) + + val some_if_all_elements_are_some : 'a option t -> 'a t option + (** If all elements of the given list are [Some _] then [Some xs] + is returned with the [xs] being the contents of those [Some]s, with + order preserved. Otherwise return [None]. *) + + val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t) + (** [let r1, r2 = map2_prefix f l1 l2] + If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n, + r1 is [List.map2 f l1 h1] and r2 is t2. *) + + val split_at : int -> 'a t -> 'a t * 'a t + (** [split_at n l] returns the pair [before, after] where [before] is + the [n] first elements of [l] and [after] the remaining ones. + If [l] has less than [n] elements, raises Invalid_argument. *) + end + + module Option : sig + type 'a t = 'a option + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val iter : ('a -> unit) -> 'a t -> unit + val map : ('a -> 'b) -> 'a t -> 'b t + val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b + end + + module Array : sig + val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + (* Same as [Array.exists], but for a two-argument predicate. Raise + Invalid_argument if the two arrays are determined to have + different lengths. *) + end +end + +val find_in_path: string list -> string -> string + (* Search a file in a list of directories. *) +val find_in_path_rel: string list -> string -> string + (* Search a relative file in a list of directories. *) +val find_in_path_uncap: string list -> string -> string + (* Same, but search also for uncapitalized name, i.e. + if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml + to match. *) +val remove_file: string -> unit + (* Delete the given file if it exists. Never raise an error. *) +val expand_directory: string -> string -> string + (* [expand_directory alt file] eventually expands a [+] at the + beginning of file into [alt] (an alternate root directory) *) + +val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t + (* Create a hashtable of the given size and fills it with the + given bindings. *) + +val copy_file: in_channel -> out_channel -> unit + (* [copy_file ic oc] reads the contents of file [ic] and copies + them to [oc]. It stops when encountering EOF on [ic]. *) +val copy_file_chunk: in_channel -> out_channel -> int -> unit + (* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies + them to [oc]. It raises [End_of_file] when encountering + EOF on [ic]. *) +val string_of_file: in_channel -> string + (* [string_of_file ic] reads the contents of file [ic] and copies + them to a string. It stops when encountering EOF on [ic]. *) +val output_to_file_via_temporary: + ?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a + (* Produce output in temporary file, then rename it + (as atomically as possible) to the desired output file name. + [output_to_file_via_temporary filename fn] opens a temporary file + which is passed to [fn] (name + output channel). When [fn] returns, + the channel is closed and the temporary file is renamed to + [filename]. *) + +val log2: int -> int + (* [log2 n] returns [s] such that [n = 1 lsl s] + if [n] is a power of 2*) +val align: int -> int -> int + (* [align n a] rounds [n] upwards to a multiple of [a] + (a power of 2). *) +val no_overflow_add: int -> int -> bool + (* [no_overflow_add n1 n2] returns [true] if the computation of + [n1 + n2] does not overflow. *) +val no_overflow_sub: int -> int -> bool + (* [no_overflow_sub n1 n2] returns [true] if the computation of + [n1 - n2] does not overflow. *) +val no_overflow_mul: int -> int -> bool + (* [no_overflow_mul n1 n2] returns [true] if the computation of + [n1 * n2] does not overflow. *) +val no_overflow_lsl: int -> int -> bool + (* [no_overflow_lsl n k] returns [true] if the computation of + [n lsl k] does not overflow. *) + +module Int_literal_converter : sig + val int : string -> int + val int32 : string -> int32 + val int64 : string -> int64 + val nativeint : string -> nativeint +end + +val chop_extensions: string -> string + (* Return the given file name without its extensions. The extensions + is the longest suffix starting with a period and not including + a directory separator, [.xyz.uvw] for instance. + + Return the given name if it does not contain an extension. *) + +val search_substring: string -> string -> int -> int + (* [search_substring pat str start] returns the position of the first + occurrence of string [pat] in string [str]. Search starts + at offset [start] in [str]. Raise [Not_found] if [pat] + does not occur. *) + +val replace_substring: before:string -> after:string -> string -> string + (* [replace_substring ~before ~after str] replaces all + occurrences of [before] with [after] in [str] and returns + the resulting string. *) + +val rev_split_words: string -> string list + (* [rev_split_words s] splits [s] in blank-separated words, and returns + the list of words in reverse order. *) + +val get_ref: 'a list ref -> 'a list + (* [get_ref lr] returns the content of the list reference [lr] and reset + its content to the empty list. *) + + +val fst3: 'a * 'b * 'c -> 'a +val snd3: 'a * 'b * 'c -> 'b +val thd3: 'a * 'b * 'c -> 'c + +val fst4: 'a * 'b * 'c * 'd -> 'a +val snd4: 'a * 'b * 'c * 'd -> 'b +val thd4: 'a * 'b * 'c * 'd -> 'c +val for4: 'a * 'b * 'c * 'd -> 'd + +module LongString : + sig + type t = bytes array + val create : int -> t + val length : t -> int + val get : t -> int -> char + val set : t -> int -> char -> unit + val blit : t -> int -> t -> int -> int -> unit + val output : out_channel -> t -> int -> int -> unit + val unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit + val input_bytes : in_channel -> int -> t + end + +val edit_distance : string -> string -> int -> int option +(** [edit_distance a b cutoff] computes the edit distance between + strings [a] and [b]. To help efficiency, it uses a cutoff: if the + distance [d] is smaller than [cutoff], it returns [Some d], else + [None]. + + The distance algorithm currently used is Damerau-Levenshtein: it + computes the number of insertion, deletion, substitution of + letters, or swapping of adjacent letters to go from one word to the + other. The particular algorithm may change in the future. +*) + +val spellcheck : string list -> string -> string list +(** [spellcheck env name] takes a list of names [env] that exist in + the current environment and an erroneous [name], and returns a + list of suggestions taken from [env], that are close enough to + [name] that it may be a typo for one of them. *) + +val did_you_mean : Format.formatter -> (unit -> string list) -> unit +(** [did_you_mean ppf get_choices] hints that the user may have meant + one of the option returned by calling [get_choices]. It does nothing + if the returned list is empty. + + The [unit -> ...] thunking is meant to delay any potentially-slow + computation (typically computing edit-distance with many things + from the current environment) to when the hint message is to be + printed. You should print an understandable error message before + calling [did_you_mean], so that users get a clear notification of + the failure even if producing the hint is slow. +*) + +val cut_at : string -> char -> string * string +(** [String.cut_at s c] returns a pair containing the sub-string before + the first occurrence of [c] in [s], and the sub-string after the + first occurrence of [c] in [s]. + [let (before, after) = String.cut_at s c in + before ^ String.make 1 c ^ after] is the identity if [s] contains [c]. + + Raise [Not_found] if the character does not appear in the string + @since 4.01 +*) + + +module StringSet: Set.S with type elt = string +module StringMap: Map.S with type key = string +(* TODO: replace all custom instantiations of StringSet/StringMap in various + compiler modules with this one. *) + +(* Color handling *) +module Color : sig + type color = + | Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + ;; + + type style = + | FG of color (* foreground *) + | BG of color (* background *) + | Bold + | Reset + + | Dim + + + val ansi_of_style_l : style list -> string + (* ANSI escape sequence for the given style *) + + type styles = { + error: style list; + warning: style list; + loc: style list; + } + + val default_styles: styles + val get_styles: unit -> styles + val set_styles: styles -> unit + + type setting = Auto | Always | Never + + val setup : setting option -> unit + (* [setup opt] will enable or disable color handling on standard formatters + according to the value of color setting [opt]. + Only the first call to this function has an effect. *) + + val set_color_tag_handling : Format.formatter -> unit + (* adds functions to support color tags to the given formatter. *) +end + +val normalise_eol : string -> string +(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters + removed. Intended for pre-processing text which will subsequently be printed + on a channel which performs EOL transformations (i.e. Windows) *) + +val delete_eol_spaces : string -> string +(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of + line spaces removed. Intended to normalize the output of the + toplevel for tests. *) + + + +(** {1 Hook machinery} + + Hooks machinery: + [add_hook name f] will register a function that will be called on the + argument of a later call to [apply_hooks]. Hooks are applied in the + lexicographical order of their names. +*) + +type hook_info = { + sourcefile : string; +} + +exception HookExnWrapper of + { + error: exn; + hook_name: string; + hook_info: hook_info; + } + (** An exception raised by a hook will be wrapped into a + [HookExnWrapper] constructor by the hook machinery. *) + + +val raise_direct_hook_exn: exn -> 'a + (** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will + not be wrapped into a {!HookExnWrapper}. *) + +module type HookSig = sig + type t + val add_hook : string -> (hook_info -> t -> t) -> unit + val apply_hooks : hook_info -> t -> t +end + +module MakeHooks : functor (M : sig type t end) -> HookSig with type t = M.t + +end = struct +#1 "misc.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Errors *) + +exception Fatal_error + +let fatal_error msg = + prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error + +let fatal_errorf fmt = Format.kasprintf fatal_error fmt + +(* Exceptions *) + +let try_finally work cleanup = + let result = (try work () with e -> cleanup (); raise e) in + cleanup (); + result +;; + +type ref_and_value = R : 'a ref * 'a -> ref_and_value + +let protect_refs = + let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in + fun refs f -> + let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in + set_refs refs; + match f () with + | x -> set_refs backup; x + | exception e -> set_refs backup; raise e + +(* List functions *) + +let rec map_end f l1 l2 = + match l1 with + [] -> l2 + | hd::tl -> f hd :: map_end f tl l2 + +let rec map_left_right f = function + [] -> [] + | hd::tl -> let res = f hd in res :: map_left_right f tl + +let rec for_all2 pred l1 l2 = + match (l1, l2) with + ([], []) -> true + | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2 + | (_, _) -> false + +let rec replicate_list elem n = + if n <= 0 then [] else elem :: replicate_list elem (n-1) + +let rec list_remove x = function + [] -> [] + | hd :: tl -> + if hd = x then tl else hd :: list_remove x tl + +let rec split_last = function + [] -> assert false + | [x] -> ([], x) + | hd :: tl -> + let (lst, last) = split_last tl in + (hd :: lst, last) + +module Stdlib = struct + module List = struct + type 'a t = 'a list + + let rec compare cmp l1 l2 = + match l1, l2 with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | h1::t1, h2::t2 -> + let c = cmp h1 h2 in + if c <> 0 then c + else compare cmp t1 t2 + + let rec equal eq l1 l2 = + match l1, l2 with + | ([], []) -> true + | (hd1 :: tl1, hd2 :: tl2) -> eq hd1 hd2 && equal eq tl1 tl2 + | (_, _) -> false + + let filter_map f l = + let rec aux acc l = + match l with + | [] -> List.rev acc + | h :: t -> + match f h with + | None -> aux acc t + | Some v -> aux (v :: acc) t + in + aux [] l + + let map2_prefix f l1 l2 = + let rec aux acc l1 l2 = + match l1, l2 with + | [], _ -> (List.rev acc, l2) + | _ :: _, [] -> raise (Invalid_argument "map2_prefix") + | h1::t1, h2::t2 -> + let h = f h1 h2 in + aux (h :: acc) t1 t2 + in + aux [] l1 l2 + + let some_if_all_elements_are_some l = + let rec aux acc l = + match l with + | [] -> Some (List.rev acc) + | None :: _ -> None + | Some h :: t -> aux (h :: acc) t + in + aux [] l + + let split_at n l = + let rec aux n acc l = + if n = 0 + then List.rev acc, l + else + match l with + | [] -> raise (Invalid_argument "split_at") + | t::q -> aux (n-1) (t::acc) q + in + aux n [] l + end + + module Option = struct + type 'a t = 'a option + + let equal eq o1 o2 = + match o1, o2 with + | None, None -> true + | Some e1, Some e2 -> eq e1 e2 + | _, _ -> false + + let iter f = function + | Some x -> f x + | None -> () + + let map f = function + | Some x -> Some (f x) + | None -> None + + let fold f a b = + match a with + | None -> b + | Some a -> f a b + + let value_default f ~default a = + match a with + | None -> default + | Some a -> f a + end + + module Array = struct + let exists2 p a1 a2 = + let n = Array.length a1 in + if Array.length a2 <> n then invalid_arg "Misc.Stdlib.Array.exists2"; + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a1 i) (Array.unsafe_get a2 i) then true + else loop (succ i) in + loop 0 + end +end + +let may = Stdlib.Option.iter +let may_map = Stdlib.Option.map + +(* File functions *) + +let find_in_path path name = + if not (Filename.is_implicit name) then + if Sys.file_exists name then name else raise Not_found + else begin + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = Filename.concat dir name in + if Sys.file_exists fullname then fullname else try_dir rem + in try_dir path + end + +let find_in_path_rel path name = + let rec simplify s = + let open Filename in + let base = basename s in + let dir = dirname s in + if dir = s then dir + else if base = current_dir_name then simplify dir + else concat (simplify dir) base + in + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = simplify (Filename.concat dir name) in + if Sys.file_exists fullname then fullname else try_dir rem + in try_dir path + +let find_in_path_uncap path name = + let uname = String.uncapitalize_ascii name in + let rec try_dir = function + [] -> raise Not_found + | dir::rem -> + let fullname = Filename.concat dir name + and ufullname = Filename.concat dir uname in + if Sys.file_exists ufullname then ufullname + else if Sys.file_exists fullname then fullname + else try_dir rem + in try_dir path + +let remove_file filename = + try + if Sys.file_exists filename + then Sys.remove filename + with Sys_error _msg -> + () + +(* Expand a -I option: if it starts with +, make it relative to the standard + library directory *) + +let expand_directory alt s = + if String.length s > 0 && s.[0] = '+' + then Filename.concat alt + (String.sub s 1 (String.length s - 1)) + else s + +(* Hashtable functions *) + +let create_hashtable size init = + let tbl = Hashtbl.create size in + List.iter (fun (key, data) -> Hashtbl.add tbl key data) init; + tbl + +(* File copy *) + +let copy_file ic oc = + let buff = Bytes.create 0x1000 in + let rec copy () = + let n = input ic buff 0 0x1000 in + if n = 0 then () else (output oc buff 0 n; copy()) + in copy() + +let copy_file_chunk ic oc len = + let buff = Bytes.create 0x1000 in + let rec copy n = + if n <= 0 then () else begin + let r = input ic buff 0 (min n 0x1000) in + if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r)) + end + in copy len + +let string_of_file ic = + let b = Buffer.create 0x10000 in + let buff = Bytes.create 0x1000 in + let rec copy () = + let n = input ic buff 0 0x1000 in + if n = 0 then Buffer.contents b else + (Buffer.add_subbytes b buff 0 n; copy()) + in copy() + +let output_to_file_via_temporary ?(mode = [Open_text]) filename fn = + let (temp_filename, oc) = + Filename.open_temp_file + ~mode ~perms:0o666 ~temp_dir:(Filename.dirname filename) + (Filename.basename filename) ".tmp" in + (* The 0o666 permissions will be modified by the umask. It's just + like what [open_out] and [open_out_bin] do. + With temp_dir = dirname filename, we ensure that the returned + temp file is in the same directory as filename itself, making + it safe to rename temp_filename to filename later. + With prefix = basename filename, we are almost certain that + the first generated name will be unique. A fixed prefix + would work too but might generate more collisions if many + files are being produced simultaneously in the same directory. *) + match fn temp_filename oc with + | res -> + close_out oc; + begin try + Sys.rename temp_filename filename; res + with exn -> + remove_file temp_filename; raise exn + end + | exception exn -> + close_out oc; remove_file temp_filename; raise exn + +(* Integer operations *) + +let rec log2 n = + if n <= 1 then 0 else 1 + log2(n asr 1) + +let align n a = + if n >= 0 then (n + a - 1) land (-a) else n land (-a) + +let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0 + +let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0 + +let no_overflow_mul a b = b <> 0 && (a * b) / b = a + +let no_overflow_lsl a k = + 0 <= k && k < Sys.word_size && min_int asr k <= a && a <= max_int asr k + +module Int_literal_converter = struct + (* To convert integer literals, allowing max_int + 1 (PR#4210) *) + let cvt_int_aux str neg of_string = + if String.length str = 0 || str.[0]= '-' + then of_string str + else neg (of_string ("-" ^ str)) + let int s = cvt_int_aux s (~-) int_of_string + let int32 s = cvt_int_aux s Int32.neg Int32.of_string + let int64 s = cvt_int_aux s Int64.neg Int64.of_string + let nativeint s = cvt_int_aux s Nativeint.neg Nativeint.of_string +end + +(* String operations *) + +let chop_extensions file = + let dirname = Filename.dirname file and basename = Filename.basename file in + try + let pos = String.index basename '.' in + let basename = String.sub basename 0 pos in + if Filename.is_implicit file && dirname = Filename.current_dir_name then + basename + else + Filename.concat dirname basename + with Not_found -> file + +let search_substring pat str start = + let rec search i j = + if j >= String.length pat then i + else if i + j >= String.length str then raise Not_found + else if str.[i + j] = pat.[j] then search i (j+1) + else search (i+1) 0 + in search start 0 + +let replace_substring ~before ~after str = + let rec search acc curr = + match search_substring before str curr with + | next -> + let prefix = String.sub str curr (next - curr) in + search (prefix :: acc) (next + String.length before) + | exception Not_found -> + let suffix = String.sub str curr (String.length str - curr) in + List.rev (suffix :: acc) + in String.concat after (search [] 0) + +let rev_split_words s = + let rec split1 res i = + if i >= String.length s then res else begin + match s.[i] with + ' ' | '\t' | '\r' | '\n' -> split1 res (i+1) + | _ -> split2 res i (i+1) + end + and split2 res i j = + if j >= String.length s then String.sub s i (j-i) :: res else begin + match s.[j] with + ' ' | '\t' | '\r' | '\n' -> split1 (String.sub s i (j-i) :: res) (j+1) + | _ -> split2 res i (j+1) + end + in split1 [] 0 + +let get_ref r = + let v = !r in + r := []; v + +let fst3 (x, _, _) = x +let snd3 (_,x,_) = x +let thd3 (_,_,x) = x + +let fst4 (x, _, _, _) = x +let snd4 (_,x,_, _) = x +let thd4 (_,_,x,_) = x +let for4 (_,_,_,x) = x + + +module LongString = struct + type t = bytes array + + let create str_size = + let tbl_size = str_size / Sys.max_string_length + 1 in + let tbl = Array.make tbl_size Bytes.empty in + for i = 0 to tbl_size - 2 do + tbl.(i) <- Bytes.create Sys.max_string_length; + done; + tbl.(tbl_size - 1) <- Bytes.create (str_size mod Sys.max_string_length); + tbl + + let length tbl = + let tbl_size = Array.length tbl in + Sys.max_string_length * (tbl_size - 1) + Bytes.length tbl.(tbl_size - 1) + + let get tbl ind = + Bytes.get tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) + + let set tbl ind c = + Bytes.set tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length) + c + + let blit src srcoff dst dstoff len = + for i = 0 to len - 1 do + set dst (dstoff + i) (get src (srcoff + i)) + done + + let output oc tbl pos len = + for i = pos to pos + len - 1 do + output_char oc (get tbl i) + done + + let unsafe_blit_to_bytes src srcoff dst dstoff len = + for i = 0 to len - 1 do + Bytes.unsafe_set dst (dstoff + i) (get src (srcoff + i)) + done + + let input_bytes ic len = + let tbl = create len in + Array.iter (fun str -> really_input ic str 0 (Bytes.length str)) tbl; + tbl +end + + +let edit_distance a b cutoff = + let la, lb = String.length a, String.length b in + let cutoff = + (* using max_int for cutoff would cause overflows in (i + cutoff + 1); + we bring it back to the (max la lb) worstcase *) + min (max la lb) cutoff in + if abs (la - lb) > cutoff then None + else begin + (* initialize with 'cutoff + 1' so that not-yet-written-to cases have + the worst possible cost; this is useful when computing the cost of + a case just at the boundary of the cutoff diagonal. *) + let m = Array.make_matrix (la + 1) (lb + 1) (cutoff + 1) in + m.(0).(0) <- 0; + for i = 1 to la do + m.(i).(0) <- i; + done; + for j = 1 to lb do + m.(0).(j) <- j; + done; + for i = 1 to la do + for j = max 1 (i - cutoff - 1) to min lb (i + cutoff + 1) do + let cost = if a.[i-1] = b.[j-1] then 0 else 1 in + let best = + (* insert, delete or substitute *) + min (1 + min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost) + in + let best = + (* swap two adjacent letters; we use "cost" again in case of + a swap between two identical letters; this is slightly + redundant as this is a double-substitution case, but it + was done this way in most online implementations and + imitation has its virtues *) + if not (i > 1 && j > 1 && a.[i-1] = b.[j-2] && a.[i-2] = b.[j-1]) + then best + else min best (m.(i-2).(j-2) + cost) + in + m.(i).(j) <- best + done; + done; + let result = m.(la).(lb) in + if result > cutoff + then None + else Some result + end + +let spellcheck env name = + let cutoff = + match String.length name with + | 1 | 2 -> 0 + | 3 | 4 -> 1 + | 5 | 6 -> 2 + | _ -> 3 + in + let compare target acc head = + match edit_distance target head cutoff with + | None -> acc + | Some dist -> + let (best_choice, best_dist) = acc in + if dist < best_dist then ([head], dist) + else if dist = best_dist then (head :: best_choice, dist) + else acc + in + fst (List.fold_left (compare name) ([], max_int) env) + +let did_you_mean ppf get_choices = + (* flush now to get the error report early, in the (unheard of) case + where the search in the get_choices function would take a bit of + time; in the worst case, the user has seen the error, she can + interrupt the process before the spell-checking terminates. *) + Format.fprintf ppf "@?"; + match get_choices () with + | [] -> () + | choices -> + let rest, last = split_last choices in + Format.fprintf ppf "@\nHint: Did you mean %s%s%s?@?" + (String.concat ", " rest) + (if rest = [] then "" else " or ") + last + +let cut_at s c = + let pos = String.index s c in + String.sub s 0 pos, String.sub s (pos+1) (String.length s - pos - 1) + + +module StringSet = Set.Make(struct type t = string let compare = compare end) +module StringMap = Map.Make(struct type t = string let compare = compare end) + +(* Color handling *) +module Color = struct + (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *) + type color = + | Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + ;; + + type style = + | FG of color (* foreground *) + | BG of color (* background *) + | Bold + | Reset + + | Dim + + + let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" + + let code_of_style = function + | FG c -> "3" ^ ansi_of_color c + | BG c -> "4" ^ ansi_of_color c + | Bold -> "1" + | Reset -> "0" + + | Dim -> "2" + + + let ansi_of_style_l l = + let s = match l with + | [] -> code_of_style Reset + | [s] -> code_of_style s + | _ -> String.concat ";" (List.map code_of_style l) + in + "\x1b[" ^ s ^ "m" + + type styles = { + error: style list; + warning: style list; + loc: style list; + } + + let default_styles = { + warning = [Bold; FG Magenta]; + error = [Bold; FG Red]; + loc = [Bold]; + } + + let cur_styles = ref default_styles + let get_styles () = !cur_styles + let set_styles s = cur_styles := s + + (* map a tag to a style, if the tag is known. + @raise Not_found otherwise *) + let style_of_tag s = match s with + | "error" -> (!cur_styles).error + | "warning" -> (!cur_styles).warning + | "loc" -> (!cur_styles).loc + + | "info" -> [Bold; FG Yellow] + | "dim" -> [Dim] + | "filename" -> [FG Cyan] + + | _ -> raise Not_found + + let color_enabled = ref true + + (* either prints the tag of [s] or delegates to [or_else] *) + let mark_open_tag ~or_else s = + try + let style = style_of_tag s in + if !color_enabled then ansi_of_style_l style else "" + with Not_found -> or_else s + + let mark_close_tag ~or_else s = + try + let _ = style_of_tag s in + if !color_enabled then ansi_of_style_l [Reset] else "" + with Not_found -> or_else s + + (* add color handling to formatter [ppf] *) + let set_color_tag_handling ppf = + let open Format in + let functions = pp_get_formatter_tag_functions ppf () in + let functions' = {functions with + mark_open_tag=(mark_open_tag ~or_else:functions.mark_open_tag); + mark_close_tag=(mark_close_tag ~or_else:functions.mark_close_tag); + } in + pp_set_mark_tags ppf true; (* enable tags *) + pp_set_formatter_tag_functions ppf functions'; + (* also setup margins *) + pp_set_margin ppf (pp_get_margin std_formatter()); + () + + external isatty : out_channel -> bool = "caml_sys_isatty" + + (* reasonable heuristic on whether colors should be enabled *) + let should_enable_color () = + let term = try Sys.getenv "TERM" with Not_found -> "" in + term <> "dumb" + && term <> "" + && isatty stderr + + type setting = Auto | Always | Never + + let setup = + let first = ref true in (* initialize only once *) + let formatter_l = + [Format.std_formatter; Format.err_formatter; Format.str_formatter] + in + fun o -> + if !first then ( + first := false; + Format.set_mark_tags true; + List.iter set_color_tag_handling formatter_l; + color_enabled := (match o with + | Some Always -> true + | Some Auto -> should_enable_color () + | Some Never -> false + | None -> should_enable_color ()) + ); + () +end + +let normalise_eol s = + let b = Buffer.create 80 in + for i = 0 to String.length s - 1 do + if s.[i] <> '\r' then Buffer.add_char b s.[i] + done; + Buffer.contents b + +let delete_eol_spaces src = + let len_src = String.length src in + let dst = Bytes.create len_src in + let rec loop i_src i_dst = + if i_src = len_src then + i_dst + else + match src.[i_src] with + | ' ' | '\t' -> + loop_spaces 1 (i_src + 1) i_dst + | c -> + Bytes.set dst i_dst c; + loop (i_src + 1) (i_dst + 1) + and loop_spaces spaces i_src i_dst = + if i_src = len_src then + i_dst + else + match src.[i_src] with + | ' ' | '\t' -> + loop_spaces (spaces + 1) (i_src + 1) i_dst + | '\n' -> + Bytes.set dst i_dst '\n'; + loop (i_src + 1) (i_dst + 1) + | _ -> + for n = 0 to spaces do + Bytes.set dst (i_dst + n) src.[i_src - spaces + n] + done; + loop (i_src + 1) (i_dst + spaces + 1) + in + let stop = loop 0 0 in + Bytes.sub_string dst 0 stop + +type hook_info = { + sourcefile : string; +} + +exception HookExnWrapper of + { + error: exn; + hook_name: string; + hook_info: hook_info; + } + +exception HookExn of exn + +let raise_direct_hook_exn e = raise (HookExn e) + +let fold_hooks list hook_info ast = + List.fold_left (fun ast (hook_name,f) -> + try + f hook_info ast + with + | HookExn e -> raise e + | error -> raise (HookExnWrapper {error; hook_name; hook_info}) + (* when explicit reraise with backtrace will be available, + it should be used here *) + + ) ast (List.sort compare list) + +module type HookSig = sig + type t + + val add_hook : string -> (hook_info -> t -> t) -> unit + val apply_hooks : hook_info -> t -> t +end + +module MakeHooks(M: sig + type t + end) : HookSig with type t = M.t += struct + + type t = M.t + + let hooks = ref [] + let add_hook name f = hooks := (name, f) :: !hooks + let apply_hooks sourcefile intf = + fold_hooks !hooks sourcefile intf +end + +end +module Identifiable : sig +#1 "identifiable.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Uniform interface for common data structures over various things. *) + +module type Thing = sig + type t + + include Hashtbl.HashedType with type t := t + include Map.OrderedType with type t := t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit +end + +module Pair : functor (A : Thing) (B : Thing) -> Thing with type t = A.t * B.t + +module type Set = sig + module T : Set.OrderedType + include Set.S + with type elt = T.t + and type t = Set.Make (T).t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit + val to_string : t -> string + val of_list : elt list -> t + val map : (elt -> elt) -> t -> t +end + +module type Map = sig + module T : Map.OrderedType + include Map.S + with type key = T.t + and type 'a t = 'a Map.Make (T).t + + val filter_map : 'a t -> f:(key -> 'a -> 'b option) -> 'b t + val of_list : (key * 'a) list -> 'a t + + (** [disjoint_union m1 m2] contains all bindings from [m1] and + [m2]. If some binding is present in both and the associated + value is not equal, a Fatal_error is raised *) + val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t + + (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If + some binding is present in both, the one from [m2] is taken *) + val union_right : 'a t -> 'a t -> 'a t + + (** [union_left m1 m2 = union_right m2 m1] *) + val union_left : 'a t -> 'a t -> 'a t + + val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t + val rename : key t -> key -> key + val map_keys : (key -> key) -> 'a t -> 'a t + val keys : 'a t -> Set.Make(T).t + val data : 'a t -> 'a list + val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t + val transpose_keys_and_data : key t -> key t + val transpose_keys_and_data_set : key t -> Set.Make(T).t t + val print : + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit +end + +module type Tbl = sig + module T : sig + type t + include Map.OrderedType with type t := t + include Hashtbl.HashedType with type t := t + end + include Hashtbl.S + with type key = T.t + and type 'a t = 'a Hashtbl.Make (T).t + + val to_list : 'a t -> (T.t * 'a) list + val of_list : (T.t * 'a) list -> 'a t + + val to_map : 'a t -> 'a Map.Make(T).t + val of_map : 'a Map.Make(T).t -> 'a t + val memoize : 'a t -> (key -> 'a) -> key -> 'a + val map : 'a t -> ('a -> 'b) -> 'b t +end + +module type S = sig + type t + + module T : Thing with type t = t + include Thing with type t := T.t + + module Set : Set with module T := T + module Map : Map with module T := T + module Tbl : Tbl with module T := T +end + +module Make (T : Thing) : S with type t := T.t + +end = struct +#1 "identifiable.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +module type Thing = sig + type t + + include Hashtbl.HashedType with type t := t + include Map.OrderedType with type t := t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit +end + +module type Set = sig + module T : Set.OrderedType + include Set.S + with type elt = T.t + and type t = Set.Make (T).t + + val output : out_channel -> t -> unit + val print : Format.formatter -> t -> unit + val to_string : t -> string + val of_list : elt list -> t + val map : (elt -> elt) -> t -> t +end + +module type Map = sig + module T : Map.OrderedType + include Map.S + with type key = T.t + and type 'a t = 'a Map.Make (T).t + + val filter_map : 'a t -> f:(key -> 'a -> 'b option) -> 'b t + val of_list : (key * 'a) list -> 'a t + + val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t + + val union_right : 'a t -> 'a t -> 'a t + + val union_left : 'a t -> 'a t -> 'a t + + val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t + val rename : key t -> key -> key + val map_keys : (key -> key) -> 'a t -> 'a t + val keys : 'a t -> Set.Make(T).t + val data : 'a t -> 'a list + val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t + val transpose_keys_and_data : key t -> key t + val transpose_keys_and_data_set : key t -> Set.Make(T).t t + val print : + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit +end + +module type Tbl = sig + module T : sig + type t + include Map.OrderedType with type t := t + include Hashtbl.HashedType with type t := t + end + include Hashtbl.S + with type key = T.t + and type 'a t = 'a Hashtbl.Make (T).t + + val to_list : 'a t -> (T.t * 'a) list + val of_list : (T.t * 'a) list -> 'a t + + val to_map : 'a t -> 'a Map.Make(T).t + val of_map : 'a Map.Make(T).t -> 'a t + val memoize : 'a t -> (key -> 'a) -> key -> 'a + val map : 'a t -> ('a -> 'b) -> 'b t +end + +module Pair (A : Thing) (B : Thing) : Thing with type t = A.t * B.t = struct + type t = A.t * B.t + + let compare (a1, b1) (a2, b2) = + let c = A.compare a1 a2 in + if c <> 0 then c + else B.compare b1 b2 + + let output oc (a, b) = Printf.fprintf oc " (%a, %a)" A.output a B.output b + let hash (a, b) = Hashtbl.hash (A.hash a, B.hash b) + let equal (a1, b1) (a2, b2) = A.equal a1 a2 && B.equal b1 b2 + let print ppf (a, b) = Format.fprintf ppf " (%a, @ %a)" A.print a B.print b +end + +module Make_map (T : Thing) = struct + include Map.Make (T) + + let filter_map t ~f = + fold (fun id v map -> + match f id v with + | None -> map + | Some r -> add id r map) t empty + + let of_list l = + List.fold_left (fun map (id, v) -> add id v map) empty l + + let disjoint_union ?eq ?print m1 m2 = + union (fun id v1 v2 -> + let ok = match eq with + | None -> false + | Some eq -> eq v1 v2 + in + if not ok then + let err = + match print with + | None -> + Format.asprintf "Map.disjoint_union %a" T.print id + | Some print -> + Format.asprintf "Map.disjoint_union %a => %a <> %a" + T.print id print v1 print v2 + in + Misc.fatal_error err + else Some v1) + m1 m2 + + let union_right m1 m2 = + merge (fun _id x y -> match x, y with + | None, None -> None + | None, Some v + | Some v, None + | Some _, Some v -> Some v) + m1 m2 + + let union_left m1 m2 = union_right m2 m1 + + let union_merge f m1 m2 = + let aux _ m1 m2 = + match m1, m2 with + | None, m | m, None -> m + | Some m1, Some m2 -> Some (f m1 m2) + in + merge aux m1 m2 + + let rename m v = + try find v m + with Not_found -> v + + let map_keys f m = + of_list (List.map (fun (k, v) -> f k, v) (bindings m)) + + let print f ppf s = + let elts ppf s = iter (fun id v -> + Format.fprintf ppf "@ (@[%a@ %a@])" T.print id f v) s in + Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s + + module T_set = Set.Make (T) + + let keys map = fold (fun k _ set -> T_set.add k set) map T_set.empty + + let data t = List.map snd (bindings t) + + let of_set f set = T_set.fold (fun e map -> add e (f e) map) set empty + + let transpose_keys_and_data map = fold (fun k v m -> add v k m) map empty + let transpose_keys_and_data_set map = + fold (fun k v m -> + let set = + match find v m with + | exception Not_found -> + T_set.singleton k + | set -> + T_set.add k set + in + add v set m) + map empty +end + +module Make_set (T : Thing) = struct + include Set.Make (T) + + let output oc s = + Printf.fprintf oc " ( "; + iter (fun v -> Printf.fprintf oc "%a " T.output v) s; + Printf.fprintf oc ")" + + let print ppf s = + let elts ppf s = iter (fun e -> Format.fprintf ppf "@ %a" T.print e) s in + Format.fprintf ppf "@[<1>{@[%a@ @]}@]" elts s + + let to_string s = Format.asprintf "%a" print s + + let of_list l = match l with + | [] -> empty + | [t] -> singleton t + | t :: q -> List.fold_left (fun acc e -> add e acc) (singleton t) q + + let map f s = of_list (List.map f (elements s)) +end + +module Make_tbl (T : Thing) = struct + include Hashtbl.Make (T) + + module T_map = Make_map (T) + + let to_list t = + fold (fun key datum elts -> (key, datum)::elts) t [] + + let of_list elts = + let t = create 42 in + List.iter (fun (key, datum) -> add t key datum) elts; + t + + let to_map v = fold T_map.add v T_map.empty + + let of_map m = + let t = create (T_map.cardinal m) in + T_map.iter (fun k v -> add t k v) m; + t + + let memoize t f = fun key -> + try find t key with + | Not_found -> + let r = f key in + add t key r; + r + + let map t f = + of_map (T_map.map f (to_map t)) +end + +module type S = sig + type t + + module T : Thing with type t = t + include Thing with type t := T.t + + module Set : Set with module T := T + module Map : Map with module T := T + module Tbl : Tbl with module T := T +end + +module Make (T : Thing) = struct + module T = T + include T + + module Set = Make_set (T) + module Map = Make_map (T) + module Tbl = Make_tbl (T) +end + +end +module Numbers : sig +#1 "numbers.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Modules about numbers, some of which satisfy {!Identifiable.S}. *) + +module Int : sig + include Identifiable.S with type t = int + + (** [zero_to_n n] is the set of numbers \{0, ..., n\} (inclusive). *) + val zero_to_n : int -> Set.t +end + +module Int8 : sig + type t + + val zero : t + val one : t + + val of_int_exn : int -> t + val to_int : t -> int +end + +module Int16 : sig + type t + + val of_int_exn : int -> t + val of_int64_exn : Int64.t -> t + + val to_int : t -> int +end + +module Float : Identifiable.S with type t = float + +end = struct +#1 "numbers.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2016 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +module Int_base = Identifiable.Make (struct + type t = int + + let compare x y = x - y + let output oc x = Printf.fprintf oc "%i" x + let hash i = i + let equal (i : int) j = i = j + let print = Format.pp_print_int +end) + +module Int = struct + type t = int + + include Int_base + + let rec zero_to_n n = + if n < 0 then Set.empty else Set.add n (zero_to_n (n-1)) +end + +module Int8 = struct + type t = int + + let zero = 0 + let one = 1 + + let of_int_exn i = + if i < -(1 lsl 7) || i > ((1 lsl 7) - 1) then + Misc.fatal_errorf "Int8.of_int_exn: %d is out of range" i + else + i + + let to_int i = i +end + +module Int16 = struct + type t = int + + let of_int_exn i = + if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then + Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i + else + i + + let lower_int64 = Int64.neg (Int64.shift_left Int64.one 15) + let upper_int64 = Int64.sub (Int64.shift_left Int64.one 15) Int64.one + + let of_int64_exn i = + if Int64.compare i lower_int64 < 0 + || Int64.compare i upper_int64 > 0 + then + Misc.fatal_errorf "Int16.of_int64_exn: %Ld is out of range" i + else + Int64.to_int i + + let to_int t = t +end + +module Float = struct + type t = float + + include Identifiable.Make (struct + type t = float + + let compare x y = Pervasives.compare x y + let output oc x = Printf.fprintf oc "%f" x + let hash f = Hashtbl.hash f + let equal (i : float) j = i = j + let print = Format.pp_print_float + end) +end + +end +module Profile : sig +#1 "profile.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Compiler performance recording *) + +type file = string + +val reset : unit -> unit +(** erase all recorded profile information *) + +val record_call : ?accumulate:bool -> string -> (unit -> 'a) -> 'a +(** [record_call pass f] calls [f] and records its profile information. *) + +val record : ?accumulate:bool -> string -> ('a -> 'b) -> 'a -> 'b +(** [record pass f arg] records the profile information of [f arg] *) + +type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ] + +val print : Format.formatter -> column list -> unit +(** Prints the selected recorded profiling information to the formatter. *) + +(** Command line flags *) + +val options_doc : string +val all_columns : column list + +(** A few pass names that are needed in several places, and shared to + avoid typos. *) + +val generate : string +val transl : string +val typing : string + +end = struct +#1 "profile.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-18-40-42-48"] + +type file = string + +external time_include_children: bool -> float = "caml_sys_time_include_children" +let cpu_time () = time_include_children true + +module Measure = struct + type t = { + time : float; + allocated_words : float; + top_heap_words : int; + } + let create () = + let stat = Gc.quick_stat () in + { + time = cpu_time (); + allocated_words = stat.minor_words +. stat.major_words; + top_heap_words = stat.top_heap_words; + } + let zero = { time = 0.; allocated_words = 0.; top_heap_words = 0 } +end + +module Measure_diff = struct + let timestamp = let r = ref (-1) in fun () -> incr r; !r + type t = { + timestamp : int; + duration : float; + allocated_words : float; + top_heap_words_increase : int; + } + let zero () = { + timestamp = timestamp (); + duration = 0.; + allocated_words = 0.; + top_heap_words_increase = 0; + } + let accumulate t (m1 : Measure.t) (m2 : Measure.t) = { + timestamp = t.timestamp; + duration = t.duration +. (m2.time -. m1.time); + allocated_words = + t.allocated_words +. (m2.allocated_words -. m1.allocated_words); + top_heap_words_increase = + t.top_heap_words_increase + (m2.top_heap_words - m1.top_heap_words); + } + let of_diff m1 m2 = + accumulate (zero ()) m1 m2 +end + +type hierarchy = + | E of (string, Measure_diff.t * hierarchy) Hashtbl.t +[@@unboxed] + +let create () = E (Hashtbl.create 2) +let hierarchy = ref (create ()) +let initial_measure = ref None +let reset () = hierarchy := create (); initial_measure := None + +let record_call ?(accumulate = false) name f = + let E prev_hierarchy = !hierarchy in + let start_measure = Measure.create () in + if !initial_measure = None then initial_measure := Some start_measure; + let this_measure_diff, this_table = + (* We allow the recording of multiple categories by the same name, for tools + like ocamldoc that use the compiler libs but don't care about profile + information, and so may record, say, "parsing" multiple times. *) + if accumulate + then + match Hashtbl.find prev_hierarchy name with + | exception Not_found -> Measure_diff.zero (), Hashtbl.create 2 + | measure_diff, E table -> + Hashtbl.remove prev_hierarchy name; + measure_diff, table + else Measure_diff.zero (), Hashtbl.create 2 + in + hierarchy := E this_table; + Misc.try_finally f + (fun () -> + hierarchy := E prev_hierarchy; + let end_measure = Measure.create () in + let measure_diff = + Measure_diff.accumulate this_measure_diff start_measure end_measure in + Hashtbl.add prev_hierarchy name (measure_diff, E this_table)) + +let record ?accumulate pass f x = record_call ?accumulate pass (fun () -> f x) + +type display = { + to_string : max:float -> width:int -> string; + worth_displaying : max:float -> bool; +} + +let time_display v : display = + (* Because indentation is meaningful, and because the durations are + the first element of each row, we can't pad them with spaces. *) + let to_string_without_unit v ~width = Printf.sprintf "%0*.03f" width v in + let to_string ~max:_ ~width = + to_string_without_unit v ~width:(width - 1) ^ "s" in + let worth_displaying ~max:_ = + float_of_string (to_string_without_unit v ~width:0) <> 0. in + { to_string; worth_displaying } + +let memory_word_display = + (* To make memory numbers easily comparable across rows, we choose a single + scale for an entire column. To keep the display compact and not overly + precise (no one cares about the exact number of bytes), we pick the largest + scale we can and we only show 3 digits. Avoiding showing tiny numbers also + allows us to avoid displaying passes that barely allocate compared to the + rest of the compiler. *) + let bytes_of_words words = words *. float_of_int (Sys.word_size / 8) in + let to_string_without_unit v ~width scale = + let precision = 3 and precision_power = 1e3 in + let v_rescaled = bytes_of_words v /. scale in + let v_rounded = + floor (v_rescaled *. precision_power +. 0.5) /. precision_power in + let v_str = Printf.sprintf "%.*f" precision v_rounded in + let index_of_dot = String.index v_str '.' in + let v_str_truncated = + String.sub v_str 0 + (if index_of_dot >= precision + then index_of_dot + else precision + 1) + in + Printf.sprintf "%*s" width v_str_truncated + in + let choose_memory_scale = + let units = [|"B"; "kB"; "MB"; "GB"|] in + fun words -> + let bytes = bytes_of_words words in + let scale = ref (Array.length units - 1) in + while !scale > 0 && bytes < 1024. ** float_of_int !scale do + decr scale + done; + 1024. ** float_of_int !scale, units.(!scale) + in + fun ?previous v : display -> + let to_string ~max ~width = + let scale, scale_str = choose_memory_scale max in + let width = width - String.length scale_str in + to_string_without_unit v ~width scale ^ scale_str + in + let worth_displaying ~max = + let scale, _ = choose_memory_scale max in + float_of_string (to_string_without_unit v ~width:0 scale) <> 0. + && match previous with + | None -> true + | Some p -> + (* This branch is for numbers that represent absolute quantity, rather + than differences. It allows us to skip displaying the same absolute + quantity many times in a row. *) + to_string_without_unit p ~width:0 scale + <> to_string_without_unit v ~width:0 scale + in + { to_string; worth_displaying } + +let profile_list (E table) = + let l = Hashtbl.fold (fun k d l -> (k, d) :: l) table [] in + List.sort (fun (_, (p1, _)) (_, (p2, _)) -> + compare p1.Measure_diff.timestamp p2.Measure_diff.timestamp) l + +let compute_other_category (E table : hierarchy) (total : Measure_diff.t) = + let r = ref total in + Hashtbl.iter (fun _pass ((p2 : Measure_diff.t), _) -> + let p1 = !r in + r := { + timestamp = p1.timestamp; + duration = p1.duration -. p2.duration; + allocated_words = p1.allocated_words -. p2.allocated_words; + top_heap_words_increase = + p1.top_heap_words_increase - p2.top_heap_words_increase; + } + ) table; + !r + +type row = R of string * (float * display) list * row list +type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ] + +let rec rows_of_hierarchy ~nesting make_row name measure_diff hierarchy env = + let rows = + rows_of_hierarchy_list + ~nesting:(nesting + 1) make_row hierarchy measure_diff env in + let values, env = + make_row env measure_diff ~toplevel_other:(nesting = 0 && name = "other") in + R (name, values, rows), env + +and rows_of_hierarchy_list ~nesting make_row hierarchy total env = + let list = profile_list hierarchy in + let list = + if list <> [] || nesting = 0 + then list @ [ "other", (compute_other_category hierarchy total, create ()) ] + else [] + in + let env = ref env in + List.map (fun (name, (measure_diff, hierarchy)) -> + let a, env' = + rows_of_hierarchy ~nesting make_row name measure_diff hierarchy !env in + env := env'; + a + ) list + +let rows_of_hierarchy hierarchy measure_diff initial_measure columns = + (* Computing top heap size is a bit complicated: if the compiler applies a + list of passes n times (rather than applying pass1 n times, then pass2 n + times etc), we only show one row for that pass but what does "top heap + size at the end of that pass" even mean? + It seems the only sensible answer is to pretend the compiler applied pass1 + n times, pass2 n times by accumulating all the heap size increases that + happened during each pass, and then compute what the heap size would have + been. So that's what we do. + There's a bit of extra complication, which is that the heap can increase in + between measurements. So the heap sizes can be a bit off until the "other" + rows account for what's missing. We special case the toplevel "other" row + so that any increases that happened before the start of the compilation is + correctly reported, as a lot of code may run before the start of the + compilation (eg functor applications). *) + let make_row prev_top_heap_words (p : Measure_diff.t) ~toplevel_other = + let top_heap_words = + prev_top_heap_words + + p.top_heap_words_increase + - if toplevel_other + then initial_measure.Measure.top_heap_words + else 0 + in + let make value ~f = value, f value in + List.map (function + | `Time -> + make p.duration ~f:time_display + | `Alloc -> + make p.allocated_words ~f:memory_word_display + | `Top_heap -> + make (float_of_int p.top_heap_words_increase) ~f:memory_word_display + | `Abs_top_heap -> + make (float_of_int top_heap_words) + ~f:(memory_word_display ~previous:(float_of_int prev_top_heap_words)) + ) columns, + top_heap_words + in + rows_of_hierarchy_list ~nesting:0 make_row hierarchy measure_diff + initial_measure.top_heap_words + +let max_by_column ~n_columns rows = + let a = Array.make n_columns 0. in + let rec loop (R (_, values, rows)) = + List.iteri (fun i (v, _) -> a.(i) <- max a.(i) v) values; + List.iter loop rows + in + List.iter loop rows; + a + +let width_by_column ~n_columns ~display_cell rows = + let a = Array.make n_columns 1 in + let rec loop (R (_, values, rows)) = + List.iteri (fun i cell -> + let _, str = display_cell i cell ~width:0 in + a.(i) <- max a.(i) (String.length str) + ) values; + List.iter loop rows; + in + List.iter loop rows; + a + +let display_rows ppf rows = + let n_columns = + match rows with + | [] -> 0 + | R (_, values, _) :: _ -> List.length values + in + let maxs = max_by_column ~n_columns rows in + let display_cell i (_, c) ~width = + let display_cell = c.worth_displaying ~max:maxs.(i) in + display_cell, if display_cell + then c.to_string ~max:maxs.(i) ~width + else String.make width '-' + in + let widths = width_by_column ~n_columns ~display_cell rows in + let rec loop (R (name, values, rows)) ~indentation = + let worth_displaying, cell_strings = + values + |> List.mapi (fun i cell -> display_cell i cell ~width:widths.(i)) + |> List.split + in + if List.exists (fun b -> b) worth_displaying then + Format.fprintf ppf "%s%s %s@\n" + indentation (String.concat " " cell_strings) name; + List.iter (loop ~indentation:(" " ^ indentation)) rows; + in + List.iter (loop ~indentation:"") rows + +let print ppf columns = + match columns with + | [] -> () + | _ :: _ -> + let initial_measure = + match !initial_measure with + | Some v -> v + | None -> Measure.zero + in + let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in + display_rows ppf (rows_of_hierarchy !hierarchy total initial_measure columns) + +let column_mapping = [ + "time", `Time; + "alloc", `Alloc; + "top-heap", `Top_heap; + "absolute-top-heap", `Abs_top_heap; +] + +let column_names = List.map fst column_mapping + +let options_doc = + Printf.sprintf + " Print performance information for each pass\ + \n The columns are: %s." + (String.concat " " column_names) + +let all_columns = List.map snd column_mapping + +let generate = "generate" +let transl = "transl" +let typing = "typing" + +end +module Clflags : sig +#1 "clflags.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2005 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Command line flags *) + +(** Optimization parameters represented as ints indexed by round number. *) +module Int_arg_helper : sig + type parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:int -> parsed -> int +end + +(** Optimization parameters represented as floats indexed by round number. *) +module Float_arg_helper : sig + type parsed + + val parse : string -> string -> parsed ref -> unit + + type parse_result = + | Ok + | Parse_failed of exn + val parse_no_error : string -> parsed ref -> parse_result + + val get : key:int -> parsed -> float +end + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + inline_branch_factor : float option; + inline_max_depth : int option; + inline_max_unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +val classic_arguments : inlining_arguments +val o1_arguments : inlining_arguments +val o2_arguments : inlining_arguments +val o3_arguments : inlining_arguments + +(** Set all the inlining arguments for a round. + The default is set if no round is provided. *) +val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit + +val objfiles : string list ref +val ccobjs : string list ref +val dllibs : string list ref +val compile_only : bool ref +val output_name : string option ref +val include_dirs : string list ref +val no_std_include : bool ref +val print_types : bool ref +val make_archive : bool ref +val debug : bool ref +val fast : bool ref +val use_linscan : bool ref +val link_everything : bool ref +val custom_runtime : bool ref +val no_check_prims : bool ref +val bytecode_compatible_32 : bool ref +val output_c_object : bool ref +val output_complete_object : bool ref +val all_ccopts : string list ref +val classic : bool ref +val nopervasives : bool ref +val open_modules : string list ref +val preprocessor : string option ref +val all_ppx : string list ref +val annotations : bool ref +val binary_annotations : bool ref +val use_threads : bool ref +val use_vmthreads : bool ref +val noassert : bool ref +val verbose : bool ref +val noprompt : bool ref +val nopromptcont : bool ref +val init_file : string option ref +val noinit : bool ref +val noversion : bool ref +val use_prims : string ref +val use_runtime : string ref +val principal : bool ref +val real_paths : bool ref +val recursive_types : bool ref +val strict_sequence : bool ref +val strict_formats : bool ref +val applicative_functors : bool ref +val make_runtime : bool ref +val gprofile : bool ref +val c_compiler : string option ref +val no_auto_link : bool ref +val dllpaths : string list ref +val make_package : bool ref +val for_package : string option ref +val error_size : int ref +val float_const_prop : bool ref +val transparent_modules : bool ref +val dump_source : bool ref +val dump_parsetree : bool ref +val dump_typedtree : bool ref +val dump_rawlambda : bool ref +val dump_lambda : bool ref +val dump_rawclambda : bool ref +val dump_clambda : bool ref +val dump_rawflambda : bool ref +val dump_flambda : bool ref +val dump_flambda_let : int option ref +val dump_instr : bool ref +val keep_asm_file : bool ref +val optimize_for_speed : bool ref +val dump_cmm : bool ref +val dump_selection : bool ref +val dump_cse : bool ref +val dump_live : bool ref +val dump_avail : bool ref +val debug_runavail : bool ref +val dump_spill : bool ref +val dump_split : bool ref +val dump_interf : bool ref +val dump_prefer : bool ref +val dump_regalloc : bool ref +val dump_reload : bool ref +val dump_scheduling : bool ref +val dump_linear : bool ref +val dump_interval : bool ref +val keep_startup_file : bool ref +val dump_combine : bool ref +val native_code : bool ref +val default_inline_threshold : float +val inline_threshold : Float_arg_helper.parsed ref +val inlining_report : bool ref +val simplify_rounds : int option ref +val default_simplify_rounds : int ref +val rounds : unit -> int +val default_inline_max_unroll : int +val inline_max_unroll : Int_arg_helper.parsed ref +val default_inline_toplevel_threshold : int +val inline_toplevel_threshold : Int_arg_helper.parsed ref +val default_inline_call_cost : int +val default_inline_alloc_cost : int +val default_inline_prim_cost : int +val default_inline_branch_cost : int +val default_inline_indirect_cost : int +val default_inline_lifting_benefit : int +val inline_call_cost : Int_arg_helper.parsed ref +val inline_alloc_cost : Int_arg_helper.parsed ref +val inline_prim_cost : Int_arg_helper.parsed ref +val inline_branch_cost : Int_arg_helper.parsed ref +val inline_indirect_cost : Int_arg_helper.parsed ref +val inline_lifting_benefit : Int_arg_helper.parsed ref +val default_inline_branch_factor : float +val inline_branch_factor : Float_arg_helper.parsed ref +val dont_write_files : bool ref +val std_include_flag : string -> string +val std_include_dir : unit -> string list +val shared : bool ref +val dlcode : bool ref +val pic_code : bool ref +val runtime_variant : string ref +val force_slash : bool ref +val keep_docs : bool ref +val keep_locs : bool ref +val unsafe_string : bool ref +val opaque : bool ref +val profile_columns : Profile.column list ref +val flambda_invariant_checks : bool ref +val unbox_closures : bool ref +val unbox_closures_factor : int ref +val default_unbox_closures_factor : int +val unbox_free_vars_of_closures : bool ref +val unbox_specialised_args : bool ref +val clambda_checks : bool ref +val default_inline_max_depth : int +val inline_max_depth : Int_arg_helper.parsed ref +val remove_unused_arguments : bool ref +val dump_flambda_verbose : bool ref +val classic_inlining : bool ref +val afl_instrument : bool ref +val afl_inst_ratio : int ref + +val all_passes : string list ref +val dumped_pass : string -> bool +val set_dumped_pass : string -> bool -> unit + +val parse_color_setting : string -> Misc.Color.setting option +val color : Misc.Color.setting option ref + +val unboxed_types : bool ref + +val arg_spec : (string * Arg.spec * string) list ref + +(* [add_arguments __LOC__ args] will add the arguments from [args] at + the end of [arg_spec], checking that they have not already been + added by [add_arguments] before. A warning is printed showing the + locations of the function from which the argument was previously + added. *) +val add_arguments : string -> (string * Arg.spec * string) list -> unit + +(* [parse_arguments anon_arg usage] will parse the arguments, using + the arguments provided in [Clflags.arg_spec]. It allows plugins to + provide their own arguments. +*) +val parse_arguments : Arg.anon_fun -> string -> unit + +(* [print_arguments usage] print the standard usage message *) +val print_arguments : string -> unit + +(* [reset_arguments ()] clear all declared arguments *) +val reset_arguments : unit -> unit + + +type mli_status = Mli_na | Mli_exists | Mli_non_exists +val no_implicit_current_dir : bool ref +val assume_no_mli : mli_status ref +val record_event_when_debug : bool ref +val bs_vscode : bool +val dont_record_crc_unit : string option ref +val bs_only : bool ref (* set true on bs top*) +val bs_gentype : string option ref +val no_assert_false : bool ref + + +end = struct +#1 "clflags.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Command-line parameters *) + +module Int_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Int + let of_string = int_of_string + end +end) +module Float_arg_helper = Arg_helper.Make (struct + module Key = struct + include Numbers.Int + let of_string = int_of_string + end + + module Value = struct + include Numbers.Float + let of_string = float_of_string + end +end) + +let objfiles = ref ([] : string list) (* .cmo and .cma files *) +and ccobjs = ref ([] : string list) (* .o, .a, .so and -cclib -lxxx *) +and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *) + +let compile_only = ref false (* -c *) +and output_name = ref (None : string option) (* -o *) +and include_dirs = ref ([] : string list)(* -I *) +and no_std_include = ref false (* -nostdlib *) +and print_types = ref false (* -i *) +and make_archive = ref false (* -a *) +and debug = ref false (* -g *) +and fast = ref false (* -unsafe *) +and use_linscan = ref false (* -linscan *) +and link_everything = ref false (* -linkall *) +and custom_runtime = ref false (* -custom *) +and no_check_prims = ref false (* -no-check-prims *) +and bytecode_compatible_32 = ref false (* -compat-32 *) +and output_c_object = ref false (* -output-obj *) +and output_complete_object = ref false (* -output-complete-obj *) +and all_ccopts = ref ([] : string list) (* -ccopt *) +and classic = ref false (* -nolabels *) +and nopervasives = ref false (* -nopervasives *) +and preprocessor = ref(None : string option) (* -pp *) +and all_ppx = ref ([] : string list) (* -ppx *) +let annotations = ref false (* -annot *) +let binary_annotations = ref false (* -annot *) +and use_threads = ref false (* -thread *) +and use_vmthreads = ref false (* -vmthread *) +and noassert = ref false (* -noassert *) +and verbose = ref false (* -verbose *) +and noversion = ref false (* -no-version *) +and noprompt = ref false (* -noprompt *) +and nopromptcont = ref false (* -nopromptcont *) +and init_file = ref (None : string option) (* -init *) +and noinit = ref false (* -noinit *) +and open_modules = ref [] (* -open *) +and use_prims = ref "" (* -use-prims ... *) +and use_runtime = ref "" (* -use-runtime ... *) +and principal = ref false (* -principal *) +and real_paths = ref true (* -short-paths *) +and recursive_types = ref false (* -rectypes *) +and strict_sequence = ref false (* -strict-sequence *) +and strict_formats = ref false (* -strict-formats *) +and applicative_functors = ref true (* -no-app-funct *) +and make_runtime = ref false (* -make-runtime *) +and gprofile = ref false (* -p *) +and c_compiler = ref (None: string option) (* -cc *) +and no_auto_link = ref false (* -noautolink *) +and dllpaths = ref ([] : string list) (* -dllpath *) +and make_package = ref false (* -pack *) +and for_package = ref (None: string option) (* -for-pack *) +and error_size = ref 500 (* -error-size *) +and float_const_prop = ref true (* -no-float-const-prop *) +and transparent_modules = ref false (* -trans-mod *) +let dump_source = ref false (* -dsource *) +let dump_parsetree = ref false (* -dparsetree *) +and dump_typedtree = ref false (* -dtypedtree *) +and dump_rawlambda = ref false (* -drawlambda *) +and dump_lambda = ref false (* -dlambda *) +and dump_rawclambda = ref false (* -drawclambda *) +and dump_clambda = ref false (* -dclambda *) +and dump_rawflambda = ref false (* -drawflambda *) +and dump_flambda = ref false (* -dflambda *) +and dump_flambda_let = ref (None : int option) (* -dflambda-let=... *) +and dump_flambda_verbose = ref false (* -dflambda-verbose *) +and dump_instr = ref false (* -dinstr *) + +let keep_asm_file = ref false (* -S *) +let optimize_for_speed = ref true (* -compact *) +and opaque = ref false (* -opaque *) + +and dump_cmm = ref false (* -dcmm *) +let dump_selection = ref false (* -dsel *) +let dump_cse = ref false (* -dcse *) +let dump_live = ref false (* -dlive *) +let dump_avail = ref false (* -davail *) +let dump_spill = ref false (* -dspill *) +let dump_split = ref false (* -dsplit *) +let dump_interf = ref false (* -dinterf *) +let dump_prefer = ref false (* -dprefer *) +let dump_regalloc = ref false (* -dalloc *) +let dump_reload = ref false (* -dreload *) +let dump_scheduling = ref false (* -dscheduling *) +let dump_linear = ref false (* -dlinear *) +let dump_interval = ref false (* -dinterval *) +let keep_startup_file = ref false (* -dstartup *) +let dump_combine = ref false (* -dcombine *) +let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *) + +let debug_runavail = ref false (* -drunavail *) + +let native_code = ref false (* set to true under ocamlopt *) + +let force_slash = ref false (* for ocamldep *) +let clambda_checks = ref false (* -clambda-checks *) + +let flambda_invariant_checks = ref true (* -flambda-invariants *) + +let dont_write_files = ref false (* set to true under ocamldoc *) + +let std_include_flag prefix = + if !no_std_include then "" + else (prefix ^ (Filename.quote Config.standard_library)) +;; + +let std_include_dir () = + if !no_std_include then [] else [Config.standard_library] +;; + +let shared = ref false (* -shared *) +let dlcode = ref true (* not -nodynlink *) + +let pic_code = ref (match Config.architecture with (* -fPIC *) + | "amd64" -> true + | _ -> false) + +let runtime_variant = ref "";; (* -runtime-variant *) + +let keep_docs = ref false (* -keep-docs *) +let keep_locs = ref true (* -keep-locs *) +let unsafe_string = + if Config.safe_string then ref false + else ref (not Config.default_safe_string) + (* -safe-string / -unsafe-string *) + +let classic_inlining = ref false (* -Oclassic *) +let inlining_report = ref false (* -inlining-report *) + +let afl_instrument = ref Config.afl_instrument (* -afl-instrument *) +let afl_inst_ratio = ref 100 (* -afl-inst-ratio *) + +let simplify_rounds = ref None (* -rounds *) +let default_simplify_rounds = ref 1 (* -rounds *) +let rounds () = + match !simplify_rounds with + | None -> !default_simplify_rounds + | Some r -> r + +let default_inline_threshold = if Config.flambda then 10. else 10. /. 8. +let inline_toplevel_multiplier = 16 +let default_inline_toplevel_threshold = + int_of_float ((float inline_toplevel_multiplier) *. default_inline_threshold) +let default_inline_call_cost = 5 +let default_inline_alloc_cost = 7 +let default_inline_prim_cost = 3 +let default_inline_branch_cost = 5 +let default_inline_indirect_cost = 4 +let default_inline_branch_factor = 0.1 +let default_inline_lifting_benefit = 1300 +let default_inline_max_unroll = 0 +let default_inline_max_depth = 1 + +let inline_threshold = ref (Float_arg_helper.default default_inline_threshold) +let inline_toplevel_threshold = + ref (Int_arg_helper.default default_inline_toplevel_threshold) +let inline_call_cost = ref (Int_arg_helper.default default_inline_call_cost) +let inline_alloc_cost = ref (Int_arg_helper.default default_inline_alloc_cost) +let inline_prim_cost = ref (Int_arg_helper.default default_inline_prim_cost) +let inline_branch_cost = + ref (Int_arg_helper.default default_inline_branch_cost) +let inline_indirect_cost = + ref (Int_arg_helper.default default_inline_indirect_cost) +let inline_branch_factor = + ref (Float_arg_helper.default default_inline_branch_factor) +let inline_lifting_benefit = + ref (Int_arg_helper.default default_inline_lifting_benefit) +let inline_max_unroll = + ref (Int_arg_helper.default default_inline_max_unroll) +let inline_max_depth = + ref (Int_arg_helper.default default_inline_max_depth) + + +let unbox_specialised_args = ref true (* -no-unbox-specialised-args *) +let unbox_free_vars_of_closures = ref true +let unbox_closures = ref false (* -unbox-closures *) +let default_unbox_closures_factor = 10 +let unbox_closures_factor = + ref default_unbox_closures_factor (* -unbox-closures-factor *) +let remove_unused_arguments = ref false (* -remove-unused-arguments *) + +type inlining_arguments = { + inline_call_cost : int option; + inline_alloc_cost : int option; + inline_prim_cost : int option; + inline_branch_cost : int option; + inline_indirect_cost : int option; + inline_lifting_benefit : int option; + inline_branch_factor : float option; + inline_max_depth : int option; + inline_max_unroll : int option; + inline_threshold : float option; + inline_toplevel_threshold : int option; +} + +let set_int_arg round (arg:Int_arg_helper.parsed ref) default value = + let value : int = + match value with + | None -> default + | Some value -> value + in + match round with + | None -> + arg := Int_arg_helper.set_base_default value + (Int_arg_helper.reset_base_overrides !arg) + | Some round -> + arg := Int_arg_helper.add_base_override round value !arg + +let set_float_arg round (arg:Float_arg_helper.parsed ref) default value = + let value = + match value with + | None -> default + | Some value -> value + in + match round with + | None -> + arg := Float_arg_helper.set_base_default value + (Float_arg_helper.reset_base_overrides !arg) + | Some round -> + arg := Float_arg_helper.add_base_override round value !arg + +let use_inlining_arguments_set ?round (arg:inlining_arguments) = + let set_int = set_int_arg round in + let set_float = set_float_arg round in + set_int inline_call_cost default_inline_call_cost arg.inline_call_cost; + set_int inline_alloc_cost default_inline_alloc_cost arg.inline_alloc_cost; + set_int inline_prim_cost default_inline_prim_cost arg.inline_prim_cost; + set_int inline_branch_cost + default_inline_branch_cost arg.inline_branch_cost; + set_int inline_indirect_cost + default_inline_indirect_cost arg.inline_indirect_cost; + set_int inline_lifting_benefit + default_inline_lifting_benefit arg.inline_lifting_benefit; + set_float inline_branch_factor + default_inline_branch_factor arg.inline_branch_factor; + set_int inline_max_depth + default_inline_max_depth arg.inline_max_depth; + set_int inline_max_unroll + default_inline_max_unroll arg.inline_max_unroll; + set_float inline_threshold + default_inline_threshold arg.inline_threshold; + set_int inline_toplevel_threshold + default_inline_toplevel_threshold arg.inline_toplevel_threshold + +(* o1 is the default *) +let o1_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = None; + inline_max_unroll = None; + inline_threshold = None; + inline_toplevel_threshold = None; +} + +let classic_arguments = { + inline_call_cost = None; + inline_alloc_cost = None; + inline_prim_cost = None; + inline_branch_cost = None; + inline_indirect_cost = None; + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = None; + inline_max_unroll = None; + (* [inline_threshold] matches the current compiler's default. + Note that this particular fraction can be expressed exactly in + floating point. *) + inline_threshold = Some (10. /. 8.); + (* [inline_toplevel_threshold] is not used in classic mode. *) + inline_toplevel_threshold = Some 1; +} + +let o2_arguments = { + inline_call_cost = Some (2 * default_inline_call_cost); + inline_alloc_cost = Some (2 * default_inline_alloc_cost); + inline_prim_cost = Some (2 * default_inline_prim_cost); + inline_branch_cost = Some (2 * default_inline_branch_cost); + inline_indirect_cost = Some (2 * default_inline_indirect_cost); + inline_lifting_benefit = None; + inline_branch_factor = None; + inline_max_depth = Some 2; + inline_max_unroll = None; + inline_threshold = Some 25.; + inline_toplevel_threshold = Some (25 * inline_toplevel_multiplier); +} + +let o3_arguments = { + inline_call_cost = Some (3 * default_inline_call_cost); + inline_alloc_cost = Some (3 * default_inline_alloc_cost); + inline_prim_cost = Some (3 * default_inline_prim_cost); + inline_branch_cost = Some (3 * default_inline_branch_cost); + inline_indirect_cost = Some (3 * default_inline_indirect_cost); + inline_lifting_benefit = None; + inline_branch_factor = Some 0.; + inline_max_depth = Some 3; + inline_max_unroll = Some 1; + inline_threshold = Some 50.; + inline_toplevel_threshold = Some (50 * inline_toplevel_multiplier); +} + +let all_passes = ref [] +let dumped_passes_list = ref [] +let dumped_pass s = + assert(List.mem s !all_passes); + List.mem s !dumped_passes_list + +let set_dumped_pass s enabled = + if (List.mem s !all_passes) then begin + let passes_without_s = List.filter ((<>) s) !dumped_passes_list in + let dumped_passes = + if enabled then + s :: passes_without_s + else + passes_without_s + in + dumped_passes_list := dumped_passes + end + +let parse_color_setting = function + | "auto" -> Some Misc.Color.Auto + | "always" -> Some Misc.Color.Always + | "never" -> Some Misc.Color.Never + | _ -> None +let color = ref None ;; (* -color *) + +let unboxed_types = ref false + +let arg_spec = ref [] +let arg_names = ref Misc.StringMap.empty + +let reset_arguments () = + arg_spec := []; + arg_names := Misc.StringMap.empty + +let add_arguments loc args = + List.iter (function (arg_name, _, _) as arg -> + try + let loc2 = Misc.StringMap.find arg_name !arg_names in + Printf.eprintf + "Warning: plugin argument %s is already defined:\n" arg_name; + Printf.eprintf " First definition: %s\n" loc2; + Printf.eprintf " New definition: %s\n" loc; + with Not_found -> + arg_spec := !arg_spec @ [ arg ]; + arg_names := Misc.StringMap.add arg_name loc !arg_names + ) args + +let print_arguments usage = + Arg.usage !arg_spec usage + +(* This function is almost the same as [Arg.parse_expand], except + that [Arg.parse_expand] could not be used because it does not take a + reference for [arg_spec].*) +let parse_arguments f msg = + try + let argv = ref Sys.argv in + let current = ref (!Arg.current) in + Arg.parse_and_expand_argv_dynamic current argv arg_spec f msg + with + | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2 + | Arg.Help msg -> Printf.printf "%s" msg; exit 0 + + +type mli_status = Mli_na | Mli_exists | Mli_non_exists +let no_implicit_current_dir = ref false +let assume_no_mli = ref Mli_na +let record_event_when_debug = ref true (* turned off in BuckleScript*) +let bs_vscode = + try ignore @@ Sys.getenv "BS_VSCODE" ; true with _ -> false + (* We get it from environment variable mostly due to + we don't want to rebuild when flip on or off + *) +let dont_record_crc_unit : string option ref = ref None +let bs_only = ref false +let bs_gentype = ref None +let no_assert_false = ref false + + +end +module Terminfo : sig +#1 "terminfo.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Basic interface to the terminfo database *) + +type status = + | Uninitialised + | Bad_term + | Good_term of int (* number of lines of the terminal *) +;; +external setup : out_channel -> status = "caml_terminfo_setup";; +external backup : int -> unit = "caml_terminfo_backup";; +external standout : bool -> unit = "caml_terminfo_standout";; +external resume : int -> unit = "caml_terminfo_resume";; + +end = struct +#1 "terminfo.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Basic interface to the terminfo database *) + +type status = + | Uninitialised + | Bad_term + | Good_term of int +;; +external setup : out_channel -> status = "caml_terminfo_setup";; +external backup : int -> unit = "caml_terminfo_backup";; +external standout : bool -> unit = "caml_terminfo_standout";; +external resume : int -> unit = "caml_terminfo_resume";; + +end +module Warnings : sig +#1 "warnings.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) +(* *) +(* Copyright 1998 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +type t = + | Comment_start (* 1 *) + | Comment_not_end (* 2 *) + | Deprecated of string * loc * loc (* 3 *) + | Fragile_match of string (* 4 *) + | Partial_application (* 5 *) + | Labels_omitted of string list (* 6 *) + | Method_override of string list (* 7 *) + | Partial_match of string (* 8 *) + | Non_closed_record_pattern of string (* 9 *) + | Statement_type (* 10 *) + | Unused_match (* 11 *) + | Unused_pat (* 12 *) + | Instance_variable_override of string list (* 13 *) + | Illegal_backslash (* 14 *) + | Implicit_public_methods of string list (* 15 *) + | Unerasable_optional_argument (* 16 *) + | Undeclared_virtual_method of string (* 17 *) + | Not_principal of string (* 18 *) + | Without_principality of string (* 19 *) + | Unused_argument (* 20 *) + | Nonreturning_statement (* 21 *) + | Preprocessor of string (* 22 *) + | Useless_record_with (* 23 *) + | Bad_module_name of string (* 24 *) + | All_clauses_guarded (* 8, used to be 25 *) + | Unused_var of string (* 26 *) + | Unused_var_strict of string (* 27 *) + | Wildcard_arg_to_constant_constr (* 28 *) + | Eol_in_string (* 29 *) + | Duplicate_definitions of string * string * string * string (* 30 *) + | Multiple_definition of string * string * string (* 31 *) + | Unused_value_declaration of string (* 32 *) + | Unused_open of string (* 33 *) + | Unused_type_declaration of string (* 34 *) + | Unused_for_index of string (* 35 *) + | Unused_ancestor of string (* 36 *) + | Unused_constructor of string * bool * bool (* 37 *) + | Unused_extension of string * bool * bool * bool (* 38 *) + | Unused_rec_flag (* 39 *) + | Name_out_of_scope of string * string list * bool (* 40 *) + | Ambiguous_name of string list * string list * bool (* 41 *) + | Disambiguated_name of string (* 42 *) + | Nonoptional_label of string (* 43 *) + | Open_shadow_identifier of string * string (* 44 *) + | Open_shadow_label_constructor of string * string (* 45 *) + | Bad_env_variable of string * string (* 46 *) + | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) + | No_cmi_file of string * string option (* 49 *) + | Bad_docstring of bool (* 50 *) + | Expect_tailcall (* 51 *) + | Fragile_literal_pattern (* 52 *) + | Misplaced_attribute of string (* 53 *) + | Duplicated_attribute of string (* 54 *) + | Inlining_impossible of string (* 55 *) + | Unreachable_case (* 56 *) + | Ambiguous_pattern of string list (* 57 *) + | No_cmx_file of string (* 58 *) + | Assignment_to_non_mutable_value (* 59 *) + | Unused_module of string (* 60 *) + | Unboxable_type_in_prim_decl of string (* 61 *) + | Constraint_on_gadt (* 62 *) + + | Bs_unused_attribute of string (* 101 *) + | Bs_polymorphic_comparison (* 102 *) + | Bs_ffi_warning of string (* 103 *) + | Bs_derive_warning of string (* 104 *) + +;; + +val parse_options : bool -> string -> unit;; + +val without_warnings : (unit -> 'a) -> 'a + +val is_active : t -> bool;; +val is_error : t -> bool;; + +val defaults_w : string;; +val defaults_warn_error : string;; + +type reporting_information = + { number : int + ; message : string + ; is_error : bool + ; sub_locs : (loc * string) list; + } + +val report : t -> [ `Active of reporting_information | `Inactive ] + +exception Errors;; + +val check_fatal : unit -> unit;; +val reset_fatal: unit -> unit + +val help_warnings: unit -> unit + +type state +val backup: unit -> state +val restore: state -> unit +val mk_lazy: (unit -> 'a) -> 'a Lazy.t + (** Like [Lazy.of_fun], but the function is applied with + the warning settings at the time [mk_lazy] is called. *) + + +val message : t -> string +val number: t -> int +val super_report : + (t -> string) -> + t -> [ `Active of reporting_information | `Inactive ] + + +end = struct +#1 "warnings.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) +(* *) +(* Copyright 1998 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* When you change this, you need to update the documentation: + - man/ocamlc.m + - man/ocamlopt.m + - manual/manual/cmds/comp.etex + - manual/manual/cmds/native.etex +*) + +type loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +type t = + | Comment_start (* 1 *) + | Comment_not_end (* 2 *) + | Deprecated of string * loc * loc (* 3 *) + | Fragile_match of string (* 4 *) + | Partial_application (* 5 *) + | Labels_omitted of string list (* 6 *) + | Method_override of string list (* 7 *) + | Partial_match of string (* 8 *) + | Non_closed_record_pattern of string (* 9 *) + | Statement_type (* 10 *) + | Unused_match (* 11 *) + | Unused_pat (* 12 *) + | Instance_variable_override of string list (* 13 *) + | Illegal_backslash (* 14 *) + | Implicit_public_methods of string list (* 15 *) + | Unerasable_optional_argument (* 16 *) + | Undeclared_virtual_method of string (* 17 *) + | Not_principal of string (* 18 *) + | Without_principality of string (* 19 *) + | Unused_argument (* 20 *) + | Nonreturning_statement (* 21 *) + | Preprocessor of string (* 22 *) + | Useless_record_with (* 23 *) + | Bad_module_name of string (* 24 *) + | All_clauses_guarded (* 8, used to be 25 *) + | Unused_var of string (* 26 *) + | Unused_var_strict of string (* 27 *) + | Wildcard_arg_to_constant_constr (* 28 *) + | Eol_in_string (* 29 *) + | Duplicate_definitions of string * string * string * string (*30 *) + | Multiple_definition of string * string * string (* 31 *) + | Unused_value_declaration of string (* 32 *) + | Unused_open of string (* 33 *) + | Unused_type_declaration of string (* 34 *) + | Unused_for_index of string (* 35 *) + | Unused_ancestor of string (* 36 *) + | Unused_constructor of string * bool * bool (* 37 *) + | Unused_extension of string * bool * bool * bool (* 38 *) + | Unused_rec_flag (* 39 *) + | Name_out_of_scope of string * string list * bool (* 40 *) + | Ambiguous_name of string list * string list * bool (* 41 *) + | Disambiguated_name of string (* 42 *) + | Nonoptional_label of string (* 43 *) + | Open_shadow_identifier of string * string (* 44 *) + | Open_shadow_label_constructor of string * string (* 45 *) + | Bad_env_variable of string * string (* 46 *) + | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) + | No_cmi_file of string * string option (* 49 *) + | Bad_docstring of bool (* 50 *) + | Expect_tailcall (* 51 *) + | Fragile_literal_pattern (* 52 *) + | Misplaced_attribute of string (* 53 *) + | Duplicated_attribute of string (* 54 *) + | Inlining_impossible of string (* 55 *) + | Unreachable_case (* 56 *) + | Ambiguous_pattern of string list (* 57 *) + | No_cmx_file of string (* 58 *) + | Assignment_to_non_mutable_value (* 59 *) + | Unused_module of string (* 60 *) + | Unboxable_type_in_prim_decl of string (* 61 *) + | Constraint_on_gadt (* 62 *) + + + | Bs_unused_attribute of string (* 101 *) + | Bs_polymorphic_comparison (* 102 *) + | Bs_ffi_warning of string (* 103 *) + | Bs_derive_warning of string (* 104 *) + +;; + +(* If you remove a warning, leave a hole in the numbering. NEVER change + the numbers of existing warnings. + If you add a new warning, add it at the end with a new number; + do NOT reuse one of the holes. +*) + +let number = function + | Comment_start -> 1 + | Comment_not_end -> 2 + | Deprecated _ -> 3 + | Fragile_match _ -> 4 + | Partial_application -> 5 + | Labels_omitted _ -> 6 + | Method_override _ -> 7 + | Partial_match _ -> 8 + | Non_closed_record_pattern _ -> 9 + | Statement_type -> 10 + | Unused_match -> 11 + | Unused_pat -> 12 + | Instance_variable_override _ -> 13 + | Illegal_backslash -> 14 + | Implicit_public_methods _ -> 15 + | Unerasable_optional_argument -> 16 + | Undeclared_virtual_method _ -> 17 + | Not_principal _ -> 18 + | Without_principality _ -> 19 + | Unused_argument -> 20 + | Nonreturning_statement -> 21 + | Preprocessor _ -> 22 + | Useless_record_with -> 23 + | Bad_module_name _ -> 24 + | All_clauses_guarded -> 8 (* used to be 25 *) + | Unused_var _ -> 26 + | Unused_var_strict _ -> 27 + | Wildcard_arg_to_constant_constr -> 28 + | Eol_in_string -> 29 + | Duplicate_definitions _ -> 30 + | Multiple_definition _ -> 31 + | Unused_value_declaration _ -> 32 + | Unused_open _ -> 33 + | Unused_type_declaration _ -> 34 + | Unused_for_index _ -> 35 + | Unused_ancestor _ -> 36 + | Unused_constructor _ -> 37 + | Unused_extension _ -> 38 + | Unused_rec_flag -> 39 + | Name_out_of_scope _ -> 40 + | Ambiguous_name _ -> 41 + | Disambiguated_name _ -> 42 + | Nonoptional_label _ -> 43 + | Open_shadow_identifier _ -> 44 + | Open_shadow_label_constructor _ -> 45 + | Bad_env_variable _ -> 46 + | Attribute_payload _ -> 47 + | Eliminated_optional_arguments _ -> 48 + | No_cmi_file _ -> 49 + | Bad_docstring _ -> 50 + | Expect_tailcall -> 51 + | Fragile_literal_pattern -> 52 + | Misplaced_attribute _ -> 53 + | Duplicated_attribute _ -> 54 + | Inlining_impossible _ -> 55 + | Unreachable_case -> 56 + | Ambiguous_pattern _ -> 57 + | No_cmx_file _ -> 58 + | Assignment_to_non_mutable_value -> 59 + | Unused_module _ -> 60 + | Unboxable_type_in_prim_decl _ -> 61 + | Constraint_on_gadt -> 62 + + + | Bs_unused_attribute _ -> 101 + | Bs_polymorphic_comparison -> 102 + | Bs_ffi_warning _ -> 103 + | Bs_derive_warning _ -> 104 + +;; + +let last_warning_number = 104 +;; + +let letter_all = + let rec loop i = if i = 0 then [] else i :: loop (i - 1) in + loop last_warning_number + +(* Must be the max number returned by the [number] function. *) + +let letter = function + | 'a' -> letter_all + | 'b' -> [] + | 'c' -> [1; 2] + | 'd' -> [3] + | 'e' -> [4] + | 'f' -> [5] + | 'g' -> [] + | 'h' -> [] + | 'i' -> [] + | 'j' -> [] + | 'k' -> [32; 33; 34; 35; 36; 37; 38; 39] + | 'l' -> [6] + | 'm' -> [7] + | 'n' -> [] + | 'o' -> [] + | 'p' -> [8] + | 'q' -> [] + | 'r' -> [9] + | 's' -> [10] + | 't' -> [] + | 'u' -> [11; 12] + | 'v' -> [13] + | 'w' -> [] + | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 30] + | 'y' -> [26] + | 'z' -> [27] + | _ -> assert false +;; + +type state = + { + active: bool array; + error: bool array; + } + +let current = + ref + { + active = Array.make (last_warning_number + 1) true; + error = Array.make (last_warning_number + 1) false; + } + +let disabled = ref false + +let without_warnings f = + Misc.protect_refs [Misc.R(disabled, true)] f + +let backup () = !current + +let restore x = current := x + +let is_active x = not !disabled && (!current).active.(number x);; +let is_error x = not !disabled && (!current).error.(number x);; + +let mk_lazy f = + let state = backup () in + lazy + ( + let prev = backup () in + restore state; + try + let r = f () in + restore prev; + r + with exn -> + restore prev; + raise exn + ) + +let parse_opt error active flags s = + let set i = flags.(i) <- true in + let clear i = flags.(i) <- false in + let set_all i = active.(i) <- true; error.(i) <- true in + let error () = raise (Arg.Bad "Ill-formed list of warnings") in + let rec get_num n i = + if i >= String.length s then i, n + else match s.[i] with + | '0'..'9' -> get_num (10 * n + Char.code s.[i] - Char.code '0') (i + 1) + | _ -> i, n + in + let get_range i = + let i, n1 = get_num 0 i in + if i + 2 < String.length s && s.[i] = '.' && s.[i + 1] = '.' then + let i, n2 = get_num 0 (i + 2) in + if n2 < n1 then error (); + i, n1, n2 + else + i, n1, n1 + in + let rec loop i = + if i >= String.length s then () else + match s.[i] with + | 'A' .. 'Z' -> + List.iter set (letter (Char.lowercase_ascii s.[i])); + loop (i+1) + | 'a' .. 'z' -> + List.iter clear (letter s.[i]); + loop (i+1) + | '+' -> loop_letter_num set (i+1) + | '-' -> loop_letter_num clear (i+1) + | '@' -> loop_letter_num set_all (i+1) + | _ -> error () + and loop_letter_num myset i = + if i >= String.length s then error () else + match s.[i] with + | '0' .. '9' -> + let i, n1, n2 = get_range i in + for n = n1 to min n2 last_warning_number do myset n done; + loop i + | 'A' .. 'Z' -> + List.iter myset (letter (Char.lowercase_ascii s.[i])); + loop (i+1) + | 'a' .. 'z' -> + List.iter myset (letter s.[i]); + loop (i+1) + | _ -> error () + in + loop 0 +;; + +let parse_options errflag s = + let error = Array.copy (!current).error in + let active = Array.copy (!current).active in + parse_opt error active (if errflag then error else active) s; + current := {error; active} + +(* If you change these, don't forget to change them in man/ocamlc.m *) +let defaults_w = "+a-4-6-7-9-27-29-32..42-44-45-48-50-60-102";; +let defaults_warn_error = "-a+31";; + +let () = parse_options false defaults_w;; +let () = parse_options true defaults_warn_error;; + +let message = function + | Comment_start -> "this is the start of a comment." + | Comment_not_end -> "this is not the end of a comment." + | Deprecated (s, _, _) -> + (* Reduce \r\n to \n: + - Prevents any \r characters being printed on Unix when processing + Windows sources + - Prevents \r\r\n being generated on Windows, which affects the + testsuite + *) + "deprecated: " ^ Misc.normalise_eol s + | Fragile_match "" -> + "this pattern-matching is fragile." + | Fragile_match s -> + "this pattern-matching is fragile.\n\ + It will remain exhaustive when constructors are added to type " ^ s ^ "." + | Partial_application -> + "this function application is partial,\n\ + maybe some arguments are missing." + | Labels_omitted [] -> assert false + | Labels_omitted [l] -> + "label " ^ l ^ " was omitted in the application of this function." + | Labels_omitted ls -> + "labels " ^ String.concat ", " ls ^ + " were omitted in the application of this function." + | Method_override [lab] -> + "the method " ^ lab ^ " is overridden." + | Method_override (cname :: slist) -> + String.concat " " + ("the following methods are overridden by the class" + :: cname :: ":\n " :: slist) + | Method_override [] -> assert false + | Partial_match "" -> "this pattern-matching is not exhaustive." + | Partial_match s -> + "this pattern-matching is not exhaustive.\n\ + Here is an example of a case that is not matched:\n" ^ s + | Non_closed_record_pattern s -> + "the following labels are not bound in this record pattern:\n" ^ s ^ + "\nEither bind these labels explicitly or add '; _' to the pattern." + | Statement_type -> + "this expression should have type unit." + | Unused_match -> "this match case is unused." + | Unused_pat -> "this sub-pattern is unused." + | Instance_variable_override [lab] -> + "the instance variable " ^ lab ^ " is overridden.\n" ^ + "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" + | Instance_variable_override (cname :: slist) -> + String.concat " " + ("the following instance variables are overridden by the class" + :: cname :: ":\n " :: slist) ^ + "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" + | Instance_variable_override [] -> assert false + | Illegal_backslash -> "illegal backslash escape in string." + | Implicit_public_methods l -> + "the following private methods were made public implicitly:\n " + ^ String.concat " " l ^ "." + | Unerasable_optional_argument -> "this optional argument cannot be erased." + | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared." + | Not_principal s -> s^" is not principal." + | Without_principality s -> s^" without principality." + | Unused_argument -> "this argument will not be used by the function." + | Nonreturning_statement -> + "this statement never returns (or has an unsound type.)" + | Preprocessor s -> s + | Useless_record_with -> + "all the fields are explicitly listed in this record:\n\ + the 'with' clause is useless." + | Bad_module_name (modname) -> + "bad source file name: \"" ^ modname ^ "\" is not a valid module name." + | All_clauses_guarded -> + "this pattern-matching is not exhaustive.\n\ + All clauses in this pattern-matching are guarded." + | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "." + | Wildcard_arg_to_constant_constr -> + "wildcard pattern given as argument to a constant constructor" + | Eol_in_string -> + "unescaped end-of-line in a string constant (non-portable code)" + | Duplicate_definitions (kind, cname, tc1, tc2) -> + Printf.sprintf "the %s %s is defined in both types %s and %s." + kind cname tc1 tc2 + | Multiple_definition(modname, file1, file2) -> + Printf.sprintf + "files %s and %s both define a module named %s" + file1 file2 modname + | Unused_value_declaration v -> "unused value " ^ v ^ "." + | Unused_open s -> "unused open " ^ s ^ "." + | Unused_type_declaration s -> "unused type " ^ s ^ "." + | Unused_for_index s -> "unused for-loop index " ^ s ^ "." + | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "." + | Unused_constructor (s, false, false) -> "unused constructor " ^ s ^ "." + | Unused_constructor (s, true, _) -> + "constructor " ^ s ^ + " is never used to build values.\n\ + (However, this constructor appears in patterns.)" + | Unused_constructor (s, false, true) -> + "constructor " ^ s ^ + " is never used to build values.\n\ + Its type is exported as a private type." + | Unused_extension (s, is_exception, cu_pattern, cu_privatize) -> + let kind = + if is_exception then "exception" else "extension constructor" in + let name = kind ^ " " ^ s in + begin match cu_pattern, cu_privatize with + | false, false -> "unused " ^ name + | true, _ -> + name ^ + " is never used to build values.\n\ + (However, this constructor appears in patterns.)" + | false, true -> + name ^ + " is never used to build values.\n\ + It is exported or rebound as a private extension." + end + | Unused_rec_flag -> + "unused rec flag." + | Name_out_of_scope (ty, [nm], false) -> + nm ^ " was selected from type " ^ ty ^ + ".\nIt is not visible in the current scope, and will not \n\ + be selected if the type becomes unknown." + | Name_out_of_scope (_, _, false) -> assert false + | Name_out_of_scope (ty, slist, true) -> + "this record of type "^ ty ^" contains fields that are \n\ + not visible in the current scope: " + ^ String.concat " " slist ^ ".\n\ + They will not be selected if the type becomes unknown." + | Ambiguous_name ([s], tl, false) -> + s ^ " belongs to several types: " ^ String.concat " " tl ^ + "\nThe first one was selected. Please disambiguate if this is wrong." + | Ambiguous_name (_, _, false) -> assert false + | Ambiguous_name (_slist, tl, true) -> + "these field labels belong to several types: " ^ + String.concat " " tl ^ + "\nThe first one was selected. Please disambiguate if this is wrong." + | Disambiguated_name s -> + "this use of " ^ s ^ " relies on type-directed disambiguation,\n\ + it will not compile with OCaml 4.00 or earlier." + | Nonoptional_label s -> + "the label " ^ s ^ " is not optional." + | Open_shadow_identifier (kind, s) -> + Printf.sprintf + "this open statement shadows the %s identifier %s (which is later used)" + kind s + | Open_shadow_label_constructor (kind, s) -> + Printf.sprintf + "this open statement shadows the %s %s (which is later used)" + kind s + | Bad_env_variable (var, s) -> + Printf.sprintf "illegal environment variable %s : %s" var s + | Attribute_payload (a, s) -> + Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s + | Eliminated_optional_arguments sl -> + Printf.sprintf "implicit elimination of optional argument%s %s" + (if List.length sl = 1 then "" else "s") + (String.concat ", " sl) + | No_cmi_file(name, None) -> + "no cmi file was found in path for module " ^ name + | No_cmi_file(name, Some msg) -> + Printf.sprintf + "no valid cmi file was found in path for module %s. %s" + name msg + | Bad_docstring unattached -> + if unattached then "unattached documentation comment (ignored)" + else "ambiguous documentation comment" + | Expect_tailcall -> + Printf.sprintf "expected tailcall" + | Fragile_literal_pattern -> + Printf.sprintf + "Code should not depend on the actual values of\n\ + this constructor's arguments. They are only for information\n\ + and may change in future versions. (See manual section 8.5)" + | Unreachable_case -> + "this match case is unreachable.\n\ + Consider replacing it with a refutation case ' -> .'" + | Misplaced_attribute attr_name -> + Printf.sprintf "the %S attribute cannot appear in this context" attr_name + | Duplicated_attribute attr_name -> + Printf.sprintf "the %S attribute is used more than once on this \ + expression" + attr_name + | Inlining_impossible reason -> + Printf.sprintf "Cannot inline: %s" reason + | Ambiguous_pattern vars -> + let msg = + let vars = List.sort String.compare vars in + match vars with + | [] -> assert false + | [x] -> "variable " ^ x + | _::_ -> + "variables " ^ String.concat "," vars in + Printf.sprintf + "Ambiguous or-pattern variables under guard;\n\ + %s may match different arguments. (See manual section 8.5)" + msg + | No_cmx_file name -> + Printf.sprintf + "no cmx file was found in path for module %s, \ + and its interface was not compiled with -opaque" name + | Assignment_to_non_mutable_value -> + "A potential assignment to a non-mutable value was detected \n\ + in this source file. Such assignments may generate incorrect code \n\ + when using Flambda." + | Unused_module s -> "unused module " ^ s ^ "." + | Unboxable_type_in_prim_decl t -> + Printf.sprintf + "This primitive declaration uses type %s, which is unannotated and\n\ + unboxable. The representation of such types may change in future\n\ + versions. You should annotate the declaration of %s with [@@boxed]\n\ + or [@@unboxed]." t t + | Constraint_on_gadt -> + "Type constraints do not apply to GADT cases of variant types." + + + | Bs_unused_attribute s -> + "Unused BuckleScript attribute: " ^ s + | Bs_polymorphic_comparison -> + "polymorphic comparison introduced (maybe unsafe)" + | Bs_ffi_warning s -> + "BuckleScript FFI warning: " ^ s + | Bs_derive_warning s -> + "BuckleScript bs.deriving warning: " ^ s + +;; + +let sub_locs = function + | Deprecated (_, def, use) -> + [ + def, "Definition"; + use, "Expected signature"; + ] + | _ -> [] + +let nerrors = ref 0;; + +type reporting_information = + { number : int + ; message : string + ; is_error : bool + ; sub_locs : (loc * string) list; + } + +let report w = + match is_active w with + | false -> `Inactive + | true -> + if is_error w then incr nerrors; + `Active { number = number w; message = message w; is_error = is_error w; + sub_locs = sub_locs w; + } +;; + + +let super_report message w = + match is_active w with + | false -> `Inactive + | true -> + if is_error w then incr nerrors; + `Active { number = number w; message = message w; is_error = is_error w; + sub_locs = sub_locs w; + } +;; + +exception Errors;; + +let reset_fatal () = + nerrors := 0 + +let check_fatal () = + if !nerrors > 0 then begin + nerrors := 0; + raise Errors; + end; +;; + +let descriptions = + [ + 1, "Suspicious-looking start-of-comment mark."; + 2, "Suspicious-looking end-of-comment mark."; + 3, "Deprecated feature."; + 4, "Fragile pattern matching: matching that will remain complete even\n\ + \ if additional constructors are added to one of the variant types\n\ + \ matched."; + 5, "Partially applied function: expression whose result has function\n\ + \ type and is ignored."; + 6, "Label omitted in function application."; + 7, "Method overridden."; + 8, "Partial match: missing cases in pattern-matching."; + 9, "Missing fields in a record pattern."; + 10, "Expression on the left-hand side of a sequence that doesn't have \ + type\n\ + \ \"unit\" (and that is not a function, see warning number 5)."; + 11, "Redundant case in a pattern matching (unused match case)."; + 12, "Redundant sub-pattern in a pattern-matching."; + 13, "Instance variable overridden."; + 14, "Illegal backslash escape in a string constant."; + 15, "Private method made public implicitly."; + 16, "Unerasable optional argument."; + 17, "Undeclared virtual method."; + 18, "Non-principal type."; + 19, "Type without principality."; + 20, "Unused function argument."; + 21, "Non-returning statement."; + 22, "Preprocessor warning."; + 23, "Useless record \"with\" clause."; + 24, "Bad module name: the source file name is not a valid OCaml module \ + name."; + 25, "Deprecated: now part of warning 8."; + 26, "Suspicious unused variable: unused variable that is bound\n\ + \ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\ + \ character."; + 27, "Innocuous unused variable: unused variable that is not bound with\n\ + \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\ + \ character."; + 28, "Wildcard pattern given as argument to a constant constructor."; + 29, "Unescaped end-of-line in a string constant (non-portable code)."; + 30, "Two labels or constructors of the same name are defined in two\n\ + \ mutually recursive types."; + 31, "A module is linked twice in the same executable."; + 32, "Unused value declaration."; + 33, "Unused open statement."; + 34, "Unused type declaration."; + 35, "Unused for-loop index."; + 36, "Unused ancestor variable."; + 37, "Unused constructor."; + 38, "Unused extension constructor."; + 39, "Unused rec flag."; + 40, "Constructor or label name used out of scope."; + 41, "Ambiguous constructor or label name."; + 42, "Disambiguated constructor or label name (compatibility warning)."; + 43, "Nonoptional label applied as optional."; + 44, "Open statement shadows an already defined identifier."; + 45, "Open statement shadows an already defined label or constructor."; + 46, "Error in environment variable."; + 47, "Illegal attribute payload."; + 48, "Implicit elimination of optional arguments."; + 49, "Absent cmi file when looking up module alias."; + 50, "Unexpected documentation comment."; + 51, "Warning on non-tail calls if @tailcall present."; + 52, "Fragile constant pattern."; + 53, "Attribute cannot appear in this context"; + 54, "Attribute used more than once on an expression"; + 55, "Inlining impossible"; + 56, "Unreachable case in a pattern-matching (based on type information)."; + 57, "Ambiguous or-pattern variables under guard"; + 58, "Missing cmx file"; + 59, "Assignment to non-mutable value"; + 60, "Unused module declaration"; + 61, "Unboxable type in primitive declaration"; + 62, "Type constraint on GADT type declaration"; + + + 101, "Unused bs attributes"; + 102, "polymorphic comparison introduced (maybe unsafe)"; + 103, "BuckleScript FFI warning: " ; + 104, "BuckleScript bs.deriving warning: " + + ] +;; + +let help_warnings () = + List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions; + print_endline " A all warnings"; + for i = Char.code 'b' to Char.code 'z' do + let c = Char.chr i in + match letter c with + | [] -> () + | [n] -> + Printf.printf " %c Alias for warning %i.\n" (Char.uppercase_ascii c) n + | l -> + Printf.printf " %c warnings %s.\n" + (Char.uppercase_ascii c) + (String.concat ", " (List.map string_of_int l)) + done; + exit 0 +;; + +end +module Location : sig +#1 "location.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Source code locations (ranges of positions), used in parsetree. *) + +open Format + +type t = Warnings.loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +(** Note on the use of Lexing.position in this module. + If [pos_fname = ""], then use [!input_name] instead. + If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and + re-parse the file to get the line and character numbers. + Else all fields are correct. +*) + +val none : t +(** An arbitrary value of type [t]; describes an empty ghost range. *) + +val in_file : string -> t +(** Return an empty ghost range located in a given file. *) + +val init : Lexing.lexbuf -> string -> unit +(** Set the file name and line number of the [lexbuf] to be the start + of the named file. *) + +val curr : Lexing.lexbuf -> t +(** Get the location of the current token from the [lexbuf]. *) + +val symbol_rloc: unit -> t +val symbol_gloc: unit -> t + +(** [rhs_loc n] returns the location of the symbol at position [n], starting + at 1, in the current parser rule. *) +val rhs_loc: int -> t + +val input_name: string ref +val input_lexbuf: Lexing.lexbuf option ref + +val get_pos_info: Lexing.position -> string * int * int (* file, line, char *) +val print_loc: formatter -> t -> unit +val print_error: formatter -> t -> unit +val print_error_cur_file: formatter -> unit -> unit +val print_warning: t -> formatter -> Warnings.t -> unit +val formatter_for_warnings : formatter ref +val prerr_warning: t -> Warnings.t -> unit +val echo_eof: unit -> unit +val reset: unit -> unit + +val default_printer : formatter -> t -> unit +val printer : (formatter -> t -> unit) ref + +val warning_printer : (t -> formatter -> Warnings.t -> unit) ref +(** Hook for intercepting warnings. *) + +val default_warning_printer : t -> formatter -> Warnings.t -> unit +(** Original warning printer for use in hooks. *) + +val highlight_locations: formatter -> t list -> bool + +type 'a loc = { + txt : 'a; + loc : t; +} + +val mknoloc : 'a -> 'a loc +val mkloc : 'a -> t -> 'a loc + +val print: formatter -> t -> unit +val print_compact: formatter -> t -> unit +val print_filename: formatter -> string -> unit + +val absolute_path: string -> string + +val show_filename: string -> string + (** In -absname mode, return the absolute path for this filename. + Otherwise, returns the filename unchanged. *) + + +val absname: bool ref + +(** Support for located errors *) + +type error = + { + loc: t; + msg: string; + sub: error list; + if_highlight: string; (* alternative message if locations are highlighted *) + } + +exception Already_displayed_error +exception Error of error + +val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error + + +val print_error_prefix : Format.formatter -> unit +val pp_ksprintf : ?before:(formatter -> unit) -> (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b + + +val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + +val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, 'b) format4 -> 'a + +val error_of_printer: t -> (formatter -> 'a -> unit) -> 'a -> error + +val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error + +val error_of_exn: exn -> [ `Ok of error | `Already_displayed ] option + +val register_error_of_exn: (exn -> error option) -> unit +(** Each compiler module which defines a custom type of exception + which can surface as a user-visible error should register + a "printer" for this exception using [register_error_of_exn]. + The result of the printer is an [error] value containing + a location, a message, and optionally sub-messages (each of them + being located as well). *) + +val report_error: formatter -> error -> unit + +val error_reporter : (formatter -> error -> unit) ref +(** Hook for intercepting error reports. *) + +val default_error_reporter : formatter -> error -> unit +(** Original error reporter for use in hooks. *) + +val report_exception: formatter -> exn -> unit +(** Reraise the exception if it is unknown. *) + +val deprecated: ?def:t -> ?use:t -> t -> string -> unit + +end = struct +#1 "location.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Lexing + +let absname = ref false + (* This reference should be in Clflags, but it would create an additional + dependency and make bootstrapping Camlp4 more difficult. *) + +type t = Warnings.loc = { loc_start: position; loc_end: position; loc_ghost: bool };; + +let in_file name = + let loc = { + pos_fname = name; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = -1; + } in + { loc_start = loc; loc_end = loc; loc_ghost = true } +;; + +let none = in_file "_none_";; + +let curr lexbuf = { + loc_start = lexbuf.lex_start_p; + loc_end = lexbuf.lex_curr_p; + loc_ghost = false +};; + +let init lexbuf fname = + lexbuf.lex_curr_p <- { + pos_fname = fname; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0; + } +;; + +let symbol_rloc () = { + loc_start = Parsing.symbol_start_pos (); + loc_end = Parsing.symbol_end_pos (); + loc_ghost = false; +};; + +let symbol_gloc () = { + loc_start = Parsing.symbol_start_pos (); + loc_end = Parsing.symbol_end_pos (); + loc_ghost = true; +};; + +let rhs_loc n = { + loc_start = Parsing.rhs_start_pos n; + loc_end = Parsing.rhs_end_pos n; + loc_ghost = false; +};; + +let input_name = ref "_none_" +let input_lexbuf = ref (None : lexbuf option) + +(* Terminal info *) + +let status = ref Terminfo.Uninitialised + +let num_loc_lines = ref 0 (* number of lines already printed after input *) + +let print_updating_num_loc_lines ppf f arg = + let open Format in + let out_functions = pp_get_formatter_out_functions ppf () in + let out_string str start len = + let rec count i c = + if i = start + len then c + else if String.get str i = '\n' then count (succ i) (succ c) + else count (succ i) c in + num_loc_lines := !num_loc_lines + count start 0 ; + out_functions.out_string str start len in + pp_set_formatter_out_functions ppf + { out_functions with out_string } ; + f ppf arg ; + pp_print_flush ppf (); + pp_set_formatter_out_functions ppf out_functions + +(* Highlight the locations using standout mode. *) + +let highlight_terminfo ppf num_lines lb locs = + Format.pp_print_flush ppf (); (* avoid mixing Format and normal output *) + (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *) + let pos0 = -lb.lex_abs_pos in + (* Do nothing if the buffer does not contain the whole phrase. *) + if pos0 < 0 then raise Exit; + (* Count number of lines in phrase *) + let lines = ref !num_loc_lines in + for i = pos0 to lb.lex_buffer_len - 1 do + if Bytes.get lb.lex_buffer i = '\n' then incr lines + done; + (* If too many lines, give up *) + if !lines >= num_lines - 2 then raise Exit; + (* Move cursor up that number of lines *) + flush stdout; Terminfo.backup !lines; + (* Print the input, switching to standout for the location *) + let bol = ref false in + print_string "# "; + for pos = 0 to lb.lex_buffer_len - pos0 - 1 do + if !bol then (print_string " "; bol := false); + if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then + Terminfo.standout true; + if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then + Terminfo.standout false; + let c = Bytes.get lb.lex_buffer (pos + pos0) in + print_char c; + bol := (c = '\n') + done; + (* Make sure standout mode is over *) + Terminfo.standout false; + (* Position cursor back to original location *) + Terminfo.resume !num_loc_lines; + flush stdout + +(* Highlight the location by printing it again. *) + +let highlight_dumb ppf lb loc = + (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *) + let pos0 = -lb.lex_abs_pos in + (* Do nothing if the buffer does not contain the whole phrase. *) + if pos0 < 0 then raise Exit; + let end_pos = lb.lex_buffer_len - pos0 - 1 in + (* Determine line numbers for the start and end points *) + let line_start = ref 0 and line_end = ref 0 in + for pos = 0 to end_pos do + if Bytes.get lb.lex_buffer (pos + pos0) = '\n' then begin + if loc.loc_start.pos_cnum > pos then incr line_start; + if loc.loc_end.pos_cnum > pos then incr line_end; + end + done; + (* Print character location (useful for Emacs) *) + Format.fprintf ppf "@[Characters %i-%i:@," + loc.loc_start.pos_cnum loc.loc_end.pos_cnum; + (* Print the input, underlining the location *) + Format.pp_print_string ppf " "; + let line = ref 0 in + let pos_at_bol = ref 0 in + for pos = 0 to end_pos do + match Bytes.get lb.lex_buffer (pos + pos0) with + | '\n' -> + if !line = !line_start && !line = !line_end then begin + (* loc is on one line: underline location *) + Format.fprintf ppf "@, "; + for _i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do + Format.pp_print_char ppf ' ' + done; + for _i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do + Format.pp_print_char ppf '^' + done + end; + if !line >= !line_start && !line <= !line_end then begin + Format.fprintf ppf "@,"; + if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf " " + end; + incr line; + pos_at_bol := pos + 1 + | '\r' -> () (* discard *) + | c -> + if !line = !line_start && !line = !line_end then + (* loc is on one line: print whole line *) + Format.pp_print_char ppf c + else if !line = !line_start then + (* first line of multiline loc: + print a dot for each char before loc_start *) + if pos < loc.loc_start.pos_cnum then + Format.pp_print_char ppf '.' + else + Format.pp_print_char ppf c + else if !line = !line_end then + (* last line of multiline loc: print a dot for each char + after loc_end, even whitespaces *) + if pos < loc.loc_end.pos_cnum then + Format.pp_print_char ppf c + else + Format.pp_print_char ppf '.' + else if !line > !line_start && !line < !line_end then + (* intermediate line of multiline loc: print whole line *) + Format.pp_print_char ppf c + done; + Format.fprintf ppf "@]" + +(* Highlight the location using one of the supported modes. *) + +let rec highlight_locations ppf locs = + match !status with + Terminfo.Uninitialised -> + status := Terminfo.setup stdout; highlight_locations ppf locs + | Terminfo.Bad_term -> + begin match !input_lexbuf with + None -> false + | Some lb -> + let norepeat = + try Sys.getenv "TERM" = "norepeat" with Not_found -> false in + if norepeat then false else + let loc1 = List.hd locs in + try highlight_dumb ppf lb loc1; true + with Exit -> false + end + | Terminfo.Good_term num_lines -> + begin match !input_lexbuf with + None -> false + | Some lb -> + try highlight_terminfo ppf num_lines lb locs; true + with Exit -> false + end + +(* Print the location in some way or another *) + +open Format + +let absolute_path s = (* This function could go into Filename *) + let open Filename in + let s = if is_relative s then concat (Sys.getcwd ()) s else s in + (* Now simplify . and .. components *) + let rec aux s = + let base = basename s in + let dir = dirname s in + if dir = s then dir + else if base = current_dir_name then aux dir + else if base = parent_dir_name then dirname (aux dir) + else concat (aux dir) base + in + aux s + +let show_filename file = + if !absname then absolute_path file else file + +let print_filename ppf file = + Format.fprintf ppf "%s" (show_filename file) + +let reset () = + num_loc_lines := 0 + +let (msg_file, msg_line, msg_chars, msg_to, msg_colon) = + ("File \"", "\", line ", ", characters ", "-", ":") + +(* return file, line, char from the given position *) +let get_pos_info pos = + (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol) +;; + +let setup_colors () = + Misc.Color.setup !Clflags.color + +let print_loc ppf loc = + setup_colors (); + let (file, line, startchar) = get_pos_info loc.loc_start in + + let startchar = + if Clflags.bs_vscode then startchar + 1 else startchar in + + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + if file = "//toplevel//" then begin + if highlight_locations ppf [loc] then () else + fprintf ppf "Characters %i-%i" + loc.loc_start.pos_cnum loc.loc_end.pos_cnum + end else begin + fprintf ppf "%s@{%a%s%i" msg_file print_filename file msg_line line; + if startchar >= 0 then + fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar; + fprintf ppf "@}" + end +;; + +let default_printer ppf loc = + setup_colors (); + if loc.loc_start.pos_fname = "//toplevel//" + && highlight_locations ppf [loc] then () + else fprintf ppf "@{%a@}%s@," print_loc loc msg_colon +;; + +let printer = ref default_printer +let print ppf loc = !printer ppf loc + +let error_prefix = "Error" +let warning_prefix = "Warning" + +let print_error_prefix ppf = + setup_colors (); + fprintf ppf "@{%s@}" error_prefix; +;; + +let print_compact ppf loc = + if loc.loc_start.pos_fname = "//toplevel//" + && highlight_locations ppf [loc] then () + else begin + let (file, line, startchar) = get_pos_info loc.loc_start in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + fprintf ppf "%a:%i" print_filename file line; + if startchar >= 0 then fprintf ppf ",%i--%i" startchar endchar + end +;; + +let print_error ppf loc = + fprintf ppf "%a%t:" print loc print_error_prefix; +;; + +let print_error_cur_file ppf () = print_error ppf (in_file !input_name);; + +let default_warning_printer loc ppf w = + match Warnings.report w with + | `Inactive -> () + | `Active { Warnings. number; message; is_error; sub_locs } -> + setup_colors (); + fprintf ppf "@["; + print ppf loc; + if is_error + then + fprintf ppf "%t (%s %d): %s@," print_error_prefix + (String.uncapitalize_ascii warning_prefix) number message + else fprintf ppf "@{%s@} %d: %s@," warning_prefix number message; + List.iter + (fun (loc, msg) -> + if loc <> none then fprintf ppf " %a %s@," print loc msg + ) + sub_locs; + fprintf ppf "@]" +;; + +let warning_printer = ref default_warning_printer ;; + +let print_warning loc ppf w = + print_updating_num_loc_lines ppf (!warning_printer loc) w +;; + +let formatter_for_warnings = ref err_formatter;; +let prerr_warning loc w = print_warning loc !formatter_for_warnings w;; + +let echo_eof () = + print_newline (); + incr num_loc_lines + +type 'a loc = { + txt : 'a; + loc : t; +} + +let mkloc txt loc = { txt ; loc } +let mknoloc txt = mkloc txt none + + +type error = + { + loc: t; + msg: string; + sub: error list; + if_highlight: string; (* alternative message if locations are highlighted *) + } + +let pp_ksprintf ?before k fmt = + let buf = Buffer.create 64 in + let ppf = Format.formatter_of_buffer buf in + Misc.Color.set_color_tag_handling ppf; + begin match before with + | None -> () + | Some f -> f ppf + end; + kfprintf + (fun _ -> + pp_print_flush ppf (); + let msg = Buffer.contents buf in + k msg) + ppf fmt + +(* Shift the formatter's offset by the length of the error prefix, which + is always added by the compiler after the message has been formatted *) +let print_phanton_error_prefix ppf = + Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" + +let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = + pp_ksprintf + ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let error ?(loc = none) ?(sub = []) ?(if_highlight = "") msg = + {loc; msg; sub; if_highlight} + +let error_of_exn : (exn -> error option) list ref = ref [] + +let register_error_of_exn f = error_of_exn := f :: !error_of_exn + +exception Already_displayed_error = Warnings.Errors + +let error_of_exn exn = + match exn with + | Already_displayed_error -> Some `Already_displayed + | _ -> + let rec loop = function + | [] -> None + | f :: rest -> + match f exn with + | Some error -> Some (`Ok error) + | None -> loop rest + in + loop !error_of_exn + +let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = + let highlighted = + if if_highlight <> "" && loc.loc_start.pos_fname = "//toplevel//" then + let rec collect_locs locs {loc; sub; _} = + List.fold_left collect_locs (loc :: locs) sub + in + let locs = collect_locs [] err in + highlight_locations ppf locs + else + false + in + if highlighted then + Format.pp_print_string ppf if_highlight + else begin + fprintf ppf "@[%a %s" print_error loc msg; + List.iter (Format.fprintf ppf "@,@[<2>%a@]" default_error_reporter) sub; + fprintf ppf "@]" + end + +let error_reporter = ref default_error_reporter + +let report_error ppf err = + print_updating_num_loc_lines ppf !error_reporter err +;; + +let error_of_printer loc print x = + errorf ~loc "%a@?" print x + +let error_of_printer_file print x = + error_of_printer (in_file !input_name) print x + +let () = + register_error_of_exn + (function + | Sys_error msg -> + Some (errorf ~loc:(in_file !input_name) + "I/O error: %s" msg) + + | Misc.HookExnWrapper {error = e; hook_name; + hook_info={Misc.sourcefile}} -> + let sub = match error_of_exn e with + | None | Some `Already_displayed -> error (Printexc.to_string e) + | Some (`Ok err) -> err + in + Some + (errorf ~loc:(in_file sourcefile) + "In hook %S:" hook_name + ~sub:[sub]) + | _ -> None + ) + +external reraise : exn -> 'a = "%reraise" + +let rec report_exception_rec n ppf exn = + try + match error_of_exn exn with + | None -> reraise exn + | Some `Already_displayed -> () + | Some (`Ok err) -> fprintf ppf "@[%a@]@." report_error err + with exn when n > 0 -> report_exception_rec (n-1) ppf exn + +let report_exception ppf exn = report_exception_rec 5 ppf exn + + +exception Error of error + +let () = + register_error_of_exn + (function + | Error e -> Some e + | _ -> None + ) + +let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = + pp_ksprintf + ~before:print_phanton_error_prefix + (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + +let deprecated ?(def = none) ?(use = none) loc msg = + prerr_warning loc (Warnings.Deprecated (msg, def, use)) + +end +(** Interface as module *) +module Asttypes += struct +#1 "asttypes.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Auxiliary AST types used by parsetree and typedtree. *) + +type constant = + Const_int of int + | Const_char of char + | Const_string of string * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + +type rec_flag = Nonrecursive | Recursive + +type direction_flag = Upto | Downto + +(* Order matters, used in polymorphic comparison *) +type private_flag = Private | Public + +type mutable_flag = Immutable | Mutable + +type virtual_flag = Virtual | Concrete + +type override_flag = Override | Fresh + +type closed_flag = Closed | Open + +type label = string + +type arg_label = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) + +type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; +} + + +type variance = + | Covariant + | Contravariant + | Invariant + +end +module Longident : sig +#1 "longident.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Long identifiers, used in parsetree. *) + +type t = + Lident of string + | Ldot of t * string + | Lapply of t * t + +val flatten: t -> string list +val unflatten: string list -> t option +val last: t -> string +val parse: string -> t + +end = struct +#1 "longident.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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type t = + Lident of string + | Ldot of t * string + | Lapply of t * t + +let rec flat accu = function + Lident s -> s :: accu + | Ldot(lid, s) -> flat (s :: accu) lid + | Lapply(_, _) -> Misc.fatal_error "Longident.flat" + +let flatten lid = flat [] lid + +let last = function + Lident s -> s + | Ldot(_, s) -> s + | Lapply(_, _) -> Misc.fatal_error "Longident.last" + +let rec split_at_dots s pos = + try + let dot = String.index_from s pos '.' in + String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) + with Not_found -> + [String.sub s pos (String.length s - pos)] + +let unflatten l = + match l with + | [] -> None + | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl) + +let parse s = + match unflatten (split_at_dots s 0) with + | None -> Lident "" (* should not happen, but don't put assert false + so as not to crash the toplevel (see Genprintval) *) + | Some v -> v + +end +(** Interface as module *) +module Parsetree += struct +#1 "parsetree.mli" +(**************************************************************************) +(* *) +(* 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 Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Abstract syntax tree produced by parsing *) + +open Asttypes + +type constant = + Pconst_integer of string * char option + (* 3 3l 3L 3n + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes except 'l', 'L' and 'n' are rejected by the typechecker + *) + | Pconst_char of char + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + +(** {1 Extension points} *) + +type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + +and extension = string loc * payload + (* [%id ARG] + [%%id ARG] + + Sub-language placeholder -- rejected by the typechecker. + *) + +and attributes = attribute list + +and payload = + | PStr of structure + | PSig of signature (* : SIG *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + +(** {1 Core language} *) + +(* Type expressions *) + +and core_type = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and core_type_desc = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string loc list * core_type + (* 'a1 ... 'an. T + + Can only appear in the following context: + + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + +and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + +and row_field = + | Rtag of label loc * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd field is true if the tag contains a + constant (empty) constructor. + - '&' occurs when several types are used for the same constructor + (see 4.2 in the manual) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + +and object_field = + | Otag of label loc * attributes * core_type + | Oinherit of core_type + +(* Patterns *) + +and pattern = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and pattern_desc = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + +(* Value expressions *) + +and expression = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and expression_desc = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (Some E0) + + Invariant: n > 0 + *) + | Pexp_field of expression * Longident.t loc + (* E.l *) + | Pexp_setfield of expression * Longident.t loc * expression + (* E1.l <- E2 *) + | Pexp_array of expression list + (* [| E1; ...; En |] *) + | Pexp_ifthenelse of expression * expression * expression option + (* if E1 then E2 else E3 *) + | Pexp_sequence of expression * expression + (* E1; E2 *) + | Pexp_while of expression * expression + (* while E1 do E2 done *) + | Pexp_for of + pattern * expression * expression * direction_flag * expression + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * label loc + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of label loc * expression + (* x <- 2 *) + | Pexp_override of (label loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string loc * module_expr * expression + (* let module M = ME in E *) + | Pexp_letexception of extension_constructor * expression + (* let exception C in E *) + | Pexp_assert of expression + (* assert E + Note: "assert false" is treated in a special way by the + type-checker. *) + | Pexp_lazy of expression + (* lazy E *) + | Pexp_poly of expression * core_type option + (* Used for method bodies. + + Can only be used as the expression under Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + +and case = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + +(* Value descriptions *) + +and value_description = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (* ... [@@id1] [@@id2] *) + pval_loc: Location.t; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) +*) + +(* Type declarations *) + +and type_declaration = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) +*) + +and type_kind = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty list *) + | Ptype_record of label_declaration list + (* Invariant: non-empty list *) + | Ptype_open + +and label_declaration = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: Location.t; + pld_attributes: attributes; (* l : T [@id1] [@id2] *) + } + +(* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. +*) + +and constructor_declaration = + { + pcd_name: string loc; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) + } + +and constructor_arguments = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) +*) + +and type_extension = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + type t += ... +*) + +and extension_constructor = + { + pext_name: string loc; + pext_kind : extension_constructor_kind; + pext_loc : Location.t; + pext_attributes: attributes; (* C of ... [@id1] [@id2] *) + } + +and extension_constructor_kind = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + +(** {1 Class language} *) + +(* Type expressions for the class language *) + +and class_type = + { + pcty_desc: class_type_desc; + pcty_loc: Location.t; + pcty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_type_desc = + | Pcty_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcty_signature of class_signature + (* object ... end *) + | Pcty_arrow of arg_label * core_type * class_type + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + | Pcty_open of override_flag * Longident.t loc * class_type + (* let open M in CT *) + +and class_signature = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } +(* object('selfpat) ... end + object ... end (self = Ptyp_any) + *) + +and class_type_field = + { + pctf_desc: class_type_field_desc; + pctf_loc: Location.t; + pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_type_field_desc = + | Pctf_inherit of class_type + (* inherit CT *) + | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (label loc * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a Ptyp_poly. + *) + | Pctf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pctf_attribute of attribute + (* [@@@id] *) + | Pctf_extension of extension + (* [%%id] *) + +and 'a class_infos = + { + pci_virt: virtual_flag; + pci_params: (core_type * variance) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. +*) + +and class_description = class_type class_infos + +and class_type_declaration = class_type class_infos + +(* Value expressions for the class language *) + +and class_expr = + { + pcl_desc: class_expr_desc; + pcl_loc: Location.t; + pcl_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_expr_desc = + | Pcl_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* CE ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + | Pcl_open of override_flag * Longident.t loc * class_expr + (* let open M in CE *) + + +and class_structure = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } +(* object(selfpat) ... end + object ... end (self = Ppat_any) + *) + +and class_field = + { + pcf_desc: class_field_desc; + pcf_loc: Location.t; + pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_field_desc = + | Pcf_inherit of override_flag * class_expr * string loc option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a Ptyp_poly) + *) + | Pcf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pcf_initializer of expression + (* initializer E *) + | Pcf_attribute of attribute + (* [@@@id] *) + | Pcf_extension of extension + (* [%%id] *) + +and class_field_kind = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + +and class_declaration = class_expr class_infos + +(** {1 Module language} *) + +(* Type expressions for the module language *) + +and module_type = + { + pmty_desc: module_type_desc; + pmty_loc: Location.t; + pmty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_type_desc = + | Pmty_ident of Longident.t loc + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * module_type + (* functor(X : MT1) -> MT2 *) + | Pmty_with of module_type * with_constraint list + (* MT with ... *) + | Pmty_typeof of module_expr + (* module type of ME *) + | Pmty_extension of extension + (* [%id] *) + | Pmty_alias of Longident.t loc + (* (module M) *) + +and signature = signature_item list + +and signature_item = + { + psig_desc: signature_item_desc; + psig_loc: Location.t; + } + +and signature_item_desc = + | Psig_value of value_description + (* + val x: T + external x: T = "s1" ... "sn" + *) + | Psig_type of rec_flag * type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Psig_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + module type S *) + | Psig_open of open_description + (* open X *) + | Psig_include of include_description + (* include MT *) + | Psig_class of class_description list + (* class c1 : ... and ... and cn : ... *) + | Psig_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Psig_attribute of attribute + (* [@@@id] *) + | Psig_extension of extension * attributes + (* [%%id] *) + +and module_declaration = + { + pmd_name: string loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } +(* S : MT *) + +and module_type_declaration = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmtd_loc: Location.t; + } +(* S = MT + S (abstract module type declaration, pmtd_type = None) +*) + +and open_description = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } +(* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + +and 'a include_infos = + { + pincl_mod: 'a; + pincl_loc: Location.t; + pincl_attributes: attributes; + } + +and include_description = module_type include_infos +(* include MT *) + +and include_declaration = module_expr include_infos +(* include ME *) + +and with_constraint = + | Pwith_type of Longident.t loc * type_declaration + (* with type X.t = ... + + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (* with module X.Y = Z *) + | Pwith_typesubst of Longident.t loc * type_declaration + (* with type X.t := ..., same format as [Pwith_type] *) + | Pwith_modsubst of Longident.t loc * Longident.t loc + (* with module X.Y := Z *) + +(* Value expressions for the module language *) + +and module_expr = + { + pmod_desc: module_expr_desc; + pmod_loc: Location.t; + pmod_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_expr_desc = + | Pmod_ident of Longident.t loc + (* X *) + | Pmod_structure of structure + (* struct ... end *) + | Pmod_functor of string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | Pmod_constraint of module_expr * module_type + (* (ME : MT) *) + | Pmod_unpack of expression + (* (val E) *) + | Pmod_extension of extension + (* [%id] *) + +and structure = structure_item list + +and structure_item = + { + pstr_desc: structure_item_desc; + pstr_loc: Location.t; + } + +and structure_item_desc = + | Pstr_eval of expression * attributes + (* E *) + | Pstr_value of rec_flag * value_binding list + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = Recursive) + *) + | Pstr_primitive of value_description + (* val x: T + external x: T = "s1" ... "sn" *) + | Pstr_type of rec_flag * type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Pstr_typext of type_extension + (* type t1 += ... *) + | Pstr_exception of extension_constructor + (* exception C of T + exception C = M.X *) + | Pstr_module of module_binding + (* module X = ME *) + | Pstr_recmodule of module_binding list + (* module rec X1 = ME1 and ... and Xn = MEn *) + | Pstr_modtype of module_type_declaration + (* module type S = MT *) + | Pstr_open of open_description + (* open X *) + | Pstr_class of class_declaration list + (* class c1 = ... and ... and cn = ... *) + | Pstr_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Pstr_include of include_declaration + (* include ME *) + | Pstr_attribute of attribute + (* [@@@id] *) + | Pstr_extension of extension * attributes + (* [%%id] *) + +and value_binding = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + +and module_binding = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } +(* X = ME *) + +(** {1 Toplevel} *) + +(* Toplevel phrases *) + +type toplevel_phrase = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + +and directive_argument = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + +end +module Docstrings : sig +#1 "docstrings.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Leo White *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Documentation comments *) + +(** (Re)Initialise all docstring state *) +val init : unit -> unit + +(** Emit warnings for unattached and ambiguous docstrings *) +val warn_bad_docstrings : unit -> unit + +(** {2 Docstrings} *) + +(** Documentation comments *) +type docstring + +(** Create a docstring *) +val docstring : string -> Location.t -> docstring + +(** Register a docstring *) +val register : docstring -> unit + +(** Get the text of a docstring *) +val docstring_body : docstring -> string + +(** Get the location of a docstring *) +val docstring_loc : docstring -> Location.t + +(** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + +(** Docstrings immediately preceding a token *) +val set_pre_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately following a token *) +val set_post_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings not immediately adjacent to a token *) +val set_floating_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately following the token which precedes this one *) +val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + +(** Docstrings immediately preceding the token which follows this one *) +val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + +(** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + +type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + +val empty_docs : docs + +val docs_attr : docstring -> Parsetree.attribute + +(** Convert item documentation to attributes and add them to an + attribute list *) +val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) +val symbol_docs : unit -> docs +val symbol_docs_lazy : unit -> docs Lazy.t + +(** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) +val rhs_docs : int -> int -> docs +val rhs_docs_lazy : int -> int -> docs Lazy.t + +(** Mark the item documentation for the current symbol (for ambiguity + warnings). *) +val mark_symbol_docs : unit -> unit + +(** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) +val mark_rhs_docs : int -> int -> unit + +(** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + +type info = docstring option + +val empty_info : info + +val info_attr : docstring -> Parsetree.attribute + +(** Convert field info to attributes and add them to an + attribute list *) +val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the field info for the current symbol. *) +val symbol_info : unit -> info + +(** Fetch the field info following the symbol at a given position. *) +val rhs_info : int -> info + +(** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + +type text = docstring list + +val empty_text : text +val empty_text_lazy : text Lazy.t + +val text_attr : docstring -> Parsetree.attribute + +(** Convert text to attributes and add them to an attribute list *) +val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +(** Fetch the text preceding the current symbol. *) +val symbol_text : unit -> text +val symbol_text_lazy : unit -> text Lazy.t + +(** Fetch the text preceding the symbol at the given position. *) +val rhs_text : int -> text +val rhs_text_lazy : int -> text Lazy.t + +(** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + +(** Fetch additional text preceding the current symbol *) +val symbol_pre_extra_text : unit -> text + +(** Fetch additional text following the current symbol *) +val symbol_post_extra_text : unit -> text + +(** Fetch additional text preceding the symbol at the given position *) +val rhs_pre_extra_text : int -> text + +(** Fetch additional text following the symbol at the given position *) +val rhs_post_extra_text : int -> text + +end = struct +#1 "docstrings.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Leo White *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Location + +(* Docstrings *) + +(* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) +type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + +(* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) +type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + +type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + +(* List of docstrings *) + +let docstrings : docstring list ref = ref [] + +(* Warn for unused and ambiguous docstrings *) + +let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) +end + +(* Docstring constructors and destructors *) + +let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + +let register ds = + docstrings := ds :: !docstrings + +let docstring_body ds = ds.ds_body + +let docstring_loc ds = ds.ds_loc + +(* Docstrings attached to items *) + +type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + +let empty_docs = { docs_pre = None; docs_post = None } + +let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + +let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + +let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + +(* Docstrings attached to constructors or fields *) + +type info = docstring option + +let empty_info = None + +let info_attr = docs_attr + +let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + +(* Docstrings not attached to a specific item *) + +type text = docstring list + +let empty_text = [] +let empty_text_lazy = lazy [] + +let text_loc = {txt = "ocaml.text"; loc = Location.none} + +let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + +let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +(* Find the first non-info docstring in a list, attach it and return it *) +let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + +(* Find all the non-info docstrings in a list, attach them and return them *) +let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + +(* "Associate" all the docstrings in a list *) +let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + +(* Map from positions to pre docstrings *) + +let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + +let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + +let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + +(* Map from positions to post docstrings *) + +let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + +let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + +let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + +let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + +(* Map from positions to floating docstrings *) + +let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + +let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + +(* Maps from positions to extra docstrings *) + +let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + +let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + +let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + +let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + +let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + +(* Docstrings from parser actions *) + +let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + +let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + +let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + +let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + +let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + +let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + +let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + +let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + +let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + +let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + +let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + +let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + +let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + +let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + +let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + +let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + + +(* (Re)Initialise all comment state *) + +let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table + +end +module Syntaxerr : sig +#1 "syntaxerr.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Auxiliary type for reporting syntax errors *) + +open Format + +type error = + Unclosed of Location.t * string * Location.t * string + | Expecting of Location.t * string + | Not_expecting of Location.t * string + | Applicative_path of Location.t + | Variable_in_scope of Location.t * string + | Other of Location.t + | Ill_formed_ast of Location.t * string + | Invalid_package_type of Location.t * string + +exception Error of error +exception Escape_error + +val report_error: formatter -> error -> unit + (** @deprecated Use {!Location.error_of_exn}, {!Location.report_error}. *) + +val location_of_error: error -> Location.t +val ill_formed_ast: Location.t -> string -> 'a + +end = struct +#1 "syntaxerr.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Auxiliary type for reporting syntax errors *) + +type error = + Unclosed of Location.t * string * Location.t * string + | Expecting of Location.t * string + | Not_expecting of Location.t * string + | Applicative_path of Location.t + | Variable_in_scope of Location.t * string + | Other of Location.t + | Ill_formed_ast of Location.t * string + | Invalid_package_type of Location.t * string + +exception Error of error +exception Escape_error + +let prepare_error = function + | Unclosed(opening_loc, opening, closing_loc, closing) -> + Location.errorf ~loc:closing_loc + ~sub:[ + Location.errorf ~loc:opening_loc + "This '%s' might be unmatched" opening + ] + ~if_highlight: + (Printf.sprintf "Syntax error: '%s' expected, \ + the highlighted '%s' might be unmatched" + closing opening) + "Syntax error: '%s' expected" closing + + | Expecting (loc, nonterm) -> + Location.errorf ~loc "Syntax error: %s expected." nonterm + | Not_expecting (loc, nonterm) -> + Location.errorf ~loc "Syntax error: %s not expected." nonterm + | Applicative_path loc -> + Location.errorf ~loc + "Syntax error: applicative paths of the form F(X).t \ + are not supported when the option -no-app-func is set." + | Variable_in_scope (loc, var) -> + Location.errorf ~loc + "In this scoped type, variable '%s \ + is reserved for the local type %s." + var var + | Other loc -> + Location.errorf ~loc "Syntax error" + | Ill_formed_ast (loc, s) -> + Location.errorf ~loc "broken invariant in parsetree: %s" s + | Invalid_package_type (loc, s) -> + Location.errorf ~loc "invalid package type: %s" s + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (prepare_error err) + | _ -> None + ) + + +let report_error ppf err = + Location.report_error ppf (prepare_error err) + +let location_of_error = function + | Unclosed(l,_,_,_) + | Applicative_path l + | Variable_in_scope(l,_) + | Other l + | Not_expecting (l, _) + | Ill_formed_ast (l, _) + | Invalid_package_type (l, _) + | Expecting (l, _) -> l + + +let ill_formed_ast loc s = + raise (Error (Ill_formed_ast (loc, s))) + +end +module Ast_helper : sig +#1 "ast_helper.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Helpers to produce Parsetree fragments *) + +open Asttypes +open Docstrings +open Parsetree + +type lid = Longident.t loc +type str = string loc +type loc = Location.t +type attrs = attribute list + +(** {1 Default locations} *) + +val default_loc: loc ref + (** Default value for all optional location arguments. *) + +val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + +(** {1 Constants} *) + +module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant +end + +(** {1 Core language} *) + +(** Type expressions *) +module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + +(** Patterns *) +module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + +(** Expressions *) +module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + +(** Value declarations *) +module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + +(** Type declarations *) +module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + +(** Type extensions *) +module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + +(** {1 Module language} *) + +(** Module type expressions *) +module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + +(** Module expressions *) +module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + +(** Signature items *) +module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + +(** Structure items *) +module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + +(** Module declarations *) +module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + +(** Module type declarations *) +module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + +(** Module bindings *) +module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + +(** Opens *) +module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + +(** Includes *) +module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + +(** Value bindings *) +module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + +(** {1 Class language} *) + +(** Class type expressions *) +module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type + -> class_type + end + +(** Class type fields *) +module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + +(** Class expressions *) +module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr + -> class_expr + end + +(** Class fields *) +module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + +(** Classes *) +module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + +(** Class signatures *) +module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + +(** Class structures *) +module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct +#1 "ast_helper.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Helpers to produce Parsetree fragments *) + +open Asttypes +open Parsetree +open Docstrings + +type lid = Longident.t loc +type str = string loc +type loc = Location.t +type attrs = attribute list + +let default_loc = ref Location.none + +let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + +module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) +end + +module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field = + function + | Rtag(label,attrs,flag,lst) -> + Rtag(label,attrs,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + and loop_object_field = + function + | Otag(label, attrs, t) -> + Otag(label, attrs, loop t) + | Oinherit t -> + Oinherit (loop t) + in + loop t + +end + +module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) +end + +module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } +end + +module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) +end + +module Mod = struct +let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) +end + +module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt +end + +module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt +end + +module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) +end + +module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) +end + +module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + +end + +module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + +end + +module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } +end + +module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } +end + +module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } +end + +module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } +end + +module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } +end + +module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + +end + +module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } +end + +module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } +end + +module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + +end + +(** Type extensions *) +module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + +end + +module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } +end + +module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } +end + +end +module Ext_bytes : sig +#1 "ext_bytes.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. *) + + + + + + + +(** Port the {!Bytes.escaped} from trunk to make it not locale sensitive *) + +val escaped : bytes -> bytes + +end = struct +#1 "ext_bytes.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. *) + + + + + + + + +external char_code: char -> int = "%identity" +external char_chr: int -> char = "%identity" + +let escaped s = + let n = Pervasives.ref 0 in + for i = 0 to Bytes.length s - 1 do + n := !n + + (match Bytes.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | ' ' .. '~' -> 1 + | _ -> 4) + done; + if !n = Bytes.length s then Bytes.copy s else begin + let s' = Bytes.create !n in + n := 0; + for i = 0 to Bytes.length s - 1 do + begin match Bytes.unsafe_get s i with + | ('"' | '\\') as c -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c + | '\n' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' + | '\t' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' + | '\r' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' + | '\b' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' + | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c + | c -> + let a = char_code c in + Bytes.unsafe_set s' !n '\\'; + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a / 100)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); + incr n; + Bytes.unsafe_set s' !n (char_chr (48 + a mod 10)); + end; + incr n + done; + s' + end + +end +module Ext_pervasives : sig +#1 "ext_pervasives.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. *) + + + + + + + + +(** Extension to standard library [Pervavives] module, safe to open + *) + +external reraise: exn -> 'a = "%reraise" + +val finally : 'a -> ('a -> 'c) -> ('a -> 'b) -> 'b + +val try_it : (unit -> 'a) -> unit + +val with_file_as_chan : string -> (out_channel -> 'a) -> 'a + +val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a + +val is_pos_pow : Int32.t -> int + +val failwithf : loc:string -> ('a, unit, string, 'b) format4 -> 'a + +val invalid_argf : ('a, unit, string, 'b) format4 -> 'a + +val bad_argf : ('a, unit, string, 'b) format4 -> 'a + + + + +external id : 'a -> 'a = "%identity" + +(** Copied from {!Btype.hash_variant}: + need sync up and add test case + *) +val hash_variant : string -> int + +val todo : string -> 'a +end = struct +#1 "ext_pervasives.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. *) + + + + + + +external reraise: exn -> 'a = "%reraise" + +let finally v action f = + match f v with + | exception e -> + action v ; + reraise e + | e -> action v ; e + +let try_it f = + try ignore (f ()) with _ -> () + +let with_file_as_chan filename f = + finally (open_out_bin filename) close_out f + +let with_file_as_pp filename f = + finally (open_out_bin filename) close_out + (fun chan -> + let fmt = Format.formatter_of_out_channel chan in + let v = f fmt in + Format.pp_print_flush fmt (); + v + ) + + +let is_pos_pow n = + let module M = struct exception E end in + let rec aux c (n : Int32.t) = + if n <= 0l then -2 + else if n = 1l then c + else if Int32.logand n 1l = 0l then + aux (c + 1) (Int32.shift_right n 1 ) + else raise M.E in + try aux 0 n with M.E -> -1 + +let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s)) + fmt + +let invalid_argf fmt = Format.ksprintf invalid_arg fmt + +let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt + +external id : 'a -> 'a = "%identity" + + +let hash_variant s = + let accu = ref 0 in + for i = 0 to String.length s - 1 do + accu := 223 * !accu + Char.code s.[i] + done; + (* reduce to 31 bits *) + accu := !accu land (1 lsl 31 - 1); + (* make it signed for 64 bits architectures *) + if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu + +let todo loc = + failwith (loc ^ " Not supported yet") +end +module Ext_string : sig +#1 "ext_string.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. *) + + + + + + + + +(** Extension to the standard library [String] module, fixed some bugs like + avoiding locale sensitivity *) + +(** default is false *) +val split_by : ?keep_empty:bool -> (char -> bool) -> string -> string list + + +(** remove whitespace letters ('\t', '\n', ' ') on both side*) +val trim : string -> string + + +(** default is false *) +val split : ?keep_empty:bool -> string -> char -> string list + +(** split by space chars for quick scripting *) +val quick_split_by_ws : string -> string list + + + +val starts_with : string -> string -> bool + +(** + return [-1] when not found, the returned index is useful + see [ends_with_then_chop] +*) +val ends_with_index : string -> string -> int + +val ends_with : string -> string -> bool + +(** + [ends_with_then_chop name ext] + @example: + {[ + ends_with_then_chop "a.cmj" ".cmj" + "a" + ]} + This is useful in controlled or file case sensitve system +*) +val ends_with_then_chop : string -> string -> string option + + +val escaped : string -> string + +(** + [for_all_from s start p] + if [start] is negative, it raises, + if [start] is too large, it returns true +*) +val for_all_from: + string -> + int -> + (char -> bool) -> + bool + +val for_all : + string -> + (char -> bool) -> + bool + +val is_empty : string -> bool + +val repeat : int -> string -> string + +val equal : string -> string -> bool + +(** + [extract_until s cursor sep] + When [sep] not found, the cursor is updated to -1, + otherwise cursor is increased to 1 + [sep_position] + User can not determine whether it is found or not by + telling the return string is empty since + "\n\n" would result in an empty string too. +*) +val extract_until: + string -> + int ref -> (* cursor to be updated *) + char -> + string + +val index_count: + string -> + int -> + char -> + int -> + int + +(** + [find ~start ~sub s] + returns [-1] if not found +*) +val find : ?start:int -> sub:string -> string -> int + +val contain_substring : string -> string -> bool + +val non_overlap_count : sub:string -> string -> int + +val rfind : sub:string -> string -> int + +(** [tail_from s 1] + return a substring from offset 1 (inclusive) +*) +val tail_from : string -> int -> string + + +(** returns negative number if not found *) +val rindex_neg : string -> char -> int + +val rindex_opt : string -> char -> int option + +type check_result = + | Good | Invalid_module_name | Suffix_mismatch + +val is_valid_source_name : + string -> check_result + + + + + +val no_char : string -> char -> int -> int -> bool + + +val no_slash : string -> bool + +(** return negative means no slash, otherwise [i] means the place for first slash *) +val no_slash_idx : string -> int + +val no_slash_idx_from : string -> int -> int + +(** if no conversion happens, reference equality holds *) +val replace_slash_backward : string -> string + +(** if no conversion happens, reference equality holds *) +val replace_backward_slash : string -> string + +val empty : string + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +val single_space : string + +val concat3 : string -> string -> string -> string +val concat4 : string -> string -> string -> string -> string +val concat5 : string -> string -> string -> string -> string -> string +val inter2 : string -> string -> string +val inter3 : string -> string -> string -> string +val inter4 : string -> string -> string -> string -> string +val concat_array : string -> string array -> string + +val single_colon : string + +val parent_dir_lit : string +val current_dir_lit : string + +val capitalize_ascii : string -> string + +val uncapitalize_ascii : string -> string + +val lowercase_ascii : string -> string +end = struct +#1 "ext_string.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. *) + + + + + + + +(* + {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} +*) +let split_by ?(keep_empty=false) is_delim str = + let len = String.length str in + let rec loop acc last_pos pos = + if pos = -1 then + if last_pos = 0 && not keep_empty then + + acc + else + String.sub str 0 last_pos :: acc + else + if is_delim str.[pos] then + let new_len = (last_pos - pos - 1) in + if new_len <> 0 || keep_empty then + let v = String.sub str (pos + 1) new_len in + loop ( v :: acc) + pos (pos - 1) + else loop acc pos (pos - 1) + else loop acc last_pos (pos - 1) + in + loop [] len (len - 1) + +let trim s = + let i = ref 0 in + let j = String.length s in + while !i < j && + let u = String.unsafe_get s !i in + u = '\t' || u = '\n' || u = ' ' + do + incr i; + done; + let k = ref (j - 1) in + while !k >= !i && + let u = String.unsafe_get s !k in + u = '\t' || u = '\n' || u = ' ' do + decr k ; + done; + String.sub s !i (!k - !i + 1) + +let split ?keep_empty str on = + if str = "" then [] else + split_by ?keep_empty (fun x -> (x : char) = on) str ;; + +let quick_split_by_ws str : string list = + split_by ~keep_empty:false (fun x -> x = '\t' || x = '\n' || x = ' ') str + +let starts_with s beg = + let beg_len = String.length beg in + let s_len = String.length s in + beg_len <= s_len && + (let i = ref 0 in + while !i < beg_len + && String.unsafe_get s !i = + String.unsafe_get beg !i do + incr i + done; + !i = beg_len + ) + +let rec ends_aux s end_ j k = + if k < 0 then (j + 1) + else if String.unsafe_get s j = String.unsafe_get end_ k then + ends_aux s end_ (j - 1) (k - 1) + else -1 + +(** return an index which is minus when [s] does not + end with [beg] +*) +let ends_with_index s end_ = + let s_finish = String.length s - 1 in + let s_beg = String.length end_ - 1 in + if s_beg > s_finish then -1 + else + ends_aux s end_ s_finish s_beg + +let ends_with s end_ = ends_with_index s end_ >= 0 + +let ends_with_then_chop s beg = + let i = ends_with_index s beg in + if i >= 0 then Some (String.sub s 0 i) + else None + +let check_suffix_case = ends_with +let check_suffix_case_then_chop = ends_with_then_chop + +let check_any_suffix_case s suffixes = + List.exists (fun x -> check_suffix_case s x) suffixes + +let check_any_suffix_case_then_chop s suffixes = + let rec aux suffixes = + match suffixes with + | [] -> None + | x::xs -> + let id = ends_with_index s x in + if id >= 0 then Some (String.sub s 0 id) + else aux xs in + aux suffixes + + + +(** In OCaml 4.02.3, {!String.escaped} is locale senstive, + this version try to make it not locale senstive, this bug is fixed + in the compiler trunk +*) +let escaped s = + let rec needs_escape i = + if i >= String.length s then false else + match String.unsafe_get s i with + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true + | ' ' .. '~' -> needs_escape (i+1) + | _ -> true + in + if needs_escape 0 then + Bytes.unsafe_to_string (Ext_bytes.escaped (Bytes.unsafe_of_string s)) + else + s + +(* it is unsafe to expose such API as unsafe since + user can provide bad input range + +*) +let rec unsafe_for_all_range s ~start ~finish p = + start > finish || + p (String.unsafe_get s start) && + unsafe_for_all_range s ~start:(start + 1) ~finish p + +let for_all_from s start p = + let len = String.length s in + if start < 0 then invalid_arg "Ext_string.for_all_from" + else unsafe_for_all_range s ~start ~finish:(len - 1) p + + +let for_all s (p : char -> bool) = + unsafe_for_all_range s ~start:0 ~finish:(String.length s - 1) p + +let is_empty s = String.length s = 0 + + +let repeat n s = + let len = String.length s in + let res = Bytes.create(n * len) in + for i = 0 to pred n do + String.blit s 0 res (i * len) len + done; + Bytes.to_string res + +let equal (x : string) y = x = y + + + +let unsafe_is_sub ~sub i s j ~len = + let rec check k = + if k = len + then true + else + String.unsafe_get sub (i+k) = + String.unsafe_get s (j+k) && check (k+1) + in + j+len <= String.length s && check 0 + + +exception Local_exit +let find ?(start=0) ~sub s = + let n = String.length sub in + let s_len = String.length s in + let i = ref start in + try + while !i + n <= s_len do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + incr i + done; + -1 + with Local_exit -> + !i + +let contain_substring s sub = + find s ~sub >= 0 + +(** TODO: optimize + avoid nonterminating when string is empty +*) +let non_overlap_count ~sub s = + let sub_len = String.length sub in + let rec aux acc off = + let i = find ~start:off ~sub s in + if i < 0 then acc + else aux (acc + 1) (i + sub_len) in + if String.length sub = 0 then invalid_arg "Ext_string.non_overlap_count" + else aux 0 0 + + +let rfind ~sub s = + let n = String.length sub in + let i = ref (String.length s - n) in + let module M = struct exception Exit end in + try + while !i >= 0 do + if unsafe_is_sub ~sub 0 s !i ~len:n then + raise_notrace Local_exit; + decr i + done; + -1 + with Local_exit -> + !i + +let tail_from s x = + let len = String.length s in + if x > len then invalid_arg ("Ext_string.tail_from " ^s ^ " : "^ string_of_int x ) + else String.sub s x (len - x) + +let equal (x : string) y = x = y + +let rec index_rec s lim i c = + if i >= lim then -1 else + if String.unsafe_get s i = c then i + else index_rec s lim (i + 1) c + +let rec index_rec_count s lim i c count = + if i >= lim then -1 else + if String.unsafe_get s i = c then + if count = 1 then i + else index_rec_count s lim (i + 1) c (count - 1) + else index_rec_count s lim (i + 1) c count + +let index_count s i c count = + let lim = String.length s in + if i < 0 || i >= lim || count < 1 then + Ext_pervasives.invalid_argf "index_count: (%d,%d)" i count; + + index_rec_count s lim i c count +let extract_until s cursor c = + let len = String.length s in + let start = !cursor in + if start < 0 || start >= len then ( + cursor := -1; + "" + ) + else + let i = index_rec s len start c in + let finish = + if i < 0 then ( + cursor := -1 ; + len + ) + else ( + cursor := i + 1; + i + ) in + String.sub s start (finish - start) + +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;; + +let is_valid_module_file (s : string) = + let len = String.length s in + len > 0 && + match String.unsafe_get s 0 with + | 'A' .. 'Z' + | 'a' .. 'z' -> + unsafe_for_all_range s ~start:1 ~finish:(len - 1) + (fun x -> + match x with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> true + | _ -> false ) + | _ -> false + + + + +type check_result = + | Good + | Invalid_module_name + | Suffix_mismatch + (** + TODO: move to another module + Make {!Ext_filename} not stateful + *) +let is_valid_source_name name : check_result = + match check_any_suffix_case_then_chop name [ + ".ml"; + ".re"; + ".mli"; + ".rei" + ] with + | None -> Suffix_mismatch + | Some x -> + if is_valid_module_file x then + Good + else Invalid_module_name + +(** TODO: can be improved to return a positive integer instead *) +let rec unsafe_no_char x ch i last_idx = + i > last_idx || + (String.unsafe_get x i <> ch && unsafe_no_char x ch (i + 1) last_idx) + +let rec unsafe_no_char_idx x ch i last_idx = + if i > last_idx then -1 + else + if String.unsafe_get x i <> ch then + unsafe_no_char_idx x ch (i + 1) last_idx + else i + +let no_char x ch i len : bool = + let str_len = String.length x in + if i < 0 || i >= str_len || len >= str_len then invalid_arg "Ext_string.no_char" + else unsafe_no_char x ch i len + + +let no_slash x = + unsafe_no_char x '/' 0 (String.length x - 1) + +let no_slash_idx x = + unsafe_no_char_idx x '/' 0 (String.length x - 1) + +let no_slash_idx_from x from = + let last_idx = String.length x - 1 in + assert (from >= 0); + unsafe_no_char_idx x '/' from last_idx + +let replace_slash_backward (x : string ) = + let len = String.length x in + if unsafe_no_char x '/' 0 (len - 1) then x + else + String.map (function + | '/' -> '\\' + | x -> x ) x + +let replace_backward_slash (x : string)= + let len = String.length x in + if unsafe_no_char x '\\' 0 (len -1) then x + else + String.map (function + |'\\'-> '/' + | x -> x) x + +let empty = "" + + +external compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + +let single_space = " " +let single_colon = ":" + +let concat_array sep (s : string array) = + let s_len = Array.length s in + match s_len with + | 0 -> empty + | 1 -> Array.unsafe_get s 0 + | _ -> + let sep_len = String.length sep in + let len = ref 0 in + for i = 0 to s_len - 1 do + len := !len + String.length (Array.unsafe_get s i) + done; + let target = + Bytes.create + (!len + (s_len - 1) * sep_len ) in + let hd = (Array.unsafe_get s 0) in + let hd_len = String.length hd in + String.unsafe_blit hd 0 target 0 hd_len; + let current_offset = ref hd_len in + for i = 1 to s_len - 1 do + String.unsafe_blit sep 0 target !current_offset sep_len; + let cur = Array.unsafe_get s i in + let cur_len = String.length cur in + let new_off_set = (!current_offset + sep_len ) in + String.unsafe_blit cur 0 target new_off_set cur_len; + current_offset := + new_off_set + cur_len ; + done; + Bytes.unsafe_to_string target + +let concat3 a b c = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let len = a_len + b_len + c_len in + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + Bytes.unsafe_to_string target + +let concat4 a b c d = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let len = a_len + b_len + c_len + d_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + Bytes.unsafe_to_string target + + +let concat5 a b c d e = + let a_len = String.length a in + let b_len = String.length b in + let c_len = String.length c in + let d_len = String.length d in + let e_len = String.length e in + let len = a_len + b_len + c_len + d_len + e_len in + + let target = Bytes.create len in + String.unsafe_blit a 0 target 0 a_len ; + String.unsafe_blit b 0 target a_len b_len; + String.unsafe_blit c 0 target (a_len + b_len) c_len; + String.unsafe_blit d 0 target (a_len + b_len + c_len) d_len; + String.unsafe_blit e 0 target (a_len + b_len + c_len + d_len) e_len; + Bytes.unsafe_to_string target + + + +let inter2 a b = + concat3 a single_space b + + +let inter3 a b c = + concat5 a single_space b single_space c + + + + + +let inter4 a b c d = + concat_array single_space [| a; b ; c; d|] + + +let parent_dir_lit = ".." +let current_dir_lit = "." + + +(* reference {!Bytes.unppercase} *) +let capitalize_ascii (s : string) : string = + if String.length s = 0 then s + else + begin + let c = String.unsafe_get s 0 in + if (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') then + let uc = Char.unsafe_chr (Char.code c - 32) in + let bytes = Bytes.of_string s in + Bytes.unsafe_set bytes 0 uc; + Bytes.unsafe_to_string bytes + else s + end + +let uncapitalize_ascii = + + String.uncapitalize_ascii + + + + +let lowercase_ascii = String.lowercase_ascii + + + + + +end +module Ext_list : sig +#1 "ext_list.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 map : + 'a list -> + ('a -> 'b) -> + 'b list + +val has_string : + string list -> + string -> + bool +val map_split_opt : + 'a list -> + ('a -> 'b option * 'c option) -> + 'b list * 'c list + +val mapi : + 'a list -> + (int -> 'a -> 'b) -> + 'b list + +val map_snd : ('a * 'b) list -> ('b -> 'c) -> ('a * 'c) list + +(** [map_last f xs ] + will pass [true] to [f] for the last element, + [false] otherwise. + For empty list, it returns empty +*) +val map_last : + 'a list -> + (bool -> 'a -> 'b) -> 'b list + +(** [last l] + return the last element + raise if the list is empty +*) +val last : 'a list -> 'a + +val append : + 'a list -> + 'a list -> + 'a list + +val append_one : + 'a list -> + 'a -> + 'a list + +val map_append : + 'b list -> + 'a list -> + ('b -> 'a) -> + 'a list + +val fold_right : + 'a list -> + 'b -> + ('a -> 'b -> 'b) -> + 'b + +val fold_right2 : + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) -> 'c + +val map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c) -> + 'c list + +val fold_left_with_offset : + 'a list -> + 'acc -> + int -> + ('a -> 'acc -> int -> 'acc) -> + 'acc + + +(** @unused *) +val filter_map : + 'a list -> + ('a -> 'b option) -> + 'b list + +(** [exclude p l] is the opposite of [filter p l] *) +val exclude : + 'a list -> + ('a -> bool) -> + 'a list + +(** [excludes p l] + return a tuple [excluded,newl] + where [exluded] is true indicates that at least one + element is removed,[newl] is the new list where all [p x] for [x] is false + +*) +val exclude_with_val : + 'a list -> + ('a -> bool) -> + 'a list option + + +val same_length : 'a list -> 'b list -> bool + +val init : int -> (int -> 'a) -> 'a list + +(** [split_at n l] + will split [l] into two lists [a,b], [a] will be of length [n], + otherwise, it will raise +*) +val split_at : + 'a list -> + int -> + 'a list * 'a list + + +(** [split_at_last l] + It is equivalent to [split_at (List.length l - 1) l ] +*) +val split_at_last : 'a list -> 'a list * 'a + +val filter_mapi : + 'a list -> + ('a -> int -> 'b option) -> + 'b list + +val filter_map2 : + 'a list -> + 'b list -> + ('a -> 'b -> 'c option) -> + 'c list + + +val length_compare : 'a list -> int -> [`Gt | `Eq | `Lt ] + +val length_ge : 'a list -> int -> bool + +(** + + {[length xs = length ys + n ]} + input n should be positive + TODO: input checking +*) + +val length_larger_than_n : + 'a list -> + 'a list -> + int -> + bool + + +(** + [rev_map_append f l1 l2] + [map f l1] and reverse it to append [l2] + This weird semantics is due to it is the most efficient operation + we can do +*) +val rev_map_append : + 'a list -> + 'b list -> + ('a -> 'b) -> + 'b list + + +val flat_map : + 'a list -> + ('a -> 'b list) -> + 'b list + +val flat_map_append : + 'a list -> + 'b list -> + ('a -> 'b list) -> + 'b list + + +(** + [stable_group eq lst] + Example: + Input: + {[ + stable_group (=) [1;2;3;4;3] + ]} + Output: + {[ + [[1];[2];[4];[3;3]] + ]} + TODO: this is O(n^2) behavior + which could be improved later +*) +val stable_group : + 'a list -> + ('a -> 'a -> bool) -> + 'a list list + +(** [drop n list] + raise when [n] is negative + raise when list's length is less than [n] +*) +val drop : + 'a list -> + int -> + 'a list + +val find_first : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_first_not p lst ] + if all elements in [lst] pass, return [None] + otherwise return the first element [e] as [Some e] which + fails the predicate +*) +val find_first_not : + 'a list -> + ('a -> bool) -> + 'a option + +(** [find_opt f l] returns [None] if all return [None], + otherwise returns the first one. +*) + +val find_opt : + 'a list -> + ('a -> 'b option) -> + 'b option + + +val rev_iter : + 'a list -> + ('a -> unit) -> + unit + +val iter: + 'a list -> + ('a -> unit) -> + unit + +val for_all: + 'a list -> + ('a -> bool) -> + bool +val for_all_snd: + ('a * 'b) list -> + ('b -> bool) -> + bool + +(** [for_all2_no_exn p xs ys] + return [true] if all satisfied, + [false] otherwise or length not equal +*) +val for_all2_no_exn : + 'a list -> + 'b list -> + ('a -> 'b -> bool) -> + bool + + + +(** [f] is applied follow the list order *) +val split_map : + 'a list -> + ('a -> 'b * 'c) -> + 'b list * 'c list + +(** [fn] is applied from left to right *) +val reduce_from_left : + 'a list -> + ('a -> 'a -> 'a) -> + 'a + +val sort_via_array : + 'a list -> + ('a -> 'a -> int) -> + 'a list + + + + +(** [assoc_by_string default key lst] + if [key] is found in the list return that val, + other unbox the [default], + otherwise [assert false ] +*) +val assoc_by_string : + (string * 'a) list -> + string -> + 'a option -> + 'a + +val assoc_by_int : + (int * 'a) list -> + int -> + 'a option -> + 'a + + +val nth_opt : 'a list -> int -> 'a option + +val iter_snd : ('a * 'b) list -> ('b -> unit) -> unit + +val iter_fst : ('a * 'b) list -> ('a -> unit) -> unit + +val exists : 'a list -> ('a -> bool) -> bool +val exists_snd : ('a * 'b) list -> ('b -> bool) -> bool + +val concat_append: + 'a list list -> + 'a list -> + 'a list + +val fold_left2: + 'a list -> + 'b list -> + 'c -> + ('a -> 'b -> 'c -> 'c) + -> 'c + +val fold_left: + 'a list -> + 'b -> + ('b -> 'a -> 'b) -> + 'b + +val singleton_exn: + 'a list -> 'a +end = struct +#1 "ext_list.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 rec map l f = + match l with + | [] -> + [] + | [x1] -> + let y1 = f x1 in + [y1] + | [x1; x2] -> + let y1 = f x1 in + let y2 = f x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::x5::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + y1::y2::y3::y4::y5::(map tail f) + +let rec has_string l f = + match l with + | [] -> + false + | [x1] -> + x1 = f + | [x1; x2] -> + x1 = f || x2 = f + | [x1; x2; x3] -> + x1 = f || x2 = f || x3 = f + | x1 :: x2 :: x3 :: x4 -> + x1 = f || x2 = f || x3 = f || has_string x4 f + + +let rec map_split_opt + (xs : 'a list) (f : 'a -> 'b option * 'c option) + : 'b list * 'c list = + match xs with + | [] -> [], [] + | x::xs -> + let c,d = f x in + let cs,ds = map_split_opt xs f in + (match c with Some c -> c::cs | None -> cs), + (match d with Some d -> d::ds | None -> ds) + +let rec map_snd l f = + match l with + | [] -> + [] + | [ v1,x1 ] -> + let y1 = f x1 in + [v1,y1] + | [v1, x1; v2, x2] -> + let y1 = f x1 in + let y2 = f x2 in + [v1, y1; v2, y2] + | [ v1, x1; v2, x2; v3, x3] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + [v1, y1; v2, y2; v3, y3] + | [ v1, x1; v2, x2; v3, x3; v4, x4] -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + [v1, y1; v2, y2; v3, y3; v4, y4] + | (v1, x1) ::(v2, x2) :: (v3, x3)::(v4, x4) :: (v5, x5) ::tail -> + let y1 = f x1 in + let y2 = f x2 in + let y3 = f x3 in + let y4 = f x4 in + let y5 = f x5 in + (v1, y1)::(v2, y2) :: (v3, y3) :: (v4, y4) :: (v5, y5) :: (map_snd tail f) + + +let rec map_last l f= + match l with + | [] -> + [] + | [x1] -> + let y1 = f true x1 in + [y1] + | [x1; x2] -> + let y1 = f false x1 in + let y2 = f true x2 in + [y1; y2] + | [x1; x2; x3] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f true x3 in + [y1; y2; y3] + | [x1; x2; x3; x4] -> + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f true x4 in + [y1; y2; y3; y4] + | x1::x2::x3::x4::tail -> + (* make sure that tail is not empty *) + let y1 = f false x1 in + let y2 = f false x2 in + let y3 = f false x3 in + let y4 = f false x4 in + y1::y2::y3::y4::(map_last tail f) + +let rec mapi_aux lst i f = + match lst with + [] -> [] + | a::l -> + let r = f i a in r :: mapi_aux l (i + 1) f + +let mapi lst f = mapi_aux lst 0 f + +let rec last xs = + match xs with + | [x] -> x + | _ :: tl -> last tl + | [] -> invalid_arg "Ext_list.last" + + + +let rec append_aux l1 l2 = + match l1 with + | [] -> l2 + | [a0] -> a0::l2 + | [a0;a1] -> a0::a1::l2 + | [a0;a1;a2] -> a0::a1::a2::l2 + | [a0;a1;a2;a3] -> a0::a1::a2::a3::l2 + | [a0;a1;a2;a3;a4] -> a0::a1::a2::a3::a4::l2 + | a0::a1::a2::a3::a4::rest -> a0::a1::a2::a3::a4::append_aux rest l2 + +let append l1 l2 = + match l2 with + | [] -> l1 + | _ -> append_aux l1 l2 + +let append_one l1 x = append_aux l1 [x] + +let rec map_append l1 l2 f = + match l1 with + | [] -> l2 + | [a0] -> f a0::l2 + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + b0::b1::l2 + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + b0::b1::b2::l2 + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + b0::b1::b2::b3::l2 + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::l2 + + | a0::a1::a2::a3::a4::rest -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + b0::b1::b2::b3::b4::map_append rest l2 f + + + +let rec fold_right l acc f = + match l with + | [] -> acc + | [a0] -> f a0 acc + | [a0;a1] -> f a0 (f a1 acc) + | [a0;a1;a2] -> f a0 (f a1 (f a2 acc)) + | [a0;a1;a2;a3] -> f a0 (f a1 (f a2 (f a3 acc))) + | [a0;a1;a2;a3;a4] -> + f a0 (f a1 (f a2 (f a3 (f a4 acc)))) + | a0::a1::a2::a3::a4::rest -> + f a0 (f a1 (f a2 (f a3 (f a4 (fold_right rest acc f ))))) + +let rec fold_right2 l r acc f = + match l,r with + | [],[] -> acc + | [a0],[b0] -> f a0 b0 acc + | [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc) + | [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc)) + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc))) + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc)))) + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f ))))) + | _, _ -> invalid_arg "Ext_list.fold_right2" + +let rec map2 l r f = + match l,r with + | [],[] -> [] + | [a0],[b0] -> [f a0 b0] + | [a0;a1],[b0;b1] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + [c0; c1] + | [a0;a1;a2],[b0;b1;b2] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + [c0;c1;c2] + | [a0;a1;a2;a3],[b0;b1;b2;b3] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + [c0;c1;c2;c3] + | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + [c0;c1;c2;c3;c4] + | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> + let c0 = f a0 b0 in + let c1 = f a1 b1 in + let c2 = f a2 b2 in + let c3 = f a3 b3 in + let c4 = f a4 b4 in + c0::c1::c2::c3::c4::map2 arest brest f + | _, _ -> invalid_arg "Ext_list.map2" + +let rec fold_left_with_offset l accu i f = + match l with + | [] -> accu + | a::l -> + fold_left_with_offset + l + (f a accu i) + (i + 1) + f + + +let rec filter_map xs (f: 'a -> 'b option)= + match xs with + | [] -> [] + | y :: ys -> + begin match f y with + | None -> filter_map ys f + | Some z -> z :: filter_map ys f + end + +let rec exclude (xs : 'a list) (p : 'a -> bool) : 'a list = + match xs with + | [] -> [] + | x::xs -> + if p x then exclude xs p + else x:: exclude xs p + +let rec exclude_with_val l p = + match l with + | [] -> None + | a0::xs -> + if p a0 then Some (exclude xs p) + else + match xs with + | [] -> None + | a1::rest -> + if p a1 then + Some (a0:: exclude rest p) + else + match exclude_with_val rest p with + | None -> None + | Some rest -> Some (a0::a1::rest) + + + +let rec same_length xs ys = + match xs, ys with + | [], [] -> true + | _::xs, _::ys -> same_length xs ys + | _, _ -> false + + +let init n f = + match n with + | 0 -> [] + | 1 -> + let a0 = f 0 in + [a0] + | 2 -> + let a0 = f 0 in + let a1 = f 1 in + [a0; a1] + | 3 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + [a0; a1; a2] + | 4 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + [a0; a1; a2; a3] + | 5 -> + let a0 = f 0 in + let a1 = f 1 in + let a2 = f 2 in + let a3 = f 3 in + let a4 = f 4 in + [a0; a1; a2; a3; a4] + | _ -> + Array.to_list (Array.init n f) + +let rec small_split_at n acc l = + if n <= 0 then List.rev acc , l + else + match l with + | x::xs -> small_split_at (n - 1) (x ::acc) xs + | _ -> invalid_arg "Ext_list.split_at" + +let split_at l n = + small_split_at n [] l + +let rec split_at_last_aux acc x = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [ x] -> List.rev acc, x + | y0::ys -> split_at_last_aux (y0::acc) ys + +let split_at_last (x : 'a list) = + match x with + | [] -> invalid_arg "Ext_list.split_at_last" + | [a0] -> + [], a0 + | [a0;a1] -> + [a0], a1 + | [a0;a1;a2] -> + [a0;a1], a2 + | [a0;a1;a2;a3] -> + [a0;a1;a2], a3 + | [a0;a1;a2;a3;a4] -> + [a0;a1;a2;a3], a4 + | a0::a1::a2::a3::a4::rest -> + let rev, last = split_at_last_aux [] rest + in + a0::a1::a2::a3::a4:: rev , last + +(** + can not do loop unroll due to state combination +*) +let filter_mapi xs f = + let rec aux i xs = + match xs with + | [] -> [] + | y :: ys -> + begin match f y i with + | None -> aux (i + 1) ys + | Some z -> z :: aux (i + 1) ys + end in + aux 0 xs + +let rec filter_map2 xs ys (f: 'a -> 'b -> 'c option) = + match xs,ys with + | [],[] -> [] + | u::us, v :: vs -> + begin match f u v with + | None -> filter_map2 us vs f (* idea: rec f us vs instead? *) + | Some z -> z :: filter_map2 us vs f + end + | _ -> invalid_arg "Ext_list.filter_map2" + + +let rec rev_map_append l1 l2 f = + match l1 with + | [] -> l2 + | a :: l -> rev_map_append l (f a :: l2) f + + +let rec rev_append l1 l2 = + match l1 with + [] -> l2 + | a :: l -> rev_append l (a :: l2) + +(** It is not worth loop unrolling, + it is already tail-call, and we need to be careful + about evaluation order when unroll +*) +let rec flat_map_aux f acc append lx = + match lx with + | [] -> rev_append acc append + | a0::rest -> flat_map_aux f (rev_append (f a0) acc ) append rest + +let flat_map lx f = + flat_map_aux f [] [] lx + +let flat_map_append lx append f = + flat_map_aux f [] append lx + + +let rec length_compare l n = + if n < 0 then `Gt + else + begin match l with + | _ ::xs -> length_compare xs (n - 1) + | [] -> + if n = 0 then `Eq + else `Lt + end + +let rec length_ge l n = + if n > 0 then + match l with + | _ :: tl -> length_ge tl (n - 1) + | [] -> false + else true +(** + + {[length xs = length ys + n ]} +*) +let rec length_larger_than_n xs ys n = + match xs, ys with + | _, [] -> length_compare xs n = `Eq + | _::xs, _::ys -> + length_larger_than_n xs ys n + | [], _ -> false + + + + +let rec group (eq : 'a -> 'a -> bool) lst = + match lst with + | [] -> [] + | x::xs -> + aux eq x (group eq xs ) + +and aux eq (x : 'a) (xss : 'a list list) : 'a list list = + match xss with + | [] -> [[x]] + | (y0::_ as y)::ys -> (* cannot be empty *) + if eq x y0 then + (x::y) :: ys + else + y :: aux eq x ys + | _ :: _ -> assert false + +let stable_group lst eq = group eq lst |> List.rev + +let rec drop h n = + if n < 0 then invalid_arg "Ext_list.drop" + else + if n = 0 then h + else + match h with + | [] -> + invalid_arg "Ext_list.drop" + | _ :: tl -> + drop tl (n - 1) + +let rec find_first x p = + match x with + | [] -> None + | x :: l -> + if p x then Some x + else find_first l p + +let rec find_first_not xs p = + match xs with + | [] -> None + | a::l -> + if p a + then find_first_not l p + else Some a + + +let rec rev_iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x2 ; f x1 + | [x1; x2; x3] -> + f x3 ; f x2 ; f x1 + | [x1; x2; x3; x4] -> + f x4; f x3; f x2; f x1 + | x1::x2::x3::x4::x5::tail -> + rev_iter tail f; + f x5; f x4 ; f x3; f x2 ; f x1 + +let rec iter l f = + match l with + | [] -> () + | [x1] -> + f x1 + | [x1; x2] -> + f x1 ; f x2 + | [x1; x2; x3] -> + f x1 ; f x2 ; f x3 + | [x1; x2; x3; x4] -> + f x1; f x2; f x3; f x4 + | x1::x2::x3::x4::x5::tail -> + f x1; f x2 ; f x3; f x4 ; f x5; + iter tail f + + +let rec for_all lst p = + match lst with + [] -> true + | a::l -> p a && for_all l p + +let rec for_all_snd lst p = + match lst with + [] -> true + | (_,a)::l -> p a && for_all_snd l p + + +let rec for_all2_no_exn l1 l2 p = + match (l1, l2) with + | ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_no_exn l1 l2 p + | (_, _) -> false + + +let rec find_opt xs p = + match xs with + | [] -> None + | x :: l -> + match p x with + | Some _ as v -> v + | None -> find_opt l p + + + +let rec split_map l f = + match l with + | [] -> + [],[] + | [x1] -> + let a0,b0 = f x1 in + [a0],[b0] + | [x1; x2] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + [a1;a2],[b1;b2] + | [x1; x2; x3] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + [a1;a2;a3], [b1;b2;b3] + | [x1; x2; x3; x4] -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + [a1;a2;a3;a4], [b1;b2;b3;b4] + | x1::x2::x3::x4::x5::tail -> + let a1,b1 = f x1 in + let a2,b2 = f x2 in + let a3,b3 = f x3 in + let a4,b4 = f x4 in + let a5,b5 = f x5 in + let ass,bss = split_map tail f in + a1::a2::a3::a4::a5::ass, + b1::b2::b3::b4::b5::bss + + + + +let sort_via_array lst cmp = + let arr = Array.of_list lst in + Array.sort cmp arr; + Array.to_list arr + + + + +let rec assoc_by_string lst (k : string) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if Ext_string.equal k1 k then v1 else + assoc_by_string rest k def + +let rec assoc_by_int lst (k : int) def = + match lst with + | [] -> + begin match def with + | None -> assert false + | Some x -> x end + | (k1,v1)::rest -> + if k1 = k then v1 else + assoc_by_int rest k def + + +let rec nth_aux l n = + match l with + | [] -> None + | a::l -> if n = 0 then Some a else nth_aux l (n-1) + +let nth_opt l n = + if n < 0 then None + else + nth_aux l n + +let rec iter_snd lst f = + match lst with + | [] -> () + | (_,x)::xs -> + f x ; + iter_snd xs f + +let rec iter_fst lst f = + match lst with + | [] -> () + | (x,_)::xs -> + f x ; + iter_fst xs f + +let rec exists l p = + match l with + [] -> false + | x :: xs -> p x || exists xs p + +let rec exists_snd l p = + match l with + [] -> false + | (_, a)::l -> p a || exists_snd l p + +let rec concat_append + (xss : 'a list list) + (xs : 'a list) : 'a list = + match xss with + | [] -> xs + | l::r -> append l (concat_append r xs) + +let rec fold_left l accu f = + match l with + [] -> accu + | a::l -> fold_left l (f accu a) f + +let reduce_from_left lst fn = + match lst with + | first :: rest -> fold_left rest first fn + | _ -> invalid_arg "Ext_list.reduce_from_left" + +let rec fold_left2 l1 l2 accu f = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> fold_left2 l1 l2 (f a1 a2 accu) f + | (_, _) -> invalid_arg "List.fold_left2" + +let singleton_exn xs = match xs with [x] -> x | _ -> assert false + + +end +module Ast_compatible : sig +#1 "ast_compatible.mli" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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. *) + + +type poly_var_label = Asttypes.label Asttypes.loc +type arg_label = Asttypes.arg_label +type label = arg_label +external convert: arg_label -> label = "%identity" + + + + +val no_label: arg_label + +type loc = Location.t +type attrs = Parsetree.attribute list +open Parsetree + + +val const_exp_string: + ?loc:Location.t -> + ?attrs:attrs -> + ?delimiter:string -> + string -> + expression + +val const_exp_int: + ?loc:Location.t -> + ?attrs:attrs -> + int -> + expression + +val const_exp_int_list_as_array: + int list -> + expression + +val const_exp_string_list_as_array: + string list -> + expression + + +val apply_simple: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression list -> + expression + +val app1: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression + +val app2: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression -> + expression + +val app3: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + expression -> + expression -> + expression -> + expression + +(** Note this function would slightly + change its semantics depending on compiler versions + for newer version: it means always label + for older version: it could be optional (which we should avoid) +*) +val apply_labels: + ?loc:Location.t -> + ?attrs:attrs -> + expression -> + (string * expression) list -> + (* [(label,e)] [label] is strictly interpreted as label *) + expression + +val fun_ : + ?loc:Location.t -> + ?attrs:attrs -> + pattern -> + expression -> + expression + +val is_arg_label_simple : + arg_label -> bool + +val arrow : + ?loc:Location.t -> + ?attrs:attrs -> + core_type -> + core_type -> + core_type + +val label_arrow : + ?loc:Location.t -> + ?attrs:attrs -> + string -> + core_type -> + core_type -> + core_type + +val opt_arrow: + ?loc:Location.t -> + ?attrs:attrs -> + string -> + core_type -> + core_type -> + core_type + +val object_: + ?loc:loc -> + ?attrs:attrs -> + (string * attributes * core_type) list -> + (*FIXME shall we use [string loc] instead?*) + Asttypes.closed_flag -> + core_type + +val rec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val nonrec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val rec_type_str: + ?loc:loc -> + type_declaration list -> + structure_item + +val nonrec_type_sig: + ?loc:loc -> + type_declaration list -> + signature_item + +val rec_type_sig: + ?loc:loc -> + type_declaration list -> + signature_item + +val mk_fn_type: + (arg_label * core_type * attributes * loc) list -> + core_type -> + core_type + +type object_field = + + Parsetree.object_field +val object_field : Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field + + +val hash_label : poly_var_label -> int +val label_of_name : poly_var_label -> string + +type args = + (arg_label * Parsetree.expression) list + +end = struct +#1 "ast_compatible.ml" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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. *) + +type loc = Location.t +type attrs = Parsetree.attribute list +open Parsetree +let default_loc = Location.none + + +type poly_var_label = Asttypes.label Asttypes.loc + +type arg_label = Asttypes.arg_label = + | Nolabel + | Labelled of string + | Optional of string +let no_label : arg_label = Nolabel +let is_arg_label_simple (s : arg_label) = s = (Nolabel : arg_label) +type label = arg_label +external convert : arg_label -> label = "%identity" + + +let arrow ?(loc=default_loc) ?(attrs = []) a b = + Ast_helper.Typ.arrow ~loc ~attrs no_label a b + +let apply_simple + ?(loc = default_loc) + ?(attrs = []) + fn args : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + (Ext_list.map args (fun x -> no_label, x) ) ) } + +let app1 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [no_label, arg1] + ) } + +let app2 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 arg2 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [ + no_label, arg1; + no_label, arg2 ] + ) } + +let app3 + ?(loc = default_loc) + ?(attrs = []) + fn arg1 arg2 arg3 : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + [ + no_label, arg1; + no_label, arg2; + no_label, arg3 + ] + ) } + +let fun_ + ?(loc = default_loc) + ?(attrs = []) + pat + exp = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_fun(no_label,None, pat, exp) + } + + + + +let const_exp_string + ?(loc = default_loc) + ?(attrs = []) + ?delimiter + (s : string) : expression = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_constant(Pconst_string(s,delimiter)) + } + + +let const_exp_int + ?(loc = default_loc) + ?(attrs = []) + (s : int) : expression = + { + pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = Pexp_constant(Pconst_integer (string_of_int s, None)) + } + + +let apply_labels + ?(loc = default_loc) + ?(attrs = []) + fn (args : (string * expression) list) : expression = + { pexp_loc = loc; + pexp_attributes = attrs; + pexp_desc = + Pexp_apply( + fn, + Ext_list.map args (fun (l,a) -> Asttypes.Labelled l, a) ) } + +let object_ + ?(loc= default_loc) + ?(attrs = []) + (fields : (string * attributes * core_type) list) + (* FIXME after upgrade *) + flg : core_type = + { + ptyp_desc = + Ptyp_object( + Ext_list.map fields (fun (a,b,c) -> + Parsetree.Otag ({txt = a; loc = c.ptyp_loc},b,c)),flg); + ptyp_loc = loc; + ptyp_attributes = attrs + } + + + +let label_arrow ?(loc=default_loc) ?(attrs=[]) s a b : core_type = + { + ptyp_desc = Ptyp_arrow( + + Asttypes.Labelled s + + , + a, + b); + ptyp_loc = loc; + ptyp_attributes = attrs + } + +let opt_arrow ?(loc=default_loc) ?(attrs=[]) s a b : core_type = + { + ptyp_desc = Ptyp_arrow( + + Asttypes.Optional s + + , + a, + b); + ptyp_loc = loc; + ptyp_attributes = attrs + } + +let rec_type_str ?(loc=default_loc) tds : structure_item = + { + pstr_loc = loc; + pstr_desc = Pstr_type ( + + Recursive, + + tds) + } + +let nonrec_type_str ?(loc=default_loc) tds : structure_item = + { + pstr_loc = loc; + pstr_desc = Pstr_type ( + + Nonrecursive, + + tds) + } + +let rec_type_sig ?(loc=default_loc) tds : signature_item = + { + psig_loc = loc; + psig_desc = Psig_type ( + + Recursive, + + tds) + } + +(* FIXME: need address migration of `[@nonrec]` attributes in older ocaml *) +let nonrec_type_sig ?(loc=default_loc) tds : signature_item = + { + psig_loc = loc; + psig_desc = Psig_type ( + + Nonrecursive, + + tds) + } + + +let const_exp_int_list_as_array xs = + Ast_helper.Exp.array + (Ext_list.map xs (fun x -> const_exp_int x )) + +let const_exp_string_list_as_array xs = + Ast_helper.Exp.array + (Ext_list.map xs (fun x -> const_exp_string x ) ) + + + let mk_fn_type + (new_arg_types_ty : (arg_label * core_type * attributes * loc) list) + (result : core_type) : core_type = + Ext_list.fold_right new_arg_types_ty result (fun (label, ty, attrs, loc) acc -> + { + ptyp_desc = Ptyp_arrow(label,ty,acc); + ptyp_loc = loc; + ptyp_attributes = attrs + } + ) + +type object_field = + + Parsetree.object_field + + +let object_field l attrs ty = + + Parsetree.Otag + (l,attrs,ty) + + + +let hash_label (x : poly_var_label) : int = Ext_pervasives.hash_variant x.txt +let label_of_name (x : poly_var_label) : string = x.txt + + +type args = + (arg_label * Parsetree.expression) list + +end +module Ext_utf8 : sig +#1 "ext_utf8.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. *) + +type byte = + | Single of int + | Cont of int + | Leading of int * int + | Invalid + + +val classify : char -> byte + +val follow : + string -> + int -> + int -> + int -> + int * int + + +(** + return [-1] if failed +*) +val next : string -> remaining:int -> int -> int + + +exception Invalid_utf8 of string + + +val decode_utf8_string : string -> int list +end = struct +#1 "ext_utf8.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. *) + +type byte = + | Single of int + | Cont of int + | Leading of int * int + | Invalid + +(** [classify chr] returns the {!byte} corresponding to [chr] *) +let classify chr = + let c = int_of_char chr in + (* Classify byte according to leftmost 0 bit *) + if c land 0b1000_0000 = 0 then Single c else + (* c 0b0____*) + if c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111) else + (* c 0b10___*) + if c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111) else + (* c 0b110__*) + if c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111) else + (* c 0b1110_ *) + if c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111) else + (* c 0b1111_0___*) + if c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011) else + (* c 0b1111_10__*) + if c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001) + (* c 0b1111_110__ *) + else Invalid + +exception Invalid_utf8 of string + +(* when the first char is [Leading], + TODO: need more error checking + when out of bond + *) +let rec follow s n (c : int) offset = + if n = 0 then (c, offset) + else + begin match classify s.[offset+1] with + | Cont cc -> follow s (n-1) ((c lsl 6) lor (cc land 0x3f)) (offset+1) + | _ -> raise (Invalid_utf8 "Continuation byte expected") + end + + +let rec next s ~remaining offset = + if remaining = 0 then offset + else + begin match classify s.[offset+1] with + | Cont cc -> next s ~remaining:(remaining-1) (offset+1) + | _ -> -1 + | exception _ -> -1 (* it can happen when out of bound *) + end + + + + +let decode_utf8_string s = + let lst = ref [] in + let add elem = lst := elem :: !lst in + let rec decode_utf8_cont s i s_len = + if i = s_len then () + else + begin + match classify s.[i] with + | Single c -> + add c; decode_utf8_cont s (i+1) s_len + | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte") + | Leading (n, c) -> + let (c', i') = follow s n c i in add c'; + decode_utf8_cont s (i' + 1) s_len + | Invalid -> raise (Invalid_utf8 "Invalid byte") + end + in decode_utf8_cont s 0 (String.length s); + List.rev !lst + + +(** To decode {j||j} we need verify in the ast so that we have better error + location, then we do the decode later +*) + +let verify s loc = + assert false +end +module Ext_js_regex : sig +#1 "ext_js_regex.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. *) + +(* This is a module that checks if js regex is valid or not *) + +val js_regex_checker : string -> bool +end = struct +#1 "ext_js_regex.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 check_from_end al = + let rec aux l seen = + match l with + | [] -> false + | (e::r) -> + if e < 0 || e > 255 then false + else (let c = Char.chr e in + if c = '/' then true + else (if List.exists (fun x -> x = c) seen then false (* flag should not be repeated *) + else (if c = 'i' || c = 'g' || c = 'm' || c = 'y' || c ='u' then aux r (c::seen) + else false))) + in aux al [] + +let js_regex_checker s = + match Ext_utf8.decode_utf8_string s with + | [] -> false + | 47 (* [Char.code '/' = 47 ]*)::tail -> + check_from_end (List.rev tail) + | _ :: _ -> false + | exception Ext_utf8.Invalid_utf8 _ -> false + +end +module Ext_array : sig +#1 "ext_array.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. *) + + + + + + +(** Some utilities for {!Array} operations *) +val reverse_range : 'a array -> int -> int -> unit +val reverse_in_place : 'a array -> unit +val reverse : 'a array -> 'a array +val reverse_of_list : 'a list -> 'a array + +val filter : ('a -> bool) -> 'a array -> 'a array + +val filter_map : ('a -> 'b option) -> 'a array -> 'b array + +val range : int -> int -> int array + +val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array + +val to_list_f : ('a -> 'b) -> 'a array -> 'b list +val to_list_map : ('a -> 'b option) -> 'a array -> 'b list + +val to_list_map_acc : + 'a array -> + 'b list -> + ('a -> 'b option) -> + 'b list + +val of_list_map : + 'a list -> + ('a -> 'b) -> + 'b array + +val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int + + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] + +val rfind_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val find_and_split : + 'a array -> + ('a -> 'b -> bool) -> + 'b -> 'a split + +val exists : ('a -> bool) -> 'a array -> bool + +val is_empty : 'a array -> bool + +val for_all2_no_exn : + 'a array -> + 'b array -> + ('a -> 'b -> bool) -> + bool + +val map : + 'a array -> + ('a -> 'b) -> + 'b array + +val iter : + 'a array -> + ('a -> unit) -> + unit + +val fold_left : + 'b array -> + 'a -> + ('a -> 'b -> 'a) -> + 'a +end = struct +#1 "ext_array.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 reverse_range a i len = + if len = 0 then () + else + for k = 0 to (len-1)/2 do + let t = Array.unsafe_get a (i+k) in + Array.unsafe_set a (i+k) ( Array.unsafe_get a (i+len-1-k)); + Array.unsafe_set a (i+len-1-k) t; + done + + +let reverse_in_place a = + reverse_range a 0 (Array.length a) + +let reverse a = + let b_len = Array.length a in + if b_len = 0 then [||] else + let b = Array.copy a in + for i = 0 to b_len - 1 do + Array.unsafe_set b i (Array.unsafe_get a (b_len - 1 -i )) + done; + b + +let reverse_of_list = function + | [] -> [||] + | hd::tl as l -> + let len = List.length l in + let a = Array.make len hd in + let rec fill i = function + | [] -> a + | hd::tl -> Array.unsafe_set a (len - i - 2) hd; fill (i+1) tl in + fill 0 tl + +let filter f a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + if f v then + aux (v::acc) (i+1) + else aux acc (i + 1) + in aux [] 0 + + +let filter_map (f : _ -> _ option) a = + let arr_len = Array.length a in + let rec aux acc i = + if i = arr_len + then reverse_of_list acc + else + let v = Array.unsafe_get a i in + match f v with + | Some v -> + aux (v::acc) (i+1) + | None -> + aux acc (i + 1) + in aux [] 0 + +let range from to_ = + if from > to_ then invalid_arg "Ext_array.range" + else Array.init (to_ - from + 1) (fun i -> i + from) + +let map2i f a b = + let len = Array.length a in + if len <> Array.length b then + invalid_arg "Ext_array.map2i" + else + Array.mapi (fun i a -> f i a ( Array.unsafe_get b i )) a + +let rec tolist_f_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_f_aux a f (i - 1) + (f v :: res) + +let to_list_f f a = tolist_f_aux a f (Array.length a - 1) [] + +let rec tolist_aux a f i res = + if i < 0 then res else + let v = Array.unsafe_get a i in + tolist_aux a f (i - 1) + (match f v with + | Some v -> v :: res + | None -> res) + +let to_list_map f a = + tolist_aux a f (Array.length a - 1) [] + +let to_list_map_acc a acc f = + tolist_aux a f (Array.length a - 1) acc + + +let of_list_map a f = + match a with + | [] -> [||] + | [a0] -> + let b0 = f a0 in + [|b0|] + | [a0;a1] -> + let b0 = f a0 in + let b1 = f a1 in + [|b0;b1|] + | [a0;a1;a2] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + [|b0;b1;b2|] + | [a0;a1;a2;a3] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + [|b0;b1;b2;b3|] + | [a0;a1;a2;a3;a4] -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + [|b0;b1;b2;b3;b4|] + + | a0::a1::a2::a3::a4::tl -> + let b0 = f a0 in + let b1 = f a1 in + let b2 = f a2 in + let b3 = f a3 in + let b4 = f a4 in + let len = List.length tl + 5 in + let arr = Array.make len b0 in + Array.unsafe_set arr 1 b1 ; + Array.unsafe_set arr 2 b2 ; + Array.unsafe_set arr 3 b3 ; + Array.unsafe_set arr 4 b4 ; + let rec fill i = function + | [] -> arr + | hd :: tl -> + Array.unsafe_set arr i (f hd); + fill (i + 1) tl in + fill 5 tl + +(** + {[ + # rfind_with_index [|1;2;3|] (=) 2;; + - : int = 1 + # rfind_with_index [|1;2;3|] (=) 1;; + - : int = 0 + # rfind_with_index [|1;2;3|] (=) 3;; + - : int = 2 + # rfind_with_index [|1;2;3|] (=) 4;; + - : int = -1 + ]} +*) +let rfind_with_index arr cmp v = + let len = Array.length arr in + let rec aux i = + if i < 0 then i + else if cmp (Array.unsafe_get arr i) v then i + else aux (i - 1) in + aux (len - 1) + +type 'a split = [ `No_split | `Split of 'a array * 'a array ] +let rfind_and_split arr cmp v : _ split = + let i = rfind_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i , Array.sub arr (i + 1 ) (Array.length arr - i - 1 )) + + +let find_with_index arr cmp v = + let len = Array.length arr in + let rec aux i len = + if i >= len then -1 + else if cmp (Array.unsafe_get arr i ) v then i + else aux (i + 1) len in + aux 0 len + +let find_and_split arr cmp v : _ split = + let i = find_with_index arr cmp v in + if i < 0 then + `No_split + else + `Split (Array.sub arr 0 i, Array.sub arr (i + 1 ) (Array.length arr - i - 1)) + +(** TODO: available since 4.03, use {!Array.exists} *) + +let exists p a = + let n = Array.length a in + let rec loop i = + if i = n then false + else if p (Array.unsafe_get a i) then true + else loop (succ i) in + loop 0 + + +let is_empty arr = + Array.length arr = 0 + + +let rec unsafe_loop index len p xs ys = + if index >= len then true + else + p + (Array.unsafe_get xs index) + (Array.unsafe_get ys index) && + unsafe_loop (succ index) len p xs ys + +let for_all2_no_exn xs ys p = + let len_xs = Array.length xs in + let len_ys = Array.length ys in + len_xs = len_ys && + unsafe_loop 0 len_xs p xs ys + + +let map a f = + let open Array in + let l = length a in + if l = 0 then [||] else begin + let r = make l (f(unsafe_get a 0)) in + for i = 1 to l - 1 do + unsafe_set r i (f(unsafe_get a i)) + done; + r + end + +let iter a f = + let open Array in + for i = 0 to length a - 1 do f(unsafe_get a i) done + + + let fold_left a x f = + let open Array in + let r = ref x in + for i = 0 to length a - 1 do + r := f !r (unsafe_get a i) + done; + !r + +end +module Map_gen += struct +#1 "map_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. *) +(* *) +(***********************************************************************) +(** adapted from stdlib *) + +type ('key,'a) t = + | Empty + | Node of ('key,'a) t * 'key * 'a * ('key,'a) t * int + +type ('key,'a) enumeration = + | End + | More of 'key * 'a * ('key,'a) t * ('key, 'a) enumeration + +let rec cardinal_aux acc = function + | Empty -> acc + | Node (l,_,_,r, _) -> + cardinal_aux (cardinal_aux (acc + 1) r ) l + +let cardinal s = cardinal_aux 0 s + +let rec bindings_aux accu = function + | Empty -> accu + | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l + +let bindings s = + bindings_aux [] s + + +let rec fill_array_aux (s : _ t) i arr : int = + match s with + | Empty -> i + | Node (l,k,v,r,_) -> + let inext = fill_array_aux l i arr in + Array.unsafe_set arr inext (k,v); + fill_array_aux r (inext + 1) arr + +let to_sorted_array (s : ('key,'a) t) : ('key * 'a ) array = + match s with + | Empty -> [||] + | Node(l,k,v,r,_) -> + let len = + cardinal_aux (cardinal_aux 1 r) l in + let arr = + Array.make len (k,v) in + ignore (fill_array_aux s 0 arr : int); + arr +let rec keys_aux accu = function + Empty -> accu + | Node(l, v, _, r, _) -> keys_aux (v :: keys_aux accu r) l + +let keys s = keys_aux [] s + + + +let rec cons_enum m e = + match m with + Empty -> e + | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e)) + + +let height = function + | Empty -> 0 + | Node(_,_,_,_,h) -> h + +let create l x d r = + let hl = height l and hr = height r in + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let singleton x d = Node(Empty, x, d, Empty, 1) + +let bal l x d r = + let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in + let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in + if hl > hr + 2 then begin + match l with + Empty -> invalid_arg "Map.bal" + | Node(ll, lv, ld, lr, _) -> + if height ll >= height lr then + create ll lv ld (create lr x d r) + else begin + match lr with + Empty -> invalid_arg "Map.bal" + | Node(lrl, lrv, lrd, lrr, _)-> + create (create ll lv ld lrl) lrv lrd (create lrr x d r) + end + end else if hr > hl + 2 then begin + match r with + Empty -> invalid_arg "Map.bal" + | Node(rl, rv, rd, rr, _) -> + if height rr >= height rl then + create (create l x d rl) rv rd rr + else begin + match rl with + Empty -> invalid_arg "Map.bal" + | Node(rll, rlv, rld, rlr, _) -> + create (create l x d rll) rlv rld (create rlr rv rd rr) + end + end else + Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + +let empty = Empty + +let is_empty = function Empty -> true | _ -> false + +let rec min_binding_exn = function + Empty -> raise Not_found + | Node(Empty, x, d, r, _) -> (x, d) + | Node(l, x, d, r, _) -> min_binding_exn l + +let choose = min_binding_exn + +let rec max_binding_exn = function + Empty -> raise Not_found + | Node(l, x, d, Empty, _) -> (x, d) + | Node(l, x, d, r, _) -> max_binding_exn r + +let rec remove_min_binding = function + Empty -> invalid_arg "Map.remove_min_elt" + | Node(Empty, x, d, r, _) -> r + | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r + +let merge t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + bal t1 x d (remove_min_binding t2) + + +let rec iter x f = match x with + Empty -> () + | Node(l, v, d, r, _) -> + iter l f; f v d; iter r f + +let rec map x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = map l f in + let d' = f d in + let r' = map r f in + Node(l', v, d', r', h) + +let rec mapi x f = match x with + Empty -> + Empty + | Node(l, v, d, r, h) -> + let l' = mapi l f in + let d' = f v d in + let r' = mapi r f in + Node(l', v, d', r', h) + +let rec fold m accu f = + match m with + Empty -> accu + | Node(l, v, d, r, _) -> + fold r (f v d (fold l accu f)) f + +let rec for_all x p = match x with + Empty -> true + | Node(l, v, d, r, _) -> p v d && for_all l p && for_all r p + +let rec exists x p = match x with + Empty -> false + | Node(l, v, d, r, _) -> p v d || exists l p || exists r p + +(* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal (add_min_binding k v l) x d r + +let rec add_max_binding k v = function + | Empty -> singleton k v + | Node (l, x, d, r, h) -> + bal l x d (add_max_binding k v r) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v d r = + match (l, r) with + (Empty, _) -> add_min_binding v d r + | (_, Empty) -> add_max_binding v d l + | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) -> + if lh > rh + 2 then bal ll lv ld (join lr v d r) else + if rh > lh + 2 then bal (join l v d rl) rv rd rr else + create l v d r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding_exn t2 in + join t1 x d (remove_min_binding t2) + +let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + +let rec filter x p = match x with + Empty -> Empty + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let l' = filter l p in + let pvd = p v d in + let r' = filter r p in + if pvd then join l' v d r' else concat l' r' + +let rec partition x p = match x with + Empty -> (Empty, Empty) + | Node(l, v, d, r, _) -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition l p in + let pvd = p v d in + let (rt, rf) = partition r p in + if pvd + then (join lt v d rt, concat lf rf) + else (concat lt rt, join lf v d rf) + +let compare compare_key cmp_val m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + let c = compare_key v1 v2 in + if c <> 0 then c else + let c = cmp_val d1 d2 in + if c <> 0 then c else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in compare_aux (cons_enum m1 End) (cons_enum m2 End) + +let equal compare_key cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + compare_key v1 v2 = 0 && cmp d1 d2 && + equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in equal_aux (cons_enum m1 End) (cons_enum m2 End) + + + + +module type S = + sig + type key + type +'a t + val empty: 'a t + val compare_key: key -> key -> int + val is_empty: 'a t -> bool + val mem: 'a t -> key -> bool + val to_sorted_array : + 'a t -> (key * 'a ) array + val add: 'a t -> key -> 'a -> 'a t + (** [add x y m] + If [x] was already bound in [m], its previous binding disappears. *) + val adjust: 'a t -> key -> ('a option-> 'a) -> 'a t + (** [adjust acc k replace ] if not exist [add (replace None ], otherwise + [add k v (replace (Some old))] + *) + val singleton: key -> 'a -> 'a t + + val remove: 'a t -> key -> 'a t + (** [remove x m] returns a map containing the same bindings as + [m], except for [x] which is unbound in the returned map. *) + + val merge: + 'a t -> 'b t -> + (key -> 'a option -> 'b option -> 'c option) -> 'c t + (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + and of [m2]. The presence of each such binding, and the corresponding + value, is determined with the function [f]. + @since 3.12.0 + *) + + val disjoint_merge : 'a t -> 'a t -> 'a t + (* merge two maps, will raise if they have the same key *) + val compare: 'a t -> 'a t -> ('a -> 'a -> int) -> int + (** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. *) + + val equal: 'a t -> 'a t -> ('a -> 'a -> bool) -> bool + + val iter: 'a t -> (key -> 'a -> unit) -> unit + (** [iter f m] applies [f] to all bindings in map [m]. + The bindings are passed to [f] in increasing order. *) + + val fold: 'a t -> 'b -> (key -> 'a -> 'b -> 'b) -> 'b + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1 ... kN] are the keys of all bindings in [m] + (in increasing order) *) + + val for_all: 'a t -> (key -> 'a -> bool) -> bool + (** [for_all p m] checks if all the bindings of the map. + order unspecified + *) + + val exists: 'a t -> (key -> 'a -> bool) -> bool + (** [exists p m] checks if at least one binding of the map + satisfy the predicate [p]. + order unspecified + *) + + val filter: 'a t -> (key -> 'a -> bool) -> 'a t + (** [filter p m] returns the map with all the bindings in [m] + that satisfy predicate [p]. + order unspecified + *) + + val partition: 'a t -> (key -> 'a -> bool) -> 'a t * 'a t + (** [partition p m] returns a pair of maps [(m1, m2)], where + [m1] contains all the bindings of [s] that satisfy the + predicate [p], and [m2] is the map with all the bindings of + [s] that do not satisfy [p]. + *) + + val cardinal: 'a t -> int + (** Return the number of bindings of a map. *) + + val bindings: 'a t -> (key * 'a) list + (** Return the list of all bindings of the given map. + The returned list is sorted in increasing order with respect + to the ordering *) + val keys : 'a t -> key list + (* Increasing order *) + + val min_binding_exn: 'a t -> (key * 'a) + (** raise [Not_found] if the map is empty. *) + + val max_binding_exn: 'a t -> (key * 'a) + (** Same as {!Map.S.min_binding} *) + + val choose: 'a t -> (key * 'a) + (** Return one binding of the given map, or raise [Not_found] if + the map is empty. Which binding is chosen is unspecified, + but equal bindings will be chosen for equal maps. + *) + + val split: 'a t -> key -> 'a t * 'a option * 'a t + (** [split x m] returns a triple [(l, data, r)], where + [l] is the map with all the bindings of [m] whose key + is strictly less than [x]; + [r] is the map with all the bindings of [m] whose key + is strictly greater than [x]; + [data] is [None] if [m] contains no binding for [x], + or [Some v] if [m] binds [v] to [x]. + @since 3.12.0 + *) + + val find_exn: 'a t -> key -> 'a + (** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. *) + val find_opt: 'a t -> key ->'a option + val find_default: 'a t -> key -> 'a -> 'a + val map: 'a t -> ('a -> 'b) -> 'b t + (** [map f m] returns a map with same domain as [m], where the + associated value [a] of all bindings of [m] has been + replaced by the result of the application of [f] to [a]. + The bindings are passed to [f] in increasing order + with respect to the ordering over the type of the keys. *) + + val mapi: 'a t -> (key -> 'a -> 'b) -> 'b t + (** Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. *) + + val of_list : (key * 'a) list -> 'a t + val of_array : (key * 'a ) array -> 'a t + val add_list : (key * 'b) list -> 'b t -> 'b t + + end + +end +module String_map : sig +#1 "string_map.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 Map_gen.S with type key = string + +end = struct +#1 "string_map.ml" + +# 2 "ext/map.cppo.ml" +(* we don't create [map_poly], since some operations require raise an exception which carries [key] *) + + + +# 10 "ext/map.cppo.ml" + type key = string + let compare_key = Ext_string.compare + +# 22 "ext/map.cppo.ml" +type 'a t = (key,'a) Map_gen.t +exception Duplicate_key of key + +let empty = Map_gen.empty +let is_empty = Map_gen.is_empty +let iter = Map_gen.iter +let fold = Map_gen.fold +let for_all = Map_gen.for_all +let exists = Map_gen.exists +let singleton = Map_gen.singleton +let cardinal = Map_gen.cardinal +let bindings = Map_gen.bindings +let to_sorted_array = Map_gen.to_sorted_array +let keys = Map_gen.keys +let choose = Map_gen.choose +let partition = Map_gen.partition +let filter = Map_gen.filter +let map = Map_gen.map +let mapi = Map_gen.mapi +let bal = Map_gen.bal +let height = Map_gen.height +let max_binding_exn = Map_gen.max_binding_exn +let min_binding_exn = Map_gen.min_binding_exn + + +let rec add (tree : _ Map_gen.t as 'a) x data : 'a = match tree with + | Empty -> + Node(Empty, x, data, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, data, r, h) + else if c < 0 then + bal (add l x data ) v d r + else + bal l v d (add r x data ) + + +let rec adjust (tree : _ Map_gen.t as 'a) x replace : 'a = + match tree with + | Empty -> + Node(Empty, x, replace None, Empty, 1) + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Node(l, x, replace (Some d) , r, h) + else if c < 0 then + bal (adjust l x replace ) v d r + else + bal l v d (adjust r x replace ) + + +let rec find_exn (tree : _ Map_gen.t ) x = match tree with + | Empty -> + raise Not_found + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_exn (if c < 0 then l else r) x + +let rec find_opt (tree : _ Map_gen.t ) x = match tree with + | Empty -> None + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then Some d + else find_opt (if c < 0 then l else r) x + +let rec find_default (tree : _ Map_gen.t ) x default = match tree with + | Empty -> default + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then d + else find_default (if c < 0 then l else r) x default + +let rec mem (tree : _ Map_gen.t ) x= match tree with + | Empty -> + false + | Node(l, v, d, r, _) -> + let c = compare_key x v in + c = 0 || mem (if c < 0 then l else r) x + +let rec remove (tree : _ Map_gen.t as 'a) x : 'a = match tree with + | Empty -> + Empty + | Node(l, v, d, r, h) -> + let c = compare_key x v in + if c = 0 then + Map_gen.merge l r + else if c < 0 then + bal (remove l x) v d r + else + bal l v d (remove r x ) + + +let rec split (tree : _ Map_gen.t as 'a) x : 'a * _ option * 'a = match tree with + | Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = compare_key x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split l x in (ll, pres, Map_gen.join rl v d r) + else + let (lr, pres, rr) = split r x in (Map_gen.join l v d lr, pres, rr) + +let rec merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) f : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split s2 v1 in + Map_gen.concat_or_join (merge l1 l2 f) v1 (f v1 (Some d1) d2) (merge r1 r2 f) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split s1 v2 in + Map_gen.concat_or_join (merge l1 l2 f) v2 (f v2 d1 (Some d2)) (merge r1 r2 f) + | _ -> + assert false + +let rec disjoint_merge (s1 : _ Map_gen.t) (s2 : _ Map_gen.t) : _ Map_gen.t = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + begin match split s2 v1 with + | l2, None, r2 -> + Map_gen.join (disjoint_merge l1 l2) v1 d1 (disjoint_merge r1 r2) + | _, Some _, _ -> + raise (Duplicate_key v1) + end + | (_, Node (l2, v2, d2, r2, h2)) -> + begin match split s1 v2 with + | (l1, None, r1) -> + Map_gen.join (disjoint_merge l1 l2) v2 d2 (disjoint_merge r1 r2) + | (_, Some _, _) -> + raise (Duplicate_key v2) + end + | _ -> + assert false + + + +let compare m1 m2 cmp = Map_gen.compare compare_key cmp m1 m2 + +let equal m1 m2 cmp = Map_gen.equal compare_key cmp m1 m2 + +let add_list (xs : _ list ) init = + Ext_list.fold_left xs init (fun acc (k,v) -> add acc k v ) + +let of_list xs = add_list xs empty + +let of_array xs = + Ext_array.fold_left xs empty (fun acc (k,v) -> add acc k v ) + +end +module Ast_payload : sig +#1 "ast_payload.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 utility module used when destructuring parsetree attributes, used for + compiling FFI attributes and built-in ppx *) + +type t = Parsetree.payload +type lid = string Asttypes.loc +type label_expr = lid * Parsetree.expression +type action = + lid * Parsetree.expression option + +val is_single_string : t -> (string * string option) option +val is_single_string_as_ast : + t -> + Parsetree.expression option + +val is_single_int : t -> int option + +type rtn = Not_String_Lteral | JS_Regex_Check_Failed | Correct of Parsetree.expression +val as_string_exp : check_js_regex: bool -> t -> rtn +val as_core_type : Location.t -> t -> Parsetree.core_type +(* val as_empty_structure : t -> bool *) +val as_ident : t -> Longident.t Asttypes.loc option +val raw_string_payload : Location.t -> string -> t +val assert_strings : + Location.t -> t -> string list + +(** as a record or empty + it will accept + + {[ [@@@bs.config ]]} + or + {[ [@@@bs.config no_export ] ]} + or + {[ [@@@bs.config { property .. } ]]} + Note that we only + {[ + { flat_property} + ]} + below is not allowed + {[ + {M.flat_property} + ]} +*) + +val ident_or_record_as_config : + Location.t -> + t -> action list + +val assert_bool_lit : Parsetree.expression -> bool + +val empty : t + +val table_dispatch : + (Parsetree.expression option -> 'a) String_map.t -> action -> 'a + +end = struct +#1 "ast_payload.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. *) + +type t = Parsetree.payload + +let is_single_string (x : t ) = + match x with (** TODO also need detect empty phrase case *) + | PStr [ { + pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_constant + + (Pconst_string(name,dec)) + + ; + _},_); + _}] -> Some (name,dec) + | _ -> None + +let is_single_string_as_ast (x : t ) + : Parsetree.expression option = + match x with (** TODO also need detect empty phrase case *) + | PStr [ { + pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_constant + + (Pconst_string(name,dec)) + + ; + _} as e ,_); + _}] -> Some e + | _ -> None + + +(** TODO also need detect empty phrase case *) + +let is_single_int (x : t ) : int option = + match x with + | PStr [ { + pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_constant + (Pconst_integer (name,_)); + _},_); + _}] -> Some (int_of_string name) + | _ -> None + +type rtn = Not_String_Lteral | JS_Regex_Check_Failed | Correct of Parsetree.expression + +let as_string_exp ~check_js_regex (x : t ) = + match x with (** TODO also need detect empty phrase case *) + | PStr [ { + pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_constant + + (Pconst_string (str,_)) + + ; + _} as e ,_); + _}] -> if check_js_regex then (if Ext_js_regex.js_regex_checker str then Correct e else JS_Regex_Check_Failed) else Correct e + | _ -> Not_String_Lteral + +let as_core_type loc x = + match x with + | Parsetree.PTyp x -> x + | _ -> Location.raise_errorf ~loc "except a core type" + +let as_ident (x : t ) = + match x with + | PStr [ + {pstr_desc = + Pstr_eval ( + { + pexp_desc = + Pexp_ident ident + + } , _) + } + ] -> Some ident + | _ -> None +open Ast_helper + +let raw_string_payload loc (s : string) : t = + PStr [ Str.eval ~loc (Ast_compatible.const_exp_string ~loc s) ] + + +type lid = string Asttypes.loc +type label_expr = lid * Parsetree.expression + +type action = + lid * Parsetree.expression option +(** None means punning is hit + {[ { x } ]} + otherwise it comes with a payload + {[ { x = exp }]} +*) + + + +let ident_or_record_as_config + loc + (x : Parsetree.payload) + : ( string Location.loc * Parsetree.expression option) list + = + match x with + | PStr + [ {pstr_desc = Pstr_eval + ({pexp_desc = Pexp_record (label_exprs, with_obj) ; pexp_loc = loc}, _); + _ + }] + -> + begin match with_obj with + | None -> + Ext_list.map label_exprs + (fun ((x,y) : (Longident.t Asttypes.loc * _) ) -> + match (x,y) with + | ({txt = Lident name; loc} ) , + ({Parsetree.pexp_desc = Pexp_ident{txt = Lident name2}} ) + when name2 = name -> + ({Asttypes.txt = name ; loc}, None) + | ({txt = Lident name; loc} ), y + -> + ({Asttypes.txt = name ; loc}, Some y) + | _ -> + Location.raise_errorf ~loc "Qualified label is not allood" + ) + + | Some _ -> + Location.raise_errorf ~loc "with is not supported" + end + | PStr [ + {pstr_desc = + Pstr_eval ( + { + pexp_desc = + Pexp_ident ({loc = lloc; txt = Lident txt}); + + } , _) + } + ] -> [ {Asttypes.txt ; loc = lloc}, None] + | PStr [] -> [] + | _ -> + Location.raise_errorf ~loc "this is not a valid record config" + + + +let assert_strings loc (x : t) : string list + = + let module M = struct exception Not_str end in + match x with + | PStr [ {pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_tuple strs; + _},_); + pstr_loc = loc ; + _}] -> + (try + Ext_list.map strs (fun e -> + match (e : Parsetree.expression) with + | {pexp_desc = Pexp_constant ( + + Pconst_string + + (name,_)); _} -> + name + | _ -> raise M.Not_str) + with M.Not_str -> + Location.raise_errorf ~loc "expect string tuple list" + ) + | PStr [ { + pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_constant + + (Pconst_string(name,_)); + + _},_); + _}] -> [name] + | PStr [] -> [] + + | PSig _ + + | PStr _ + | PTyp _ | PPat _ -> + Location.raise_errorf ~loc "expect string tuple list" +let assert_bool_lit (e : Parsetree.expression) = + match e.pexp_desc with + | Pexp_construct ({txt = Lident "true" }, None) + -> true + | Pexp_construct ({txt = Lident "false" }, None) + -> false + | _ -> + Location.raise_errorf ~loc:e.pexp_loc "expect `true` or `false` in this field" + + +let empty : t = Parsetree.PStr [] + + + +let table_dispatch table (action : action) + = + match action with + | {txt = name; loc }, y -> + begin match String_map.find_exn table name with + | fn -> fn y + | exception _ -> Location.raise_errorf ~loc "%s is not supported" name + end + +end +module Ast_literal : sig +#1 "ast_literal.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. *) + + +type 'a lit = ?loc: Location.t -> unit -> 'a + +val predef_option : Longident.t +val predef_some : Longident.t +val predef_none : Longident.t + +module Lid : sig + type t = Longident.t + val val_unit : t + val type_unit : t + val type_int : t + val js_fn : t + val js_meth : t + val js_meth_callback : t + val js_obj : t + + val ignore_id : t + val js_null : t + val js_undefined : t + val js_null_undefined : t + val js_re_id : t + val js_internal : t +end + +type expression_lit = Parsetree.expression lit +type core_type_lit = Parsetree.core_type lit +type pattern_lit = Parsetree.pattern lit + +val val_unit : expression_lit + +val type_unit : core_type_lit +val type_exn : core_type_lit +val type_string : core_type_lit +val type_int : core_type_lit +val type_any : core_type_lit + +val pat_unit : pattern_lit + +end = struct +#1 "ast_literal.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. *) + +open Ast_helper + + +let predef_prefix_ident : Longident.t = Lident "*predef*" + +let predef_option : Longident.t = + Ldot (predef_prefix_ident, "option") + +let predef_some : Longident.t = + Ldot (predef_prefix_ident, "Some") + +let predef_none : Longident.t = + Ldot (predef_prefix_ident, "None") + + +module Lid = struct + type t = Longident.t + let val_unit : t = Lident "()" + let type_unit : t = Lident "unit" + let type_string : t = Lident "string" + let type_int : t = Lident "int" (* use *predef* *) + let type_exn : t = Lident "exn" (* use *predef* *) + (* TODO should be renamed in to {!Js.fn} *) + (* TODO should be moved into {!Js.t} Later *) + let js_internal : t = Ldot (Lident "Js", "Internal") + let js_fn : t = + Ldot (js_internal, "fn") + let js_meth : t = + Ldot (js_internal , "meth") + let js_meth_callback : t = + Ldot (js_internal, "meth_callback") + let js_obj : t = Ldot (Lident "Js", "t") + let ignore_id : t = Ldot (Lident "Pervasives", "ignore") + let js_null : t = Ldot (Lident "Js", "null") + let js_undefined : t = Ldot (Lident "Js", "undefined") + let js_null_undefined : t = Ldot (Lident "Js", "null_undefined") + let js_re_id : t = Ldot (Ldot (Lident "Js", "Re"), "t") +end + +module No_loc = struct + let loc = Location.none + let val_unit = + Ast_helper.Exp.construct {txt = Lid.val_unit; loc } None + + let type_unit = + Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, [])) + let type_exn = + Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, [])) + + let type_int = + Ast_helper.Typ.mk (Ptyp_constr ({txt = Lid.type_int; loc}, [])) + let type_string = + Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_string; loc}, [])) + + let type_any = Ast_helper.Typ.any () + let pat_unit = Pat.construct {txt = Lid.val_unit; loc} None +end + +type 'a lit = ?loc: Location.t -> unit -> 'a +type expression_lit = Parsetree.expression lit +type core_type_lit = Parsetree.core_type lit +type pattern_lit = Parsetree.pattern lit + +let val_unit ?loc () = + match loc with + | None -> No_loc.val_unit + | Some loc -> Ast_helper.Exp.construct {txt = Lid.val_unit; loc} None + + +let type_unit ?loc () = + match loc with + | None -> + No_loc.type_unit + | Some loc -> + Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_unit; loc}, [])) + +let type_exn ?loc () = + match loc with + | None -> + No_loc.type_exn + | Some loc -> + Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_exn; loc}, [])) + + +let type_string ?loc () = + match loc with + | None -> No_loc.type_string + | Some loc -> + Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_string; loc}, [])) + +let type_int ?loc () = + match loc with + | None -> No_loc.type_int + | Some loc -> + Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_int; loc}, [])) + +let type_any ?loc () = + match loc with + | None -> No_loc.type_any + | Some loc -> Ast_helper.Typ.any ~loc () + +let pat_unit ?loc () = + match loc with + | None -> No_loc.pat_unit + | Some loc -> + Pat.construct ~loc {txt = Lid.val_unit; loc} None + +end +module Ast_comb : sig +#1 "ast_comb.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 exp_apply_no_label : + ?loc:Location.t -> + ?attrs:Parsetree.attributes -> + Parsetree.expression -> Parsetree.expression list -> Parsetree.expression *) + +(* val fun_no_label : + ?loc:Location.t -> + ?attrs:Parsetree.attributes -> + Parsetree.pattern -> Parsetree.expression -> Parsetree.expression *) + +(* val arrow_no_label : + ?loc:Location.t -> + ?attrs:Parsetree.attributes -> + Parsetree.core_type -> Parsetree.core_type -> Parsetree.core_type *) + +(* note we first declare its type is [unit], + then [ignore] it, [ignore] is necessary since + the js value maybe not be of type [unit] and + we can use [unit] value (though very little chance) + sometimes +*) +val discard_exp_as_unit : + Location.t -> Parsetree.expression -> Parsetree.expression + + +val tuple_type_pair : + ?loc:Ast_helper.loc -> + [< `Make | `Run ] -> + int -> Parsetree.core_type * Parsetree.core_type list * Parsetree.core_type + +val to_js_type : + Location.t -> Parsetree.core_type -> Parsetree.core_type + + + +val to_undefined_type : + Location.t -> Parsetree.core_type -> Parsetree.core_type + +val to_js_re_type : Location.t -> Parsetree.core_type + +val single_non_rec_value : + Ast_helper.str -> + Parsetree.expression -> + Parsetree.structure_item + +val single_non_rec_val : + Ast_helper.str -> + Parsetree.core_type -> + Parsetree.signature_item +end = struct +#1 "ast_comb.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. *) + + +open Ast_helper + + + +(* let fun_no_label ?loc ?attrs pat body = + Ast_compatible.fun_ ?loc ?attrs pat body *) + + +let discard_exp_as_unit loc e = + Ast_compatible.apply_simple ~loc + (Exp.ident ~loc {txt = Ast_literal.Lid.ignore_id; loc}) + [Exp.constraint_ ~loc e + (Ast_literal.type_unit ~loc ())] + + +let tuple_type_pair ?loc kind arity = + let prefix = "a" in + if arity = 0 then + let ty = Typ.var ?loc ( prefix ^ "0") in + match kind with + | `Run -> ty, [], ty + | `Make -> + (Ast_compatible.arrow ?loc + (Ast_literal.type_unit ?loc ()) + ty , + [], ty) + else + let number = arity + 1 in + let tys = Ext_list.init number (fun i -> + Typ.var ?loc (prefix ^ string_of_int (number - i - 1)) + ) in + match tys with + | result :: rest -> + Ext_list.reduce_from_left tys (fun r arg -> Ast_compatible.arrow ?loc arg r) , + List.rev rest , result + | [] -> assert false + + + +let js_obj_type_id = + Ast_literal.Lid.js_obj + +let re_id = + Ast_literal.Lid.js_re_id + +let to_js_type loc x = + Typ.constr ~loc {txt = js_obj_type_id; loc} [x] + +let to_js_re_type loc = + Typ.constr ~loc { txt = re_id ; loc} [] + +let to_undefined_type loc x = + Typ.constr ~loc + {txt = Ast_literal.Lid.js_undefined ; loc} + [x] + +let single_non_rec_value name exp = + Str.value Nonrecursive + [Vb.mk (Pat.var name) exp] + +let single_non_rec_val name ty = + Sig.value + (Val.mk name ty) +end +module Bs_syntaxerr : sig +#1 "bs_syntaxerr.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. *) + +type error + = Unsupported_predicates + | Conflict_bs_bs_this_bs_meth + | Duplicated_bs_deriving + | Conflict_attributes + + | Duplicated_bs_as + | Expect_int_literal + | Expect_string_literal + | Expect_int_or_string_or_json_literal + | Unhandled_poly_type + | Unregistered of string + | Invalid_underscore_type_in_external + | Invalid_bs_string_type + | Invalid_bs_int_type + | Invalid_bs_unwrap_type + | Conflict_ffi_attribute of string + | Not_supported_in_bs_deriving + | Canot_infer_arity_by_syntax + | Illegal_attribute + | Inconsistent_arity of int * int + (* we still rqeuire users to have explicit annotation to avoid + {[ (((int -> int) -> int) -> int )]} + *) + | Not_supported_directive_in_bs_return + | Expect_opt_in_bs_return_to_opt + | Label_in_uncurried_bs_attribute + + | Bs_this_simple_pattern + + +val err : Location.t -> error -> 'a + +end = struct +#1 "bs_syntaxerr.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. *) + + + +type error + = Unsupported_predicates + | Conflict_bs_bs_this_bs_meth + | Duplicated_bs_deriving + | Conflict_attributes + + | Duplicated_bs_as + | Expect_int_literal + | Expect_string_literal + | Expect_int_or_string_or_json_literal + | Unhandled_poly_type + | Unregistered of string + | Invalid_underscore_type_in_external + | Invalid_bs_string_type + | Invalid_bs_int_type + | Invalid_bs_unwrap_type + | Conflict_ffi_attribute of string + | Not_supported_in_bs_deriving + | Canot_infer_arity_by_syntax + | Illegal_attribute + | Inconsistent_arity of int * int + (* we still rqeuire users to have explicit annotation to avoid + {[ (((int -> int) -> int) -> int )]} + *) + | Not_supported_directive_in_bs_return + | Expect_opt_in_bs_return_to_opt + | Label_in_uncurried_bs_attribute + + | Bs_this_simple_pattern + +let pp_error fmt err = + Format.pp_print_string fmt @@ match err with + | Label_in_uncurried_bs_attribute + -> "label is not allowed here, it is due to `bs.` attribute indicate uncurried calling convention which does not support label argument yet" + | Expect_opt_in_bs_return_to_opt + -> + "bs.return directive *_to_opt expect return type to be \n\ + syntax wise `_ option` for safety" + + | Not_supported_directive_in_bs_return + -> + "Not supported return directive" + | Illegal_attribute -> + "Illegal attributes" + | Canot_infer_arity_by_syntax + -> "Can not infer the arity by syntax, either [@bs.uncurry n] or \n\ + write it in arrow syntax " + | Inconsistent_arity (arity,n) + -> Printf.sprintf "Inconsistent arity %d vs %d" arity n + | Not_supported_in_bs_deriving + -> + "not supported in deriving" + | Unsupported_predicates + -> + "unsupported predicates" + | Conflict_bs_bs_this_bs_meth -> + "[@bs.this], [@bs], [@bs.meth] can not be applied at the same time" + | Duplicated_bs_deriving + -> "duplicated bs.deriving attribute" + | Conflict_attributes + -> "conflicting attributes " + | Expect_string_literal + -> "expect string literal " + | Duplicated_bs_as + -> + "duplicated bs.as " + | Expect_int_literal + -> + "expect int literal " + | Expect_int_or_string_or_json_literal + -> + "expect int or string literal or json literal ({json||json}) " + | Unhandled_poly_type + -> + "Unhandled poly type" + | Unregistered str + -> "Unregistered " ^ str + | Invalid_underscore_type_in_external + -> + "_ is not allowed in combination with external optional type" + | Invalid_bs_string_type + -> + "Not a valid type for [@bs.string]" + | Invalid_bs_int_type + -> + "Not a valid type for [@bs.int]" + | Invalid_bs_unwrap_type + -> + "Not a valid type for [@bs.unwrap]. Type must be an inline variant (closed), and\n\ + each constructor must have an argument." + | Conflict_ffi_attribute str + -> + "Conflicting FFI attributes found: " ^ str + | Bs_this_simple_pattern + -> + "[@bs.this] expect its pattern variable to be simple form" + +type exn += Error of Location.t * error + + +let () = + Location.register_error_of_exn (function + | Error(loc,err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None + ) + +let err loc error = raise (Error(loc, error)) + +end +module Ast_core_type : sig +#1 "ast_core_type.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. *) + +type t = Parsetree.core_type + + + + +val lift_option_type : t -> t +val is_any : t -> bool +val replace_result : t -> t -> t + +(* val opt_arrow: Location.t -> string -> t -> t -> t *) + +val is_unit : t -> bool +val is_array : t -> bool + + +(** return a function type + [from_labels ~loc tyvars labels] + example output: + {[x:'a0 -> y:'a1 -> < x :'a0 ;y :'a1 > Js.t]} +*) +val from_labels : + loc:Location.t -> int -> string Asttypes.loc list -> t + +val make_obj : + loc:Location.t -> + (string * Parsetree.attributes * t) list -> + t + +val is_user_option : t -> bool + +val is_user_bool : t -> bool + +val is_user_int : t -> bool + + + +(** + returns 0 when it can not tell arity from the syntax +*) +val get_uncurry_arity : t -> [`Arity of int | `Not_function ] + + +(** fails when Ptyp_poly *) +val list_of_arrow : + t -> + t * (Ast_compatible.arg_label * t * Parsetree.attributes * Location.t) list + +val is_arity_one : t -> bool + +end = struct +#1 "ast_core_type.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. *) + +type t = Parsetree.core_type + + + + + + + + + +let lift_option_type ({ptyp_loc} as ty:t) : t = + {ptyp_desc = + Ptyp_constr( + {txt = Ast_literal.predef_option; + loc = ptyp_loc} + , [ty]); + ptyp_loc = ptyp_loc; + ptyp_attributes = [] + } + +let is_any (ty : t) = + ty.ptyp_desc = Ptyp_any + +open Ast_helper + +let replace_result (ty : t) (result : t) : t = + let rec aux (ty : Parsetree.core_type) = + match ty with + | { ptyp_desc = + Ptyp_arrow (label,t1,t2) + } -> { ty with ptyp_desc = Ptyp_arrow(label,t1, aux t2)} + | {ptyp_desc = Ptyp_poly(fs,ty)} + -> {ty with ptyp_desc = Ptyp_poly(fs, aux ty)} + | _ -> result in + aux ty + +let is_unit (ty : t ) = + match ty.ptyp_desc with + | Ptyp_constr({txt =Lident "unit"}, []) -> true + | _ -> false + +let is_array (ty : t) = + match ty.ptyp_desc with + | Ptyp_constr({txt =Lident "array"}, [_]) -> true + | _ -> false + +let is_user_option (ty : t) = + match ty.ptyp_desc with + | Ptyp_constr( + {txt = Lident "option" | + (Ldot (Lident "*predef*", "option")) }, + [_]) -> true + | _ -> false + +let is_user_bool (ty : t) = + match ty.ptyp_desc with + | Ptyp_constr({txt = Lident "bool"},[]) -> true + | _ -> false + +let is_user_int (ty : t) = + match ty.ptyp_desc with + | Ptyp_constr({txt = Lident "int"},[]) -> true + | _ -> false + + + + + +(* Note that OCaml type checker will not allow arbitrary + name as type variables, for example: + {[ + '_x'_ + ]} + will be recognized as a invalid program +*) +let from_labels ~loc arity labels + : t = + let tyvars = + ((Ext_list.init arity (fun i -> + Typ.var ~loc ("a" ^ string_of_int i)))) in + let result_type = + Ast_comb.to_js_type loc + (Ast_compatible.object_ ~loc + (Ext_list.map2 labels tyvars (fun x y -> x.Asttypes.txt ,[], y)) Closed) + in + Ext_list.fold_right2 labels tyvars result_type + (fun label (* {loc ; txt = label }*) + tyvar acc -> + Ast_compatible.label_arrow ~loc:label.loc label.txt tyvar acc) + + +let make_obj ~loc xs = + Ast_comb.to_js_type loc + (Ast_compatible.object_ ~loc xs Closed) + + + +(** + +{[ 'a . 'a -> 'b ]} +OCaml does not support such syntax yet +{[ 'a -> ('a. 'a -> 'b) ]} + +*) +let rec get_uncurry_arity_aux (ty : t) acc = + match ty.ptyp_desc with + | Ptyp_arrow(_, _ , new_ty) -> + get_uncurry_arity_aux new_ty (succ acc) + | Ptyp_poly (_,ty) -> + get_uncurry_arity_aux ty acc + | _ -> acc + +(** + {[ unit -> 'b ]} return arity 0 + {[ unit -> 'a1 -> a2']} arity 2 + {[ 'a1 -> 'a2 -> ... 'aN -> 'b ]} return arity N +*) +let get_uncurry_arity (ty : t ) = + match ty.ptyp_desc with + | Ptyp_arrow(arg_label, {ptyp_desc = (Ptyp_constr ({txt = Lident "unit"}, []))}, + rest ) when Ast_compatible.is_arg_label_simple arg_label -> + begin match rest with + | {ptyp_desc = Ptyp_arrow _ } -> + `Arity (get_uncurry_arity_aux rest 1 ) + | _ -> `Arity 0 + end + | Ptyp_arrow(_,_,rest ) -> + `Arity(get_uncurry_arity_aux rest 1) + | _ -> `Not_function + +let get_curry_arity ty = + get_uncurry_arity_aux ty 0 + +let is_arity_one ty = get_curry_arity ty = 1 + +let list_of_arrow (ty : t) = + let rec aux (ty : t) acc = + match ty.ptyp_desc with + | Ptyp_arrow(label,t1,t2) -> + aux t2 ((label,t1,ty.ptyp_attributes,ty.ptyp_loc) ::acc) + | Ptyp_poly(_, ty) -> (* should not happen? *) + Bs_syntaxerr.err ty.ptyp_loc Unhandled_poly_type + | return_type -> ty, List.rev acc + in aux ty [] + + +(* type arg_label = + | Nolabel (* it will be ignored , side effect will be recorded *) + | Labelled of string + | Optional of string + + +let label_name l : arg_label = + if l = "" then Nolabel else + if is_optional_label l + then Optional (String.sub l 1 (String.length l - 1)) + else Labelled l *) +end +module Ast_iterator : sig +#1 "ast_iterator.mli" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Ojeda Bar, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** {!iterator} allows to implement AST inspection using open recursion. A + typical mapper would be based on {!default_iterator}, a trivial iterator, + and will fall back on it for handling the syntax it does not modify. *) + +open Parsetree + +(** {1 A generic Parsetree iterator} *) + +type iterator = { + attribute: iterator -> attribute -> unit; + attributes: iterator -> attribute list -> unit; + case: iterator -> case -> unit; + cases: iterator -> case list -> unit; + class_declaration: iterator -> class_declaration -> unit; + class_description: iterator -> class_description -> unit; + class_expr: iterator -> class_expr -> unit; + class_field: iterator -> class_field -> unit; + class_signature: iterator -> class_signature -> unit; + class_structure: iterator -> class_structure -> unit; + class_type: iterator -> class_type -> unit; + class_type_declaration: iterator -> class_type_declaration -> unit; + class_type_field: iterator -> class_type_field -> unit; + constructor_declaration: iterator -> constructor_declaration -> unit; + expr: iterator -> expression -> unit; + extension: iterator -> extension -> unit; + extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; + label_declaration: iterator -> label_declaration -> unit; + location: iterator -> Location.t -> unit; + module_binding: iterator -> module_binding -> unit; + module_declaration: iterator -> module_declaration -> unit; + module_expr: iterator -> module_expr -> unit; + module_type: iterator -> module_type -> unit; + module_type_declaration: iterator -> module_type_declaration -> unit; + open_description: iterator -> open_description -> unit; + pat: iterator -> pattern -> unit; + payload: iterator -> payload -> unit; + signature: iterator -> signature -> unit; + signature_item: iterator -> signature_item -> unit; + structure: iterator -> structure -> unit; + structure_item: iterator -> structure_item -> unit; + typ: iterator -> core_type -> unit; + type_declaration: iterator -> type_declaration -> unit; + type_extension: iterator -> type_extension -> unit; + type_kind: iterator -> type_kind -> unit; + value_binding: iterator -> value_binding -> unit; + value_description: iterator -> value_description -> unit; + with_constraint: iterator -> with_constraint -> unit; +} +(** A [iterator] record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the iterator to be applied to children in the syntax + tree. *) + +val default_iterator: iterator +(** A default iterator, which implements a "do not do anything" mapping. *) + +end = struct +#1 "ast_iterator.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Nicolas Ojeda Bar, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* A generic Parsetree mapping class *) + +(* +[@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) +*) + + +open Parsetree +open Location + +type iterator = { + attribute: iterator -> attribute -> unit; + attributes: iterator -> attribute list -> unit; + case: iterator -> case -> unit; + cases: iterator -> case list -> unit; + class_declaration: iterator -> class_declaration -> unit; + class_description: iterator -> class_description -> unit; + class_expr: iterator -> class_expr -> unit; + class_field: iterator -> class_field -> unit; + class_signature: iterator -> class_signature -> unit; + class_structure: iterator -> class_structure -> unit; + class_type: iterator -> class_type -> unit; + class_type_declaration: iterator -> class_type_declaration -> unit; + class_type_field: iterator -> class_type_field -> unit; + constructor_declaration: iterator -> constructor_declaration -> unit; + expr: iterator -> expression -> unit; + extension: iterator -> extension -> unit; + extension_constructor: iterator -> extension_constructor -> unit; + include_declaration: iterator -> include_declaration -> unit; + include_description: iterator -> include_description -> unit; + label_declaration: iterator -> label_declaration -> unit; + location: iterator -> Location.t -> unit; + module_binding: iterator -> module_binding -> unit; + module_declaration: iterator -> module_declaration -> unit; + module_expr: iterator -> module_expr -> unit; + module_type: iterator -> module_type -> unit; + module_type_declaration: iterator -> module_type_declaration -> unit; + open_description: iterator -> open_description -> unit; + pat: iterator -> pattern -> unit; + payload: iterator -> payload -> unit; + signature: iterator -> signature -> unit; + signature_item: iterator -> signature_item -> unit; + structure: iterator -> structure -> unit; + structure_item: iterator -> structure_item -> unit; + typ: iterator -> core_type -> unit; + type_declaration: iterator -> type_declaration -> unit; + type_extension: iterator -> type_extension -> unit; + type_kind: iterator -> type_kind -> unit; + value_binding: iterator -> value_binding -> unit; + value_description: iterator -> value_description -> unit; + with_constraint: iterator -> with_constraint -> unit; +} +(** A [iterator] record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the iterator to be applied to children in the syntax + tree. *) + +let iter_fst f (x, _) = f x +let iter_snd f (_, y) = f y +let iter_tuple f1 f2 (x, y) = f1 x; f2 y +let iter_tuple3 f1 f2 f3 (x, y, z) = f1 x; f2 y; f3 z +let iter_opt f = function None -> () | Some x -> f x + +let iter_loc sub {loc; txt = _} = sub.location sub loc + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (_, attrs, _, tl) -> + sub.attributes sub attrs; List.iter (sub.typ sub) tl + | Rinherit t -> sub.typ sub t + + let object_field sub = function + | Otag (_, attrs, t) -> + sub.attributes sub attrs; sub.typ sub t + | Oinherit t -> sub.typ sub t + + let iter sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Ptyp_any + | Ptyp_var _ -> () + | Ptyp_arrow (_lab, t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl + | Ptyp_constr (lid, tl) -> + iter_loc sub lid; List.iter (sub.typ sub) tl + | Ptyp_object (ol, _o) -> + List.iter (object_field sub) ol + | Ptyp_class (lid, tl) -> + iter_loc sub lid; List.iter (sub.typ sub) tl + | Ptyp_alias (t, _) -> sub.typ sub t + | Ptyp_variant (rl, _b, _ll) -> + List.iter (row_field sub) rl + | Ptyp_poly (_, t) -> sub.typ sub t + | Ptyp_package (lid, l) -> + iter_loc sub lid; + List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l + | Ptyp_extension x -> sub.extension sub x + + let iter_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private = _; + ptype_manifest; + ptype_attributes; + ptype_loc} = + iter_loc sub ptype_name; + List.iter (iter_fst (sub.typ sub)) ptype_params; + List.iter + (iter_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs; + sub.type_kind sub ptype_kind; + iter_opt (sub.typ sub) ptype_manifest; + sub.location sub ptype_loc; + sub.attributes sub ptype_attributes + + let iter_type_kind sub = function + | Ptype_abstract -> () + | Ptype_variant l -> + List.iter (sub.constructor_declaration sub) l + | Ptype_record l -> List.iter (sub.label_declaration sub) l + | Ptype_open -> () + + let iter_constructor_arguments sub = function + | Pcstr_tuple l -> List.iter (sub.typ sub) l + | Pcstr_record l -> + List.iter (sub.label_declaration sub) l + + let iter_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private = _; + ptyext_attributes} = + iter_loc sub ptyext_path; + List.iter (sub.extension_constructor sub) ptyext_constructors; + List.iter (iter_fst (sub.typ sub)) ptyext_params; + sub.attributes sub ptyext_attributes + + let iter_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + iter_constructor_arguments sub ctl; iter_opt (sub.typ sub) cto + | Pext_rebind li -> + iter_loc sub li + + let iter_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + iter_loc sub pext_name; + iter_extension_constructor_kind sub pext_kind; + sub.location sub pext_loc; + sub.attributes sub pext_attributes + +end + +module CT = struct + (* Type expressions for the class language *) + + let iter sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcty_constr (lid, tys) -> + iter_loc sub lid; List.iter (sub.typ sub) tys + | Pcty_signature x -> sub.class_signature sub x + | Pcty_arrow (_lab, t, ct) -> + sub.typ sub t; sub.class_type sub ct + | Pcty_extension x -> sub.extension sub x + | Pcty_open (_ovf, lid, e) -> + iter_loc sub lid; sub.class_type sub e + + let iter_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pctf_inherit ct -> sub.class_type sub ct + | Pctf_val (_s, _m, _v, t) -> sub.typ sub t + | Pctf_method (_s, _p, _v, t) -> sub.typ sub t + | Pctf_constraint (t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Pctf_attribute x -> sub.attribute sub x + | Pctf_extension x -> sub.extension sub x + + let iter_signature sub {pcsig_self; pcsig_fields} = + sub.typ sub pcsig_self; + List.iter (sub.class_type_field sub) pcsig_fields +end + +module MT = struct + (* Type expressions for the module language *) + + let iter sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pmty_ident s -> iter_loc sub s + | Pmty_alias s -> iter_loc sub s + | Pmty_signature sg -> sub.signature sub sg + | Pmty_functor (s, mt1, mt2) -> + iter_loc sub s; + iter_opt (sub.module_type sub) mt1; + sub.module_type sub mt2 + | Pmty_with (mt, l) -> + sub.module_type sub mt; + List.iter (sub.with_constraint sub) l + | Pmty_typeof me -> sub.module_expr sub me + | Pmty_extension x -> sub.extension sub x + + let iter_with_constraint sub = function + | Pwith_type (lid, d) -> + iter_loc sub lid; sub.type_declaration sub d + | Pwith_module (lid, lid2) -> + iter_loc sub lid; iter_loc sub lid2 + | Pwith_typesubst (lid, d) -> + iter_loc sub lid; sub.type_declaration sub d + | Pwith_modsubst (s, lid) -> + iter_loc sub s; iter_loc sub lid + + let iter_signature_item sub {psig_desc = desc; psig_loc = loc} = + sub.location sub loc; + match desc with + | Psig_value vd -> sub.value_description sub vd + | Psig_type (_rf, l) -> List.iter (sub.type_declaration sub) l + | Psig_typext te -> sub.type_extension sub te + | Psig_exception ed -> sub.extension_constructor sub ed + | Psig_module x -> sub.module_declaration sub x + | Psig_recmodule l -> + List.iter (sub.module_declaration sub) l + | Psig_modtype x -> sub.module_type_declaration sub x + | Psig_open x -> sub.open_description sub x + | Psig_include x -> sub.include_description sub x + | Psig_class l -> List.iter (sub.class_description sub) l + | Psig_class_type l -> + List.iter (sub.class_type_declaration sub) l + | Psig_extension (x, attrs) -> + sub.extension sub x; sub.attributes sub attrs + | Psig_attribute x -> sub.attribute sub x +end + + +module M = struct + (* Value expressions for the module language *) + + let iter sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pmod_ident x -> iter_loc sub x + | Pmod_structure str -> sub.structure sub str + | Pmod_functor (arg, arg_ty, body) -> + iter_loc sub arg; + iter_opt (sub.module_type sub) arg_ty; + sub.module_expr sub body + | Pmod_apply (m1, m2) -> + sub.module_expr sub m1; sub.module_expr sub m2 + | Pmod_constraint (m, mty) -> + sub.module_expr sub m; sub.module_type sub mty + | Pmod_unpack e -> sub.expr sub e + | Pmod_extension x -> sub.extension sub x + + let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + sub.location sub loc; + match desc with + | Pstr_eval (x, attrs) -> + sub.expr sub x; sub.attributes sub attrs + | Pstr_value (_r, vbs) -> List.iter (sub.value_binding sub) vbs + | Pstr_primitive vd -> sub.value_description sub vd + | Pstr_type (_rf, l) -> List.iter (sub.type_declaration sub) l + | Pstr_typext te -> sub.type_extension sub te + | Pstr_exception ed -> sub.extension_constructor sub ed + | Pstr_module x -> sub.module_binding sub x + | Pstr_recmodule l -> List.iter (sub.module_binding sub) l + | Pstr_modtype x -> sub.module_type_declaration sub x + | Pstr_open x -> sub.open_description sub x + | Pstr_class l -> List.iter (sub.class_declaration sub) l + | Pstr_class_type l -> + List.iter (sub.class_type_declaration sub) l + | Pstr_include x -> sub.include_declaration sub x + | Pstr_extension (x, attrs) -> + sub.extension sub x; sub.attributes sub attrs + | Pstr_attribute x -> sub.attribute sub x +end + +module E = struct + (* Value expressions for the core language *) + + let iter sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pexp_ident x -> iter_loc sub x + | Pexp_constant _ -> () + | Pexp_let (_r, vbs, e) -> + List.iter (sub.value_binding sub) vbs; + sub.expr sub e + | Pexp_fun (_lab, def, p, e) -> + iter_opt (sub.expr sub) def; + sub.pat sub p; + sub.expr sub e + | Pexp_function pel -> sub.cases sub pel + | Pexp_apply (e, l) -> + sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l + | Pexp_match (e, pel) -> + sub.expr sub e; sub.cases sub pel + | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel + | Pexp_tuple el -> List.iter (sub.expr sub) el + | Pexp_construct (lid, arg) -> + iter_loc sub lid; iter_opt (sub.expr sub) arg + | Pexp_variant (_lab, eo) -> + iter_opt (sub.expr sub) eo + | Pexp_record (l, eo) -> + List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l; + iter_opt (sub.expr sub) eo + | Pexp_field (e, lid) -> + sub.expr sub e; iter_loc sub lid + | Pexp_setfield (e1, lid, e2) -> + sub.expr sub e1; iter_loc sub lid; + sub.expr sub e2 + | Pexp_array el -> List.iter (sub.expr sub) el + | Pexp_ifthenelse (e1, e2, e3) -> + sub.expr sub e1; sub.expr sub e2; + iter_opt (sub.expr sub) e3 + | Pexp_sequence (e1, e2) -> + sub.expr sub e1; sub.expr sub e2 + | Pexp_while (e1, e2) -> + sub.expr sub e1; sub.expr sub e2 + | Pexp_for (p, e1, e2, _d, e3) -> + sub.pat sub p; sub.expr sub e1; sub.expr sub e2; + sub.expr sub e3 + | Pexp_coerce (e, t1, t2) -> + sub.expr sub e; iter_opt (sub.typ sub) t1; + sub.typ sub t2 + | Pexp_constraint (e, t) -> + sub.expr sub e; sub.typ sub t + | Pexp_send (e, _s) -> sub.expr sub e + | Pexp_new lid -> iter_loc sub lid + | Pexp_setinstvar (s, e) -> + iter_loc sub s; sub.expr sub e + | Pexp_override sel -> + List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) sel + | Pexp_letmodule (s, me, e) -> + iter_loc sub s; sub.module_expr sub me; + sub.expr sub e + | Pexp_letexception (cd, e) -> + sub.extension_constructor sub cd; + sub.expr sub e + | Pexp_assert e -> sub.expr sub e + | Pexp_lazy e -> sub.expr sub e + | Pexp_poly (e, t) -> + sub.expr sub e; iter_opt (sub.typ sub) t + | Pexp_object cls -> sub.class_structure sub cls + | Pexp_newtype (_s, e) -> sub.expr sub e + | Pexp_pack me -> sub.module_expr sub me + | Pexp_open (_ovf, lid, e) -> + iter_loc sub lid; sub.expr sub e + | Pexp_extension x -> sub.extension sub x + | Pexp_unreachable -> () +end + +module P = struct + (* Patterns *) + + let iter sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Ppat_any -> () + | Ppat_var s -> iter_loc sub s + | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s + | Ppat_constant _ -> () + | Ppat_interval _ -> () + | Ppat_tuple pl -> List.iter (sub.pat sub) pl + | Ppat_construct (l, p) -> + iter_loc sub l; iter_opt (sub.pat sub) p + | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p + | Ppat_record (lpl, _cf) -> + List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl + | Ppat_array pl -> List.iter (sub.pat sub) pl + | Ppat_or (p1, p2) -> sub.pat sub p1; sub.pat sub p2 + | Ppat_constraint (p, t) -> + sub.pat sub p; sub.typ sub t + | Ppat_type s -> iter_loc sub s + | Ppat_lazy p -> sub.pat sub p + | Ppat_unpack s -> iter_loc sub s + | Ppat_exception p -> sub.pat sub p + | Ppat_extension x -> sub.extension sub x + | Ppat_open (lid, p) -> + iter_loc sub lid; sub.pat sub p + +end + +module CE = struct + (* Value expressions for the class language *) + + let iter sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcl_constr (lid, tys) -> + iter_loc sub lid; List.iter (sub.typ sub) tys + | Pcl_structure s -> + sub.class_structure sub s + | Pcl_fun (_lab, e, p, ce) -> + iter_opt (sub.expr sub) e; + sub.pat sub p; + sub.class_expr sub ce + | Pcl_apply (ce, l) -> + sub.class_expr sub ce; + List.iter (iter_snd (sub.expr sub)) l + | Pcl_let (_r, vbs, ce) -> + List.iter (sub.value_binding sub) vbs; + sub.class_expr sub ce + | Pcl_constraint (ce, ct) -> + sub.class_expr sub ce; sub.class_type sub ct + | Pcl_extension x -> sub.extension sub x + | Pcl_open (_ovf, lid, e) -> + iter_loc sub lid; sub.class_expr sub e + + let iter_kind sub = function + | Cfk_concrete (_o, e) -> sub.expr sub e + | Cfk_virtual t -> sub.typ sub t + + let iter_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + sub.location sub loc; + sub.attributes sub attrs; + match desc with + | Pcf_inherit (_o, ce, _s) -> sub.class_expr sub ce + | Pcf_val (s, _m, k) -> iter_loc sub s; iter_kind sub k + | Pcf_method (s, _p, k) -> + iter_loc sub s; iter_kind sub k + | Pcf_constraint (t1, t2) -> + sub.typ sub t1; sub.typ sub t2 + | Pcf_initializer e -> sub.expr sub e + | Pcf_attribute x -> sub.attribute sub x + | Pcf_extension x -> sub.extension sub x + + let iter_structure sub {pcstr_self; pcstr_fields} = + sub.pat sub pcstr_self; + List.iter (sub.class_field sub) pcstr_fields + + let class_infos sub f {pci_virt = _; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + List.iter (iter_fst (sub.typ sub)) pl; + iter_loc sub pci_name; + f pci_expr; + sub.location sub pci_loc; + sub.attributes sub pci_attributes +end + +(* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + +let default_iterator = + { + structure = (fun this l -> List.iter (this.structure_item this) l); + structure_item = M.iter_structure_item; + module_expr = M.iter; + signature = (fun this l -> List.iter (this.signature_item this) l); + signature_item = MT.iter_signature_item; + module_type = MT.iter; + with_constraint = MT.iter_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.iter; + class_field = CE.iter_field; + class_structure = CE.iter_structure; + class_type = CT.iter; + class_type_field = CT.iter_field; + class_signature = CT.iter_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.iter_type_declaration; + type_kind = T.iter_type_kind; + typ = T.iter; + type_extension = T.iter_type_extension; + extension_constructor = T.iter_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim = _; pval_loc; + pval_attributes} -> + iter_loc this pval_name; + this.typ this pval_type; + this.attributes this pval_attributes; + this.location this pval_loc + ); + + pat = P.iter; + expr = E.iter; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + iter_loc this pmd_name; + this.module_type this pmd_type; + this.attributes this pmd_attributes; + this.location this pmd_loc + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + iter_loc this pmtd_name; + iter_opt (this.module_type this) pmtd_type; + this.attributes this pmtd_attributes; + this.location this pmtd_loc + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + iter_loc this pmb_name; this.module_expr this pmb_expr; + this.attributes this pmb_attributes; + this.location this pmb_loc + ); + + + open_description = + (fun this {popen_lid; popen_override = _; popen_attributes; popen_loc} -> + iter_loc this popen_lid; + this.location this popen_loc; + this.attributes this popen_attributes + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + this.module_type this pincl_mod; + this.location this pincl_loc; + this.attributes this pincl_attributes + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + this.module_expr this pincl_mod; + this.location this pincl_loc; + this.attributes this pincl_attributes + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + this.pat this pvb_pat; + this.expr this pvb_expr; + this.location this pvb_loc; + this.attributes this pvb_attributes + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + iter_loc this pcd_name; + T.iter_constructor_arguments this pcd_args; + iter_opt (this.typ this) pcd_res; + this.location this pcd_loc; + this.attributes this pcd_attributes + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable = _; pld_attributes}-> + iter_loc this pld_name; + this.typ this pld_type; + this.location this pld_loc; + this.attributes this pld_attributes + ); + + cases = (fun this l -> List.iter (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + this.pat this pc_lhs; + iter_opt (this.expr this) pc_guard; + this.expr this pc_rhs + ); + + location = (fun _this _l -> ()); + + extension = (fun this (s, e) -> iter_loc this s; this.payload this e); + attribute = (fun this (s, e) -> iter_loc this s; this.payload this e); + attributes = (fun this l -> List.iter (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> this.structure this x + | PSig x -> this.signature this x + | PTyp x -> this.typ this x + | PPat (x, g) -> this.pat this x; iter_opt (this.expr this) g + ); + } + +end +module Ext_char : sig +#1 "ext_char.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. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool + +val is_lower_case : char -> bool + +val uppercase_ascii : char -> char + +val lowercase_ascii : char -> char +end = struct +#1 "ext_char.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. *) + + + + + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) + +let escaped = Char.escaped + + +let valid_hex x = + match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> true + | _ -> false + + + +let is_lower_case c = + (c >= 'a' && c <= 'z') + || (c >= '\224' && c <= '\246') + || (c >= '\248' && c <= '\254') +let uppercase_ascii = + + Char.uppercase_ascii + + +let lowercase_ascii = + + Char.lowercase_ascii + + +end +module Ast_utf8_string : sig +#1 "ast_utf8_string.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. *) + + +type error + + +type exn += Error of int (* offset *) * error + +val pp_error : Format.formatter -> error -> unit + + + +(* module Interp : sig *) +(* val check_and_transform : int -> string -> int -> cxt -> unit *) +(* val transform_test : string -> segments *) +(* end *) +val transform_test : string -> string + +val transform : Location.t -> string -> string + + +end = struct +#1 "ast_utf8_string.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. *) + + + +type error = + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + +let pp_error fmt err = + Format.pp_print_string fmt @@ match err with + | Invalid_code_point -> "Invalid code point" + | Unterminated_backslash -> "\\ ended unexpectedly" + | Invalid_escape_code c -> "Invalid escape code: " ^ String.make 1 c + | Invalid_hex_escape -> + "Invalid \\x escape" + | Invalid_unicode_escape -> "Invalid \\u escape" + + + +type exn += Error of int (* offset *) * error + + + + +let error ~loc error = + raise (Error (loc, error)) + +(** Note the [loc] really should be the utf8-offset, it has nothing to do with our + escaping mechanism +*) +(* we can not just print new line in ES5 + seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since + ocaml multiple-line allows [\n] + visual input while es5 string + does not*) + +let rec check_and_transform (loc : int ) buf s byte_offset s_len = + if byte_offset = s_len then () + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single 92 (* '\\' *) -> + escape_code (loc + 1) buf s (byte_offset+1) s_len + | Single 34 -> + Buffer.add_string buf "\\\""; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 39 -> + Buffer.add_string buf "\\'"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 10 -> + Buffer.add_string buf "\\n"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single 13 -> + Buffer.add_string buf "\\r"; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + | Single _ -> + Buffer.add_char buf current_char; + check_and_transform (loc + 1) buf s (byte_offset + 1) s_len + + | Invalid + | Cont _ -> error ~loc Invalid_code_point + | Leading (n,_) -> + let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + error ~loc Invalid_code_point + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform (loc + 1 ) buf s (i' + 1) s_len + end +(* we share the same escape sequence with js *) +and escape_code loc buf s offset s_len = + if offset >= s_len then + error ~loc Unterminated_backslash + else + Buffer.add_char buf '\\'; + let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + begin + Buffer.add_char buf cur_char ; + check_and_transform (loc + 1) buf s (offset + 1) s_len + end + | 'u' -> + begin + Buffer.add_char buf cur_char; + unicode (loc + 1) buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex (loc + 1) buf s (offset + 1) s_len + end + | _ -> error ~loc (Invalid_escape_code cur_char) +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then + error ~loc Invalid_hex_escape; + (*Location.raise_errorf ~loc "\\x need at least two chars";*) + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform (loc + 2) buf s (offset + 2) s_len + end + else + error ~loc Invalid_hex_escape +(*Location.raise_errorf ~loc "%c%c is not a valid hex code" a b*) + +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then + error ~loc Invalid_unicode_escape + (*Location.raise_errorf ~loc "\\u need at least four chars"*) + ; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform (loc + 4) buf s (offset + 4) s_len + end + else + error ~loc Invalid_unicode_escape +(*Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" + a0 a1 a2 a3 *) +(* http://www.2ality.com/2015/01/es6-strings.html + console.log('\uD83D\uDE80'); (* ES6*) + console.log('\u{1F680}'); +*) + + + + + + + + + +let transform_test s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform 0 buf s 0 s_len; + Buffer.contents buf + +let transform loc s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + try + check_and_transform 0 buf s 0 s_len; + Buffer.contents buf + with + Error (offset, error) + -> Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error + + + +end +module Bs_loc : sig +#1 "bs_loc.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. *) + +type t = Location.t = { + loc_start : Lexing.position; + loc_end : Lexing.position ; + loc_ghost : bool +} + +val is_ghost : t -> bool +val merge : t -> t -> t +val none : t + + +end = struct +#1 "bs_loc.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. *) + + +type t = Location.t = { + loc_start : Lexing.position; + loc_end : Lexing.position ; + loc_ghost : bool +} + +let is_ghost x = x.loc_ghost + +let merge (l: t) (r : t) = + if is_ghost l then r + else if is_ghost r then l + else match l,r with + | {loc_start ; }, {loc_end; _} (* TODO: improve*) + -> + {loc_start ;loc_end; loc_ghost = false} + +let none = Location.none + +end +module Ast_utf8_string_interp : sig +#1 "ast_utf8_string_interp.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. *) + + + + type kind = + | String + | Var of int * int (* int records its border length *) + +type error = private + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + | Unterminated_variable + | Unmatched_paren + | Invalid_syntax_of_var of string + +(** Note the position is about code point *) +type pos = { lnum : int ; offset : int ; byte_bol : int } + +type segment = { + start : pos; + finish : pos ; + kind : kind; + content : string ; +} + +type segments = segment list + +type cxt = { + mutable segment_start : pos ; + buf : Buffer.t ; + s_len : int ; + mutable segments : segments; + mutable pos_bol : int; (* record the abs position of current beginning line *) + mutable byte_bol : int ; + mutable pos_lnum : int ; (* record the line number *) +} + +type exn += Error of pos * pos * error + +val empty_segment : segment -> bool + +val transform_test : string -> segment list + + + +val transform : + Parsetree.expression -> + string -> + string -> + Parsetree.expression + +val is_unicode_string : + string -> + bool + +val is_unescaped : + string -> + bool +end = struct +#1 "ast_utf8_string_interp.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. *) + +type error = + | Invalid_code_point + | Unterminated_backslash + | Invalid_escape_code of char + | Invalid_hex_escape + | Invalid_unicode_escape + | Unterminated_variable + | Unmatched_paren + | Invalid_syntax_of_var of string + +type kind = + | String + | Var of int * int +(* [Var (loffset, roffset)] + For parens it used to be (2,-1) + for non-parens it used to be (1,0) +*) + +(** Note the position is about code point *) +type pos = { + lnum : int ; + offset : int ; + byte_bol : int (* Note it actually needs to be in sync with OCaml's lexing semantics *) +} + + +type segment = { + start : pos; + finish : pos ; + kind : kind; + content : string ; +} + +type segments = segment list + + +type cxt = { + mutable segment_start : pos ; + buf : Buffer.t ; + s_len : int ; + mutable segments : segments; + mutable pos_bol : int; (* record the abs position of current beginning line *) + mutable byte_bol : int ; + mutable pos_lnum : int ; (* record the line number *) +} + + +type exn += Error of pos * pos * error + +let pp_error fmt err = + Format.pp_print_string fmt @@ match err with + | Invalid_code_point -> "Invalid code point" + | Unterminated_backslash -> "\\ ended unexpectedly" + | Invalid_escape_code c -> "Invalid escape code: " ^ String.make 1 c + | Invalid_hex_escape -> + "Invalid \\x escape" + | Invalid_unicode_escape -> "Invalid \\u escape" + | Unterminated_variable -> "$ unterminated" + | Unmatched_paren -> "Unmatched paren" + | Invalid_syntax_of_var s -> "`" ^s ^ "' is not a valid syntax of interpolated identifer" +let valid_lead_identifier_char x = + match x with + | 'a'..'z' | '_' -> true + | _ -> false + +let valid_identifier_char x = + match x with + | 'a'..'z' + | 'A'..'Z' + | '0'..'9' + | '_' | '\''-> true + | _ -> false +(** Invariant: [valid_lead_identifier] has to be [valid_identifier] *) + +let valid_identifier s = + let s_len = String.length s in + if s_len = 0 then false + else + valid_lead_identifier_char s.[0] && + Ext_string.for_all_from s 1 valid_identifier_char + + +let is_space x = + match x with + | ' ' | '\n' | '\t' -> true + | _ -> false + + + +(** + FIXME: multiple line offset + if there is no line offset. Note {|{j||} border will never trigger a new line +*) +let update_position border + ({lnum ; offset;byte_bol } : pos) + (pos : Lexing.position)= + if lnum = 0 then + {pos with pos_cnum = pos.pos_cnum + border + offset } + (** When no newline, the column number is [border + offset] *) + else + { + pos with + pos_lnum = pos.pos_lnum + lnum ; + pos_bol = pos.pos_cnum + border + byte_bol; + pos_cnum = pos.pos_cnum + border + byte_bol + offset; + (** when newline, the column number is [offset] *) + } +let update border + (start : pos) + (finish : pos) (loc : Location.t) : Location.t = + let start_pos = loc.loc_start in + { loc with + loc_start = + update_position border start start_pos; + loc_end = + update_position border finish start_pos + } + + +(** Note [Var] kind can not be mpty *) +let empty_segment {content } = + Ext_string.is_empty content + + + +let update_newline ~byte_bol loc cxt = + cxt.pos_lnum <- cxt.pos_lnum + 1 ; + cxt.pos_bol <- loc; + cxt.byte_bol <- byte_bol + +let pos_error cxt ~loc error = + raise (Error + (cxt.segment_start, + { lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; byte_bol = cxt.byte_bol}, error)) + +let add_var_segment cxt loc loffset roffset = + let content = Buffer.contents cxt.buf in + Buffer.clear cxt.buf ; + let next_loc = { + lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; + byte_bol = cxt.byte_bol } in + if valid_identifier content then + begin + cxt.segments <- + { start = cxt.segment_start; + finish = next_loc ; + kind = Var (loffset, roffset); + content} :: cxt.segments ; + cxt.segment_start <- next_loc + end + else pos_error cxt ~loc (Invalid_syntax_of_var content) + +let add_str_segment cxt loc = + let content = Buffer.contents cxt.buf in + Buffer.clear cxt.buf ; + let next_loc = { + lnum = cxt.pos_lnum ; offset = loc - cxt.pos_bol ; + byte_bol = cxt.byte_bol } in + cxt.segments <- + { start = cxt.segment_start; + finish = next_loc ; + kind = String; + content} :: cxt.segments ; + cxt.segment_start <- next_loc + + + + + +let rec check_and_transform (loc : int ) s byte_offset ({s_len; buf} as cxt : cxt) = + if byte_offset = s_len then + add_str_segment cxt loc + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single 92 (* '\\' *) -> + escape_code (loc + 1) s (byte_offset+1) cxt + | Single 34 -> + Buffer.add_string buf "\\\""; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 39 -> + Buffer.add_string buf "\\'"; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 10 -> + + Buffer.add_string buf "\\n"; + let loc = loc + 1 in + let byte_offset = byte_offset + 1 in + update_newline ~byte_bol:byte_offset loc cxt ; (* Note variable could not have new-line *) + check_and_transform loc s byte_offset cxt + | Single 13 -> + Buffer.add_string buf "\\r"; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + | Single 36 -> (* $ *) + add_str_segment cxt loc ; + let offset = byte_offset + 1 in + if offset >= s_len then + pos_error ~loc cxt Unterminated_variable + else + let cur_char = s.[offset] in + if cur_char = '(' then + expect_var_paren (loc + 2) s (offset + 1) cxt + else + expect_simple_var (loc + 1) s offset cxt + | Single _ -> + Buffer.add_char buf current_char; + check_and_transform (loc + 1) s (byte_offset + 1) cxt + + | Invalid + | Cont _ -> pos_error ~loc cxt Invalid_code_point + | Leading (n,_) -> + let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + pos_error cxt ~loc Invalid_code_point + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform (loc + 1 ) s (i' + 1) cxt + end +(**Lets keep identifier simple, so that we could generating a function easier in the future + for example + let f = [%fn{| $x + $y = $x_add_y |}] +*) +and expect_simple_var loc s offset ({buf; s_len} as cxt) = + let v = ref offset in + (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) + if not (offset < s_len && valid_lead_identifier_char s.[offset]) then + pos_error cxt ~loc (Invalid_syntax_of_var Ext_string.empty) + else + begin + while !v < s_len && valid_identifier_char s.[!v] do (* TODO*) + let cur_char = s.[!v] in + Buffer.add_char buf cur_char; + incr v ; + done; + let added_length = !v - offset in + let loc = added_length + loc in + add_var_segment cxt loc 1 0 ; + check_and_transform loc s (added_length + offset) cxt + end +and expect_var_paren loc s offset ({buf; s_len} as cxt) = + let v = ref offset in + (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) + while !v < s_len && s.[!v] <> ')' do + let cur_char = s.[!v] in + Buffer.add_char buf cur_char; + incr v ; + done; + let added_length = !v - offset in + let loc = added_length + 1 + loc in + if !v < s_len && s.[!v] = ')' then + begin + add_var_segment cxt loc 2 (-1) ; + check_and_transform loc s (added_length + 1 + offset) cxt + end + else + pos_error cxt ~loc Unmatched_paren + + + + + +(* we share the same escape sequence with js *) +and escape_code loc s offset ({ buf; s_len} as cxt) = + if offset >= s_len then + pos_error cxt ~loc Unterminated_backslash + else + Buffer.add_char buf '\\'; + let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + begin + Buffer.add_char buf cur_char ; + check_and_transform (loc + 1) s (offset + 1) cxt + end + | 'u' -> + begin + Buffer.add_char buf cur_char; + unicode (loc + 1) s (offset + 1) cxt + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex (loc + 1) s (offset + 1) cxt + end + | _ -> pos_error cxt ~loc (Invalid_escape_code cur_char) +and two_hex loc s offset ({buf ; s_len} as cxt) = + if offset + 1 >= s_len then + pos_error cxt ~loc Invalid_hex_escape; + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform (loc + 2) s (offset + 2) cxt + end + else + pos_error cxt ~loc Invalid_hex_escape + + +and unicode loc s offset ({buf ; s_len} as cxt) = + if offset + 3 >= s_len then + pos_error cxt ~loc Invalid_unicode_escape + ; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform (loc + 4) s (offset + 4) cxt + end + else + pos_error cxt ~loc Invalid_unicode_escape +let transform_test s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + let cxt = + { segment_start = {lnum = 0; offset = 0; byte_bol = 0}; + buf ; + s_len; + segments = []; + pos_lnum = 0; + byte_bol = 0; + pos_bol = 0; + + } in + check_and_transform 0 s 0 cxt; + List.rev cxt.segments + + +(** TODO: test empty var $() $ failure, + Allow identifers x.A.y *) + +open Ast_helper + +(** Longident.parse "Pervasives.^" *) +let concat_ident : Longident.t = + Ldot (Lident "Pervasives", "^") (* FIXME: remove deps on `Pervasives` *) + (* JS string concatMany *) + (* Ldot (Ldot (Lident "Js", "String2"), "concat") *) + +(* Longident.parse "Js.String.make" *) +let to_string_ident : Longident.t = + Ldot (Ldot (Lident "Js", "String2"), "make") + + +let escaped_j_delimiter = "*j" (* not user level syntax allowed *) +let unescaped_j_delimiter = "j" +let unescaped_js_delimiter = "js" + +let escaped = Some escaped_j_delimiter + +let concat_exp + (a : Parsetree.expression) + (b : Parsetree.expression) : Parsetree.expression = + let loc = Bs_loc.merge a.pexp_loc b.pexp_loc in + Ast_compatible.apply_simple ~loc + (Exp.ident { txt =concat_ident; loc}) + [a ; + b] + +let border = String.length "{j|" + +let aux loc (segment : segment) = + match segment with + | {start ; finish; kind ; content} + -> + begin match kind with + | String -> + let loc = update border start finish loc in + Ast_compatible.const_exp_string + content ?delimiter:escaped ~loc + | Var (soffset, foffset) -> + let loc = { + loc with + loc_start = update_position (soffset + border) start loc.loc_start ; + loc_end = update_position (foffset + border) finish loc.loc_start + } in + Ast_compatible.apply_simple ~loc + (Exp.ident ~loc {loc ; txt = to_string_ident }) + [ + Exp.ident ~loc {loc ; txt = Lident content} + ] + end + + +let transform_interp loc s = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2 ) in + try + let cxt : cxt = + { segment_start = {lnum = 0; offset = 0; byte_bol = 0}; + buf ; + s_len; + segments = []; + pos_lnum = 0; + byte_bol = 0; + pos_bol = 0; + + } in + + check_and_transform 0 s 0 cxt; + let rev_segments = cxt.segments in + match rev_segments with + | [] -> + Ast_compatible.const_exp_string ~loc "" ?delimiter:escaped + | [ segment] -> + aux loc segment + | a::rest -> + Ext_list.fold_left rest (aux loc a) (fun acc x -> + concat_exp (aux loc x) acc ) + with + Error (start,pos, error) + -> + Location.raise_errorf ~loc:(update border start pos loc ) + "%a" pp_error error + + +let transform (e : Parsetree.expression) s delim : Parsetree.expression = + if Ext_string.equal delim unescaped_js_delimiter then + let js_str = Ast_utf8_string.transform e.pexp_loc s in + { e with pexp_desc = + Pexp_constant ( + + Pconst_string + + (js_str, escaped))} + else if Ext_string.equal delim unescaped_j_delimiter then + transform_interp e.pexp_loc s + else e + +let is_unicode_string opt = Ext_string.equal opt escaped_j_delimiter + +let is_unescaped s = + Ext_string.equal s unescaped_j_delimiter + || Ext_string.equal s unescaped_js_delimiter +end +module Js_config : sig +#1 "js_config.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 get_packages_info : + unit -> Js_packages_info.t *) + + +(** set/get header *) +val no_version_header : bool ref + + +(** return [package_name] and [path] + when in script mode: +*) + +(* val get_current_package_name_and_path : + Js_packages_info.module_system -> + Js_packages_info.info_query *) + + +(* val set_package_name : string -> unit +val get_package_name : unit -> string option *) + +(** cross module inline option *) +val cross_module_inline : bool ref +val set_cross_module_inline : bool -> unit +val get_cross_module_inline : unit -> bool + +(** diagnose option *) +val diagnose : bool ref +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit + + +(** options for builtin ppx *) +val no_builtin_ppx_ml : bool ref +val no_builtin_ppx_mli : bool ref + + + +val no_warn_unimplemented_external : bool ref + +(** check-div-by-zero option *) +val check_div_by_zero : bool ref +val get_check_div_by_zero : unit -> bool + + + + + +(** Debugging utilies *) +val set_current_file : string -> unit +val get_current_file : unit -> string +val get_module_name : unit -> string + +val iset_debug_file : string -> unit +val set_debug_file : string -> unit +val get_debug_file : unit -> string + +val is_same_file : unit -> bool + +val tool_name : string + + +val sort_imports : bool ref +val dump_js : bool ref +val syntax_only : bool ref +val binary_ast : bool ref + + +val bs_suffix : bool ref +val debug : bool ref + +val cmi_only : bool ref +val force_cmi : bool ref +val force_cmj : bool ref +end = struct +#1 "js_config.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 add_npm_package_path s = + match !packages_info with + | Empty -> + Ext_pervasives.bad_argf "please set package name first using -bs-package-name "; + | NonBrowser(name, envs) -> + let env, path = + match Ext_string.split ~keep_empty:false s ':' with + | [ package_name; path] -> + (match Js_packages_info.module_system_of_string package_name with + | Some x -> x + | None -> + Ext_pervasives.bad_argf "invalid module system %s" package_name), path + | [path] -> + NodeJS, path + | _ -> + Ext_pervasives.bad_argf "invalid npm package path: %s" s + in + packages_info := NonBrowser (name, ((env,path) :: envs)) *) +(** Browser is not set via command line only for internal use *) + + +let no_version_header = ref false + +let cross_module_inline = ref false + +let get_cross_module_inline () = !cross_module_inline +let set_cross_module_inline b = + cross_module_inline := b + + +let diagnose = ref false +let get_diagnose () = !diagnose +let set_diagnose b = diagnose := b + +let (//) = Filename.concat + +(* let get_packages_info () = !packages_info *) + +let no_builtin_ppx_ml = ref false +let no_builtin_ppx_mli = ref false + + +(** TODO: will flip the option when it is ready *) +let no_warn_unimplemented_external = ref false +let current_file = ref "" +let debug_file = ref "" + +let set_current_file f = current_file := f +let get_current_file () = !current_file +let get_module_name () = + Filename.chop_extension + (Filename.basename (Ext_string.uncapitalize_ascii !current_file)) + +let iset_debug_file _ = () +let set_debug_file f = debug_file := f +let get_debug_file () = !debug_file + + +let is_same_file () = + !debug_file <> "" && !debug_file = !current_file + +let tool_name = "BuckleScript" + +let check_div_by_zero = ref true +let get_check_div_by_zero () = !check_div_by_zero + + + + +let sort_imports = ref true +let dump_js = ref false + + + +let syntax_only = ref false +let binary_ast = ref false + +let bs_suffix = ref false + +let debug = ref false + +let cmi_only = ref false +let force_cmi = ref false +let force_cmj = ref false +end +module Bs_warnings : sig +#1 "bs_warnings.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. *) + + +type t = + | Unsafe_poly_variant_type + +val prerr_bs_ffi_warning : Location.t -> t -> unit + + +val warn_missing_primitive : Location.t -> string -> unit + +val warn_literal_overflow : Location.t -> unit + +val error_unescaped_delimiter : + Location.t -> string -> unit +end = struct +#1 "bs_warnings.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. *) + + + +type t = + | Unsafe_poly_variant_type + (* for users write code like this: + {[ external f : [`a of int ] -> string = ""]} + Here users forget about `[@bs.string]` or `[@bs.int]` + *) + + + +let to_string t = + match t with + | Unsafe_poly_variant_type + -> + "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + +let warning_formatter = Format.err_formatter + +let print_string_warning (loc : Location.t) x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." + (Js_config.get_current_file ()) + else + Location.print warning_formatter loc ; + Format.fprintf warning_formatter "@{Warning@}: %s@." x + +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = + | Uninterpreted_delimiters of string + | Unimplemented_primitive of string +exception Error of Location.t * error + +let pp_error fmt x = + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters" ; + Format.pp_print_string fmt str + + + +let () = + Location.register_error_of_exn (function + | Error (loc,err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None + ) + + + + +let warn_missing_primitive loc txt = + if not @@ !Js_config.no_warn_unimplemented_external then + begin + print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); + Format.pp_print_flush warning_formatter () + end + +let warn_literal_overflow loc = + begin + print_string_warning loc + "Integer literal exceeds the range of representable integers of type int"; + Format.pp_print_flush warning_formatter () + end + +let error_unescaped_delimiter loc txt = + raise (Error(loc, Uninterpreted_delimiters txt)) + + + + + + +(** + Note the standard way of reporting error in compiler: + + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> + (Format.formatter -> error -> unit) -> error -> Location.error + + Define an error type + + type error + exception Error of Location.t * error + + Provide a printer to error + + {[ + let () = + Location.register_error_of_exn + (function + | Error(loc,err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None + ) + ]} +*) + +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 +#1 "hash_set_gen.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. *) + + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) + +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a list array; (* the buckets *) + initial_size: int; (* initial array size *) + } + + + + +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; data = Array.make s [] } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + Array.unsafe_set h.data i [] + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size [ ] + + +let copy h = { h with data = Array.copy h.data } + +let length h = h.size + +let iter h f = + let rec do_bucket = function + | [ ] -> + () + | k :: rest -> + f k ; 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 h init f = + let rec do_bucket b accu = + match b with + [ ] -> + accu + | k :: rest -> + do_bucket rest (f k accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu + +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 [ ] in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + [ ] -> () + | key :: rest -> + let nidx = indexfun h key in + ndata.(nidx) <- key :: ndata.(nidx); + insert_bucket rest + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done + end + +let elements set = + fold set [] (fun k acc -> k :: acc) + + + + +let stats h = + let mbl = + Ext_array.fold_left h.data 0 (fun m b -> max m (List.length b)) in + let histo = Array.make (mbl + 1) 0 in + Ext_array.iter h.data + (fun b -> + let l = List.length b in + histo.(l) <- histo.(l) + 1) + ; + {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 key lst = + match lst with + | [] -> false + | key1::rest -> + eq_key key key1 || + match rest with + | [] -> false + | key2 :: rest -> + eq_key key key2 || + match rest with + | [] -> false + | key3 :: rest -> + eq_key key key3 || + small_bucket_mem eq_key key rest + +let rec remove_bucket eq_key key (h : _ t) buckets = + match buckets with + | [ ] -> + [ ] + | k :: next -> + if eq_key k key + then begin h.size <- h.size - 1; next end + else k :: remove_bucket eq_key key h next + +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + val copy: t -> t + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + val stats: t -> Hashtbl.statistics + val elements : t -> key list +end + +end +module Hash_set_poly : sig +#1 "hash_set_poly.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. *) + + +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 -> 'a -> unit +val remove : 'a t -> 'a -> unit + +val mem : 'a t -> 'a -> bool + +val iter : 'a t -> ('a -> unit) -> unit + +val elements : 'a t -> 'a list + +val length : 'a t -> int + +val stats: 'a t -> Hashtbl.statistics + +end = struct +#1 "hash_set_poly.ml" +# 1 "ext/hash_set.cppo.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. *) +# 51 "ext/hash_set.cppo.ml" +[@@@ocaml.warning "-3"] +(* we used cppo the mixture does not work*) +external seeded_hash_param : + int -> int -> int -> 'a -> int = "caml_hash" "noalloc" +let key_index (h : _ Hash_set_gen.t ) (key : 'a) = + seeded_hash_param 10 100 0 key land (Array.length h.data - 1) +let eq_key = (=) +type 'a t = 'a Hash_set_gen.t + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Bs_ast_invariant : sig +#1 "bs_ast_invariant.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. *) + + +type iterator = Ast_iterator.iterator + +val mark_used_bs_attribute : + Parsetree.attribute -> unit + +(** [warn_discarded_unused_attributes discarded] + warn if [discarded] has unused bs attribute +*) +val warn_discarded_unused_attributes : + Parsetree.attributes -> unit +(** Ast invariant checking for detecting errors *) + +val emit_external_warnings_on_structure: + Parsetree.structure -> unit + +val emit_external_warnings_on_signature: + Parsetree.signature -> unit +end = struct +#1 "bs_ast_invariant.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 is_bs_attribute txt = + let len = String.length txt in + len >= 2 && + (*TODO: check the stringing padding rule, this preciate may not be needed *) + String.unsafe_get txt 0 = 'b'&& + String.unsafe_get txt 1 = 's' && + (len = 2 || + String.unsafe_get txt 2 = '.' + ) + +let used_attributes : _ Hash_set_poly.t = Hash_set_poly.create 16 + + + +(* only mark non-ghost used bs attribute *) +let mark_used_bs_attribute ((x,_) : Parsetree.attribute) = + if not x.loc.loc_ghost then + Hash_set_poly.add used_attributes x + +let dummy_unused_attribute : Warnings.t = (Bs_unused_attribute "") + + + +let warn_unused_attribute + (({txt; loc} as sloc, _) : Parsetree.attribute) = + if is_bs_attribute txt && + not loc.loc_ghost && + not (Hash_set_poly.mem used_attributes sloc) then + begin + + Location.prerr_warning loc (Bs_unused_attribute txt) + end + +let warn_discarded_unused_attributes (attrs : Parsetree.attributes) = + if attrs <> [] then + Ext_list.iter attrs warn_unused_attribute + + +type iterator = Ast_iterator.iterator +let default_iterator = Ast_iterator.default_iterator + +(* Note we only used Bs_ast_iterator here, we can reuse compiler-libs instead of + rolling our own*) +let emit_external_warnings : iterator= + { + default_iterator with + attribute = (fun _ attr -> warn_unused_attribute attr); + expr = (fun self a -> + match a.pexp_desc with + | Pexp_constant ( + + Pconst_string + + (_, Some s)) + when Ast_utf8_string_interp.is_unescaped s -> + Bs_warnings.error_unescaped_delimiter a.pexp_loc s + + | Pexp_constant(Pconst_integer(s,None)) -> + (* range check using int32 + It is better to give a warning instead of error to avoid make people unhappy. + It also has restrictions in which platform bsc is running on since it will + affect int ranges + *) + ( + try + ignore ( + if String.length s = 0 || s.[0] = '-' then + Int32.of_string s + else Int32.of_string ("-" ^ s)) + with _ -> + Bs_warnings.warn_literal_overflow a.pexp_loc + ) + + | _ -> default_iterator.expr self a + ); + value_description = + (fun self v -> + match v with + | ( { + pval_loc; + pval_prim = + "%identity"::_; + pval_type + } : Parsetree.value_description) + when not + (Ast_core_type.is_arity_one pval_type) + -> + Location.raise_errorf + ~loc:pval_loc + "%%identity expect its type to be of form 'a -> 'b (arity 1)" + | _ -> + default_iterator.value_description self v + ); + pat = begin fun self (pat : Parsetree.pattern) -> + match pat.ppat_desc with + | Ppat_constant( + + Pconst_string + + (_, Some "j")) -> + Location.raise_errorf ~loc:pat.ppat_loc "Unicode string is not allowed in pattern match" + | _ -> default_iterator.pat self pat + end + } + +let emit_external_warnings_on_structure (stru : Parsetree.structure) = + if Warnings.is_active dummy_unused_attribute then + emit_external_warnings.structure emit_external_warnings stru + +let emit_external_warnings_on_signature (sigi : Parsetree.signature) = + if Warnings.is_active dummy_unused_attribute then + emit_external_warnings.signature emit_external_warnings sigi +end +module Literals : sig +#1 "literals.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 js_array_ctor : string +val js_type_number : string +val js_type_string : string +val js_type_object : string +val js_type_boolean : string +val js_undefined : string +val js_prop_length : string + +val param : string +val partial_arg : string +val prim : string + +(**temporary varaible used in {!Js_ast_util} *) +val tmp : string + +val create : string +val runtime : string +val stdlib : string +val imul : string + +val setter_suffix : string +val setter_suffix_len : int + + +val debugger : string +val raw_expr : string +val raw_stmt : string +val raw_function : string +val unsafe_downgrade : string +val fn_run : string +val method_run : string +val fn_method : string +val fn_mk : string + +(** callback actually, not exposed to user yet *) +(* val js_fn_runmethod : string *) + +val bs_deriving : string +val bs_deriving_dot : string +val bs_type : string + +(** nodejs *) + +val node_modules : string +val node_modules_length : int +val package_json : string +val bsconfig_json : string +val build_ninja : string + +(* Name of the library file created for each external dependency. *) +val library_file : string + +val suffix_a : string +val suffix_cmj : string +val suffix_cmo : string +val suffix_cma : string +val suffix_cmi : string +val suffix_cmx : string +val suffix_cmxa : string +val suffix_ml : string +val suffix_mlast : string +val suffix_mlast_simple : string +val suffix_mliast : string +val suffix_mliast_simple : string +val suffix_mlmap : string +val suffix_mll : string +val suffix_re : string +val suffix_rei : string + +val suffix_d : string +val suffix_js : string +val suffix_bs_js : string +(* val suffix_re_js : string *) +val suffix_gen_js : string +val suffix_gen_tsx: string + +val suffix_tsx : string +val suffix_mlastd : string +val suffix_mliastd : string + +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string + +val commonjs : string +val amdjs : string +val es6 : string +val es6_global : string +val amdjs_global : string +val unused_attribute : string +val dash_nostdlib : string + +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string + +val native : string +val bytecode : string +val js : string + +val node_sep : string +val node_parent : string +val node_current : string +val gentype_import : string +end = struct +#1 "literals.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 js_array_ctor = "Array" +let js_type_number = "number" +let js_type_string = "string" +let js_type_object = "object" +let js_type_boolean = "boolean" +let js_undefined = "undefined" +let js_prop_length = "length" + +let prim = "prim" +let param = "param" +let partial_arg = "partial_arg" +let tmp = "tmp" + +let create = "create" (* {!Caml_exceptions.create}*) + +let runtime = "runtime" (* runtime directory *) + +let stdlib = "stdlib" + +let imul = "imul" (* signed int32 mul *) + +let setter_suffix = "#=" +let setter_suffix_len = String.length setter_suffix + +let debugger = "debugger" +let raw_expr = "raw_expr" +let raw_stmt = "raw_stmt" +let raw_function = "raw_function" +let unsafe_downgrade = "unsafe_downgrade" +let fn_run = "fn_run" +let method_run = "method_run" + +let fn_method = "fn_method" +let fn_mk = "fn_mk" +(*let js_fn_runmethod = "js_fn_runmethod"*) + +let bs_deriving = "bs.deriving" +let bs_deriving_dot = "bs.deriving." +let bs_type = "bs.type" + + +(** nodejs *) +let node_modules = "node_modules" +let node_modules_length = String.length "node_modules" +let package_json = "package.json" +let bsconfig_json = "bsconfig.json" +let build_ninja = "build.ninja" + +(* Name of the library file created for each external dependency. *) +let library_file = "lib" + +let suffix_a = ".a" +let suffix_cmj = ".cmj" +let suffix_cmo = ".cmo" +let suffix_cma = ".cma" +let suffix_cmi = ".cmi" +let suffix_cmx = ".cmx" +let suffix_cmxa = ".cmxa" +let suffix_mll = ".mll" +let suffix_ml = ".ml" +let suffix_mli = ".mli" +let suffix_re = ".re" +let suffix_rei = ".rei" +let suffix_mlmap = ".mlmap" + +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" +let suffix_mlast = ".mlast" +let suffix_mlast_simple = ".mlast_simple" +let suffix_mliast = ".mliast" +let suffix_mliast_simple = ".mliast_simple" +let suffix_d = ".d" +let suffix_mlastd = ".mlast.d" +let suffix_mliastd = ".mliast.d" +let suffix_js = ".js" +let suffix_bs_js = ".bs.js" +(* let suffix_re_js = ".re.js" *) +let suffix_gen_js = ".gen.js" +let suffix_gen_tsx = ".gen.tsx" +let suffix_tsx = ".tsx" + +let commonjs = "commonjs" +let amdjs = "amdjs" +let es6 = "es6" +let es6_global = "es6-global" +let amdjs_global = "amdjs-global" +let unused_attribute = "Unused attribute " +let dash_nostdlib = "-nostdlib" + +let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" +let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" + +let native = "native" +let bytecode = "bytecode" +let js = "js" + + + +(** Used when produce node compatible paths *) +let node_sep = "/" +let node_parent = ".." +let node_current = "." + +let gentype_import = "genType.import" +end +module Ast_attributes : sig +#1 "ast_attributes.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. *) +type attr = Parsetree.attribute +type t = attr list + +type ('a,'b) st = + { get : 'a option ; + set : 'b option } + +val process_method_attributes_rev : + t -> + (bool * bool , [`Get | `No_get ]) st * t + +type attr_kind = + | Nothing + | Meth_callback of attr + | Uncurry of attr + | Method of attr + +val process_attributes_rev : + t -> attr_kind * t + +val process_pexp_fun_attributes_rev : + t -> bool * t + +val process_bs : + t -> bool * t + +val external_needs_to_be_encoded : + t -> bool + +type derive_attr = { + explict_nonrec : bool; + bs_deriving : Ast_payload.action list option +} + + +val iter_process_bs_string_int_unwrap_uncurry : + t -> + [`Nothing | `String | `Int | `Ignore | `Unwrap | `Uncurry of int option ] + + +val iter_process_bs_string_as : + t -> string option + +val iter_process_bs_string_as_ast : + t -> + Parsetree.expression option + +val has_bs_optional : + t -> bool + +val iter_process_bs_int_as : + t -> int option + + +val iter_process_bs_string_or_int_as : + t -> + [ `Int of int + | `Str of string + | `Json_str of string ] option + + +val process_derive_type : + t -> derive_attr * t + +val iter_process_derive_type : + t -> derive_attr + + +val bs : attr +val is_bs : attr -> bool + + + +val bs_get : attr +val bs_get_arity : attr +val bs_set : attr +val bs_return_undefined : attr + +val deprecated : string -> attr + +end = struct +#1 "ast_attributes.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. *) + +type attr = Parsetree.attribute +type t = attr list + +type ('a,'b) st = + { get : 'a option ; + set : 'b option } + + +let process_method_attributes_rev (attrs : t) = + Ext_list.fold_left attrs ({get = None ; set = None}, []) (fun (st,acc) (({txt ; loc}, payload) as attr ) -> + match txt with + | "bs.get" (* [@@bs.get{null; undefined}]*) + -> + let result = + Ext_list.fold_left (Ast_payload.ident_or_record_as_config loc payload) (false, false) + (fun (null, undefined) ({txt ; loc}, opt_expr) -> + match txt with + | "null" -> + (match opt_expr with + | None -> true + | Some e -> + Ast_payload.assert_bool_lit e), undefined + + | "undefined" -> + null, + (match opt_expr with + | None -> true + | Some e -> + Ast_payload.assert_bool_lit e) + | "nullable" -> + begin match opt_expr with + | None -> true, true + | Some e -> + let v = Ast_payload.assert_bool_lit e in + v,v + end + | _ -> Bs_syntaxerr.err loc Unsupported_predicates + ) in + + ({st with get = Some result}, acc ) + + | "bs.set" + -> + let result = + Ext_list.fold_left (Ast_payload.ident_or_record_as_config loc payload) `Get + (fun st ({txt ; loc}, opt_expr) -> + if txt = "no_get" then + match opt_expr with + | None -> `No_get + | Some e -> + if Ast_payload.assert_bool_lit e then + `No_get + else `Get + else Bs_syntaxerr.err loc Unsupported_predicates + ) in + (* properties -- void + [@@bs.set{only}] + *) + {st with set = Some result }, acc + | _ -> + (st, attr::acc ) + ) + +type attr_kind = + | Nothing + | Meth_callback of attr + | Uncurry of attr + | Method of attr + +let process_attributes_rev (attrs : t) : attr_kind * t = + Ext_list.fold_left attrs ( Nothing, []) (fun (st, acc) (({txt; loc}, _) as attr) -> + match txt, st with + | "bs", (Nothing | Uncurry _) + -> + Uncurry attr, acc (* TODO: warn unused/duplicated attribute *) + | "bs.this", (Nothing | Meth_callback _) + -> Meth_callback attr, acc + | "bs.meth", (Nothing | Method _) + -> Method attr, acc + | "bs", _ + | "bs.this", _ + -> Bs_syntaxerr.err loc Conflict_bs_bs_this_bs_meth + | _ , _ -> + st, attr::acc + ) + +let process_pexp_fun_attributes_rev (attrs : t) = + Ext_list.fold_left attrs (false, []) (fun (st, acc) (({txt; loc}, _) as attr ) -> + match txt with + | "bs.open" + -> + true, acc + | _ -> + st, attr::acc + ) + + +let process_bs (attrs : t) = + Ext_list.fold_left attrs (false, []) (fun (st, acc) (({txt; loc}, _) as attr ) -> + match txt, st with + | "bs", _ + -> + true, acc + | _ , _ -> + st, attr::acc + ) + +let external_needs_to_be_encoded (attrs : t)= + Ext_list.exists attrs + (fun ({txt; }, _) -> + Ext_string.starts_with txt "bs." || txt = Literals.gentype_import) + + +type derive_attr = { + explict_nonrec : bool; + bs_deriving : Ast_payload.action list option +} + +let process_derive_type (attrs : t) : derive_attr * t = + Ext_list.fold_left attrs ({explict_nonrec = false; bs_deriving = None }, []) + (fun (st, acc) ({txt ; loc}, payload as attr) -> + match st, txt with + | {bs_deriving = None}, "bs.deriving" + -> + {st with + bs_deriving = Some + (Ast_payload.ident_or_record_as_config loc payload)}, acc + | {bs_deriving = Some _}, "bs.deriving" + -> + Bs_syntaxerr.err loc Duplicated_bs_deriving + + | _ , _ -> + let st = + if txt = "nonrec" then + { st with explict_nonrec = true } + else st in + st, attr::acc + ) + +let iter_process_derive_type (attrs : t) = + let st = ref {explict_nonrec = false; bs_deriving = None } in + Ext_list.iter attrs + (fun ({txt ; loc}, payload as attr) -> + match txt with + | "bs.deriving" + -> + let ost = !st in + (match ost with + | {bs_deriving = None } -> + Bs_ast_invariant.mark_used_bs_attribute attr ; + st := + {ost with + bs_deriving = Some + (Ast_payload.ident_or_record_as_config loc payload)} + | {bs_deriving = Some _} -> + Bs_syntaxerr.err loc Duplicated_bs_deriving) + + | "nonrec" -> + st := + { !st with explict_nonrec = true } + (* non bs attribute, no need to mark its use *) + | _ -> () + ) ; + !st + + +(* duplicated [bs.uncurry] [bs.string] not allowed, + it is worse in bs.uncurry since it will introduce + inconsistency in arity + *) +let iter_process_bs_string_int_unwrap_uncurry (attrs : t) = + let st = ref `Nothing in + let assign v (({loc;_}, _ ) as attr : attr) = + if !st = `Nothing then + begin + Bs_ast_invariant.mark_used_bs_attribute attr; + st := v ; + end + else Bs_syntaxerr.err loc Conflict_attributes in + Ext_list.iter attrs (fun (({txt ; loc}, (payload : _ ) ) as attr) -> + match txt with + | "bs.string" + -> assign `String attr + | "bs.int" + -> assign `Int attr + | "bs.ignore" + -> assign `Ignore attr + | "bs.unwrap" + -> assign `Unwrap attr + | "bs.uncurry" + -> + assign (`Uncurry (Ast_payload.is_single_int payload)) attr + | _ -> () + ) ; + !st + + +let iter_process_bs_string_as (attrs : t) : string option = + let st = ref None in + Ext_list.iter attrs + (fun + (({txt ; loc}, payload ) as attr ) -> + match txt with + | "bs.as" + -> + if !st = None then + match Ast_payload.is_single_string payload with + | None -> + Bs_syntaxerr.err loc Expect_string_literal + | Some (v,_dec) -> + Bs_ast_invariant.mark_used_bs_attribute attr ; + st:= Some v + else + Bs_syntaxerr.err loc Duplicated_bs_as + | _ -> () + ) ; + !st + +let iter_process_bs_string_as_ast (attrs : t) : Parsetree.expression option = + let st = ref None in + Ext_list.iter attrs + (fun + (({txt ; loc}, payload ) as attr ) -> + match txt with + | "bs.as" + -> + if !st = None then + match Ast_payload.is_single_string_as_ast payload with + | None -> + Bs_syntaxerr.err loc Expect_string_literal + | Some _ as v -> + Bs_ast_invariant.mark_used_bs_attribute attr ; + st:= v + else + Bs_syntaxerr.err loc Duplicated_bs_as + | _ -> () + ) ; + !st + +let has_bs_optional (attrs : t) : bool = + Ext_list.exists attrs (fun + (({txt ; }, _ ) as attr) -> + match txt with + | "bs.optional" + -> + Bs_ast_invariant.mark_used_bs_attribute attr ; + true + | _ -> false + ) + + + +let iter_process_bs_int_as (attrs : t) = + let st = ref None in + Ext_list.iter attrs + (fun + (({txt ; loc}, payload ) as attr) -> + match txt with + | "bs.as" + -> + if !st = None then + match Ast_payload.is_single_int payload with + | None -> + Bs_syntaxerr.err loc Expect_int_literal + | Some _ as v-> + Bs_ast_invariant.mark_used_bs_attribute attr ; + st := v + else + Bs_syntaxerr.err loc Duplicated_bs_as + | _ -> () + ) ; !st + + +let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = + let st = ref None in + Ext_list.iter attrs + (fun + (({txt ; loc}, payload ) as attr) -> + match txt with + | "bs.as" + -> + if !st = None then + (Bs_ast_invariant.mark_used_bs_attribute attr ; + match Ast_payload.is_single_int payload with + | None -> + begin match Ast_payload.is_single_string payload with + | Some (s,None) -> + st := Some (`Str (s)) + | Some (s, Some "json") -> + st := Some (`Json_str s ) + | None | Some (_, Some _) -> + Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal + + end + | Some v-> + st := (Some (`Int v)) + ) + else + Bs_syntaxerr.err loc Duplicated_bs_as + | _ -> () + + ) ; + !st + +let locg = Location.none +let bs : attr + = {txt = "bs" ; loc = locg}, Ast_payload.empty + +let is_bs (attr : attr) = + match attr with + | {Location.txt = "bs"; _}, _ -> true + | _ -> false + + +let bs_get : attr + = {txt = "bs.get"; loc = locg}, Ast_payload.empty + +let bs_get_arity : attr + = {txt = "internal.arity"; loc = locg}, + PStr + [{pstr_desc = + Pstr_eval ( + Ast_compatible.const_exp_int ~loc:locg 1 + , + []) + ; pstr_loc = locg}] + + +let bs_set : attr + = {txt = "bs.set"; loc = locg}, Ast_payload.empty + +let bs_return_undefined : attr + = + {txt = "bs.return"; loc = locg }, + PStr + [ + {pstr_desc = + Pstr_eval ( + {pexp_desc = + Pexp_ident + { txt = Lident "undefined_to_opt"; + loc = locg}; + pexp_loc = locg; + pexp_attributes = [] + },[]) + ; pstr_loc = locg}] + +let deprecated s : attr = + {txt = "ocaml.deprecated"; loc = locg }, + PStr + [ + {pstr_desc = + Pstr_eval ( + Ast_compatible.const_exp_string ~loc:locg s, + []) + ; pstr_loc = locg}] + +end +module Ast_open_cxt : sig +#1 "ast_open_cxt.mli" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + +type loc = Location.t + +type whole +type t = whole list + +val restore_exp : + Parsetree.expression -> + t -> + Parsetree.expression + +val destruct : + Parsetree.expression -> + t -> + Parsetree.expression * t + +val destruct_open_tuple : + Parsetree.expression -> + t -> + (t * Parsetree.expression list * Parsetree.attributes ) option +end = struct +#1 "ast_open_cxt.ml" +(* Copyright (C) 2019 - Present Authors of BuckleScript + * + * 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. *) + +type loc = Location.t + +type whole = + | Let_open of + (Asttypes.override_flag * Longident.t Asttypes.loc * loc * + Parsetree.attributes) + +type t = whole list + +type exp = Parsetree.expression + +type destruct_output = + exp list + +(** + destruct such pattern + {[ A.B.let open C in (a,b)]} +*) +let rec destruct_open_tuple + (e : Parsetree.expression) + (acc : t) + : (t * destruct_output * _) option = + match e.pexp_desc with + | Pexp_open (flag, lid, cont) + -> + destruct_open_tuple + cont + (Let_open (flag, lid, e.pexp_loc, e.pexp_attributes) :: acc) + | Pexp_tuple es -> Some (acc, es, e.pexp_attributes) + | _ -> None + +let rec destruct + (e : Parsetree.expression) + (acc : t) + = + match e.pexp_desc with + | Pexp_open (flag, lid, cont) + -> + destruct + cont + (Let_open (flag, lid, e.pexp_loc, e.pexp_attributes) :: acc) + | _ -> e, acc + + + +let restore_exp + (xs : Parsetree.expression) + (qualifiers : t) : Parsetree.expression = + Ext_list.fold_left qualifiers xs (fun x hole -> + match hole with + | Let_open (flag, lid,loc,attrs) -> + ({ + pexp_desc = Pexp_open (flag,lid,x); + pexp_attributes = attrs; + pexp_loc = loc + } : Parsetree.expression) + ) +end +module Ast_exp : sig +#1 "ast_exp.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. *) + +type t = Parsetree.expression + +end = struct +#1 "ast_exp.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. *) + +type t = Parsetree.expression + +end +module Ast_external_mk : sig +#1 "ast_external_mk.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. *) + +(** + [local_module loc ~pval_prim ~pval_type args] + generate such code + {[ + let module J = struct + external unsafe_expr : pval_type = pval_prim + end in + J.unssafe_expr args + ]} +*) +val local_external_apply : + Location.t -> + ?pval_attributes:Parsetree.attributes -> + pval_prim:string list -> + pval_type:Parsetree.core_type -> + ?local_module_name:string -> + ?local_fun_name:string -> + Parsetree.expression list -> + Parsetree.expression_desc + + +val local_external_obj : + Location.t -> + ?pval_attributes:Parsetree.attributes -> + pval_prim:string list -> + pval_type:Parsetree.core_type -> + ?local_module_name:string -> + ?local_fun_name:string -> + (string * Parsetree.expression) list -> (* [ (label, exp )]*) + Parsetree.expression_desc + + + +val local_extern_cont : + Location.t -> + ?pval_attributes:Parsetree.attributes -> + pval_prim:string list -> + pval_type:Parsetree.core_type -> + ?local_module_name:string -> + ?local_fun_name:string -> + (Parsetree.expression -> Parsetree.expression) -> Parsetree.expression_desc + +end = struct +#1 "ast_external_mk.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 local_external_apply loc + ?(pval_attributes=[]) + ~pval_prim + ~pval_type + ?(local_module_name = "J") + ?(local_fun_name = "unsafe_expr") + args + : Parsetree.expression_desc = + Pexp_letmodule + ({txt = local_module_name; loc}, + {pmod_desc = + Pmod_structure + [{pstr_desc = + Pstr_primitive + {pval_name = {txt = local_fun_name; loc}; + pval_type ; + pval_loc = loc; + pval_prim ; + pval_attributes }; + pstr_loc = loc; + }]; + pmod_loc = loc; + pmod_attributes = []}, + Ast_compatible.apply_simple + ({pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); + loc}; + pexp_attributes = [] ; + pexp_loc = loc} : Parsetree.expression) args ~loc + ) + +let local_external_obj loc + ?(pval_attributes=[]) + ~pval_prim + ~pval_type + ?(local_module_name = "J") + ?(local_fun_name = "unsafe_expr") + args + : Parsetree.expression_desc = + Pexp_letmodule + ({txt = local_module_name; loc}, + {pmod_desc = + Pmod_structure + [{pstr_desc = + Pstr_primitive + {pval_name = {txt = local_fun_name; loc}; + pval_type ; + pval_loc = loc; + pval_prim ; + pval_attributes }; + pstr_loc = loc; + }]; + pmod_loc = loc; + pmod_attributes = []}, + Ast_compatible.apply_labels + ({pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); + loc}; + pexp_attributes = [] ; + pexp_loc = loc} : Parsetree.expression) args ~loc + ) + +let local_extern_cont loc + ?(pval_attributes=[]) + ~pval_prim + ~pval_type + ?(local_module_name = "J") + ?(local_fun_name = "unsafe_expr") + (cb : Parsetree.expression -> 'a) + : Parsetree.expression_desc = + Pexp_letmodule + ({txt = local_module_name; loc}, + {pmod_desc = + Pmod_structure + [{pstr_desc = + Pstr_primitive + {pval_name = {txt = local_fun_name; loc}; + pval_type ; + pval_loc = loc; + pval_prim ; + pval_attributes }; + pstr_loc = loc; + }]; + pmod_loc = loc; + pmod_attributes = []}, + cb {pexp_desc = Pexp_ident {txt = Ldot (Lident local_module_name, local_fun_name); + loc}; + pexp_attributes = [] ; + pexp_loc = loc} +) + +end +module Ext_json_types += struct +#1 "ext_json_types.ml" +(* Copyright (C) 2015-2017 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. *) + +type loc = Lexing.position +type json_str = + { str : string ; loc : loc} + +type json_flo = + { flo : string ; loc : loc} +type json_array = + { content : t array ; + loc_start : loc ; + loc_end : loc ; + } + +and json_map = + { map : t String_map.t ; loc : loc } +and t = + | True of loc + | False of loc + | Null of loc + | Flo of json_flo + | Str of json_str + | Arr of json_array + | Obj of json_map + + +end +module Ext_position : sig +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +(** [offset pos newpos] + return a new position + here [newpos] is zero based, the use case is that + at position [pos], we get a string and Lexing from that string, + therefore, we get a [newpos] and we need rebase it on top of + [pos] +*) +val offset : t -> t -> t + +val lexbuf_from_channel_with_fname: + in_channel -> string -> + Lexing.lexbuf + +val print : Format.formatter -> t -> unit +end = struct +#1 "ext_position.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. *) + + +type t = Lexing.position = { + pos_fname : string ; + pos_lnum : int ; + pos_bol : int ; + pos_cnum : int +} + +let offset (x : t) (y:t) = + { + x with + pos_lnum = + x.pos_lnum + y.pos_lnum - 1; + pos_cnum = + x.pos_cnum + y.pos_cnum; + pos_bol = + if y.pos_lnum = 1 then + x.pos_bol + else x.pos_cnum + y.pos_bol + } + +let print fmt (pos : t) = + Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) + + + +let lexbuf_from_channel_with_fname ic fname = + let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in + let pos : t = { + pos_fname = fname ; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0 (* copied from zero_pos*) + } in + x.lex_start_p <- pos; + x.lex_curr_p <- pos ; + x + + +end +module Ext_json_parse : sig +#1 "ext_json_parse.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. *) + +type error + +val report_error : Format.formatter -> error -> unit + +exception Error of Lexing.position * Lexing.position * error + +val parse_json_from_string : string -> Ext_json_types.t + +val parse_json_from_chan : + string -> in_channel -> Ext_json_types.t + +val parse_json_from_file : string -> Ext_json_types.t + + +end = struct +#1 "ext_json_parse.ml" +# 1 "ext/ext_json_parse.mll" + +type error = + | Illegal_character of char + | Unterminated_string + | Unterminated_comment + | Illegal_escape of string + | Unexpected_token + | Expect_comma_or_rbracket + | Expect_comma_or_rbrace + | Expect_colon + | Expect_string_or_rbrace + | Expect_eof + (* | Trailing_comma_in_obj *) + (* | Trailing_comma_in_array *) + + +let fprintf = Format.fprintf +let report_error ppf = function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_escape s -> + fprintf ppf "Illegal backslash escape in string or character (%s)" s + | Unterminated_string -> + fprintf ppf "Unterminated_string" + | Expect_comma_or_rbracket -> + fprintf ppf "Expect_comma_or_rbracket" + | Expect_comma_or_rbrace -> + fprintf ppf "Expect_comma_or_rbrace" + | Expect_colon -> + fprintf ppf "Expect_colon" + | Expect_string_or_rbrace -> + fprintf ppf "Expect_string_or_rbrace" + | Expect_eof -> + fprintf ppf "Expect_eof" + | Unexpected_token + -> + fprintf ppf "Unexpected_token" + (* | Trailing_comma_in_obj *) + (* -> fprintf ppf "Trailing_comma_in_obj" *) + (* | Trailing_comma_in_array *) + (* -> fprintf ppf "Trailing_comma_in_array" *) + | Unterminated_comment + -> fprintf ppf "Unterminated_comment" + + +exception Error of Lexing.position * Lexing.position * error + + +let () = + Printexc.register_printer + (function x -> + match x with + | Error (loc_start,loc_end,error) -> + Some (Format.asprintf + "@[%a:@ %a@ -@ %a)@]" + report_error error + Ext_position.print loc_start + Ext_position.print loc_end + ) + + | _ -> None + ) + + + + + +type token = + | Comma + | Eof + | False + | Lbrace + | Lbracket + | Null + | Colon + | Number of string + | Rbrace + | Rbracket + | String of string + | True + +let error (lexbuf : Lexing.lexbuf) e = + raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) + + +let lexeme_len (x : Lexing.lexbuf) = + x.lex_curr_pos - x.lex_start_pos + +let update_loc ({ lex_curr_p; _ } as lexbuf : Lexing.lexbuf) diff = + lexbuf.lex_curr_p <- + { + lex_curr_p with + pos_lnum = lex_curr_p.pos_lnum + 1; + pos_bol = lex_curr_p.pos_cnum - diff; + } + +let char_for_backslash = function + | 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + +let dec_code c1 c2 c3 = + 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) + +let hex_code c1 c2 = + let d1 = Char.code c1 in + let val1 = + if d1 >= 97 then d1 - 87 + else if d1 >= 65 then d1 - 55 + else d1 - 48 in + let d2 = Char.code c2 in + let val2 = + if d2 >= 97 then d2 - 87 + else if d2 >= 65 then d2 - 55 + else d2 - 48 in + val1 * 16 + val2 + +let lf = '\010' + +# 124 "ext/ext_json_parse.ml" +let __ocaml_lex_tables = { + Lexing.lex_base = + "\000\000\239\255\240\255\241\255\000\000\025\000\011\000\244\255\ + \245\255\246\255\247\255\248\255\249\255\000\000\000\000\000\000\ + \041\000\001\000\254\255\005\000\005\000\253\255\001\000\002\000\ + \252\255\000\000\000\000\003\000\251\255\001\000\003\000\250\255\ + \079\000\089\000\099\000\121\000\131\000\141\000\153\000\163\000\ + \001\000\253\255\254\255\023\000\255\255\006\000\246\255\189\000\ + \248\255\215\000\255\255\249\255\249\000\181\000\252\255\009\000\ + \063\000\075\000\234\000\251\255\032\001\250\255"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\255\255\013\000\013\000\016\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\ + \016\000\016\000\255\255\000\000\012\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\013\000\255\255\013\000\255\255\013\000\255\255\ + \255\255\255\255\255\255\001\000\255\255\255\255\255\255\008\000\ + \255\255\255\255\255\255\255\255\006\000\006\000\255\255\006\000\ + \001\000\002\000\255\255\255\255\255\255\255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\000\000\255\255\255\255\255\255\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\ + \255\255\255\255\000\000\255\255\020\000\000\000\255\255\255\255\ + \000\000\255\255\255\255\255\255\000\000\255\255\255\255\000\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \042\000\000\000\000\000\255\255\000\000\047\000\000\000\047\000\ + \000\000\051\000\000\000\000\000\255\255\255\255\000\000\255\255\ + \255\255\255\255\255\255\000\000\255\255\000\000"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\019\000\018\000\018\000\019\000\017\000\019\000\255\255\ + \048\000\019\000\255\255\057\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \019\000\000\000\003\000\000\000\000\000\019\000\000\000\000\000\ + \050\000\000\000\000\000\043\000\008\000\006\000\033\000\016\000\ + \004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\007\000\004\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\005\000\005\000\032\000\044\000\033\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\021\000\057\000\000\000\000\000\000\000\ + \020\000\000\000\000\000\012\000\000\000\011\000\032\000\056\000\ + \000\000\025\000\049\000\000\000\000\000\032\000\014\000\024\000\ + \028\000\000\000\000\000\057\000\026\000\030\000\013\000\031\000\ + \000\000\000\000\022\000\027\000\015\000\029\000\023\000\000\000\ + \000\000\000\000\039\000\010\000\039\000\009\000\032\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\ + \035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\255\255\ + \035\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\038\000\038\000\000\000\000\000\255\255\ + \000\000\056\000\000\000\000\000\055\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\058\000\058\000\058\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\054\000\ + \000\000\054\000\000\000\000\000\000\000\000\000\054\000\000\000\ + \002\000\041\000\000\000\000\000\000\000\255\255\046\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\ + \053\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\255\255\059\000\059\000\059\000\059\000\059\000\059\000\ + \059\000\059\000\059\000\059\000\000\000\000\000\000\000\000\000\ + \000\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\060\000\054\000\000\000\000\000\000\000\000\000\ + \000\000\054\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\000\000\000\000\000\000\000\000\054\000\000\000\000\000\ + \000\000\054\000\000\000\054\000\000\000\000\000\000\000\052\000\ + \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ + \061\000\061\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\017\000\000\000\000\000\019\000\020\000\ + \045\000\019\000\020\000\055\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \000\000\255\255\000\000\255\255\255\255\019\000\255\255\255\255\ + \045\000\255\255\255\255\040\000\000\000\000\000\004\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\ + \006\000\006\000\006\000\006\000\006\000\004\000\043\000\005\000\ + \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ + \005\000\005\000\005\000\016\000\057\000\255\255\255\255\255\255\ + \016\000\255\255\255\255\000\000\255\255\000\000\005\000\056\000\ + \255\255\014\000\045\000\255\255\255\255\004\000\000\000\023\000\ + \027\000\255\255\255\255\057\000\025\000\029\000\000\000\030\000\ + \255\255\255\255\015\000\026\000\000\000\013\000\022\000\255\255\ + \255\255\255\255\032\000\000\000\032\000\000\000\005\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ + \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\ + \034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\035\000\255\255\035\000\255\255\ + \034\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ + \035\000\035\000\035\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\037\000\037\000\037\000\037\000\047\000\ + \034\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ + \038\000\038\000\038\000\039\000\039\000\039\000\039\000\039\000\ + \039\000\039\000\039\000\039\000\039\000\255\255\255\255\047\000\ + \255\255\049\000\255\255\255\255\049\000\053\000\053\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\053\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\049\000\255\255\255\255\255\255\255\255\049\000\255\255\ + \000\000\040\000\255\255\255\255\255\255\020\000\045\000\049\000\ + \049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\ + \049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\047\000\058\000\058\000\058\000\058\000\058\000\058\000\ + \058\000\058\000\058\000\058\000\255\255\255\255\255\255\255\255\ + \255\255\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \052\000\052\000\052\000\049\000\255\255\255\255\255\255\255\255\ + \255\255\049\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\ + \255\255\049\000\255\255\049\000\255\255\255\255\255\255\049\000\ + \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ + \060\000\060\000\052\000\052\000\052\000\052\000\052\000\052\000\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\047\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255"; + Lexing.lex_base_code = + ""; + Lexing.lex_backtrk_code = + ""; + Lexing.lex_default_code = + ""; + Lexing.lex_trans_code = + ""; + Lexing.lex_check_code = + ""; + Lexing.lex_code = + ""; +} + +let rec lex_json buf lexbuf = + __ocaml_lex_lex_json_rec buf lexbuf 0 +and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 142 "ext/ext_json_parse.mll" + ( lex_json buf lexbuf) +# 314 "ext/ext_json_parse.ml" + + | 1 -> +# 143 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + lex_json buf lexbuf + ) +# 322 "ext/ext_json_parse.ml" + + | 2 -> +# 147 "ext/ext_json_parse.mll" + ( comment buf lexbuf) +# 327 "ext/ext_json_parse.ml" + + | 3 -> +# 148 "ext/ext_json_parse.mll" + ( True) +# 332 "ext/ext_json_parse.ml" + + | 4 -> +# 149 "ext/ext_json_parse.mll" + (False) +# 337 "ext/ext_json_parse.ml" + + | 5 -> +# 150 "ext/ext_json_parse.mll" + (Null) +# 342 "ext/ext_json_parse.ml" + + | 6 -> +# 151 "ext/ext_json_parse.mll" + (Lbracket) +# 347 "ext/ext_json_parse.ml" + + | 7 -> +# 152 "ext/ext_json_parse.mll" + (Rbracket) +# 352 "ext/ext_json_parse.ml" + + | 8 -> +# 153 "ext/ext_json_parse.mll" + (Lbrace) +# 357 "ext/ext_json_parse.ml" + + | 9 -> +# 154 "ext/ext_json_parse.mll" + (Rbrace) +# 362 "ext/ext_json_parse.ml" + + | 10 -> +# 155 "ext/ext_json_parse.mll" + (Comma) +# 367 "ext/ext_json_parse.ml" + + | 11 -> +# 156 "ext/ext_json_parse.mll" + (Colon) +# 372 "ext/ext_json_parse.ml" + + | 12 -> +# 157 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 377 "ext/ext_json_parse.ml" + + | 13 -> +# 159 "ext/ext_json_parse.mll" + ( Number (Lexing.lexeme lexbuf)) +# 382 "ext/ext_json_parse.ml" + + | 14 -> +# 161 "ext/ext_json_parse.mll" + ( + let pos = Lexing.lexeme_start_p lexbuf in + scan_string buf pos lexbuf; + let content = (Buffer.contents buf) in + Buffer.clear buf ; + String content +) +# 393 "ext/ext_json_parse.ml" + + | 15 -> +# 168 "ext/ext_json_parse.mll" + (Eof ) +# 398 "ext/ext_json_parse.ml" + + | 16 -> +let +# 169 "ext/ext_json_parse.mll" + c +# 404 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in +# 169 "ext/ext_json_parse.mll" + ( error lexbuf (Illegal_character c )) +# 408 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state + +and comment buf lexbuf = + __ocaml_lex_comment_rec buf lexbuf 40 +and __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 171 "ext/ext_json_parse.mll" + (lex_json buf lexbuf) +# 420 "ext/ext_json_parse.ml" + + | 1 -> +# 172 "ext/ext_json_parse.mll" + (comment buf lexbuf) +# 425 "ext/ext_json_parse.ml" + + | 2 -> +# 173 "ext/ext_json_parse.mll" + (error lexbuf Unterminated_comment) +# 430 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state + +and scan_string buf start lexbuf = + __ocaml_lex_scan_string_rec buf start lexbuf 45 +and __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with + | 0 -> +# 177 "ext/ext_json_parse.mll" + ( () ) +# 442 "ext/ext_json_parse.ml" + + | 1 -> +# 179 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 2 in + update_loc lexbuf len; + + scan_string buf start lexbuf + ) +# 452 "ext/ext_json_parse.ml" + + | 2 -> +# 186 "ext/ext_json_parse.mll" + ( + let len = lexeme_len lexbuf - 3 in + update_loc lexbuf len; + scan_string buf start lexbuf + ) +# 461 "ext/ext_json_parse.ml" + + | 3 -> +let +# 191 "ext/ext_json_parse.mll" + c +# 467 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 192 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf (char_for_backslash c); + scan_string buf start lexbuf + ) +# 474 "ext/ext_json_parse.ml" + + | 4 -> +let +# 196 "ext/ext_json_parse.mll" + c1 +# 480 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) +and +# 196 "ext/ext_json_parse.mll" + c2 +# 485 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 196 "ext/ext_json_parse.mll" + c3 +# 490 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) +and +# 196 "ext/ext_json_parse.mll" + s +# 495 "ext/ext_json_parse.ml" += Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_start_pos + 4) in +# 197 "ext/ext_json_parse.mll" + ( + let v = dec_code c1 c2 c3 in + if v > 255 then + error lexbuf (Illegal_escape s) ; + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 506 "ext/ext_json_parse.ml" + + | 5 -> +let +# 205 "ext/ext_json_parse.mll" + c1 +# 512 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) +and +# 205 "ext/ext_json_parse.mll" + c2 +# 517 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) in +# 206 "ext/ext_json_parse.mll" + ( + let v = hex_code c1 c2 in + Buffer.add_char buf (Char.chr v); + + scan_string buf start lexbuf + ) +# 526 "ext/ext_json_parse.ml" + + | 6 -> +let +# 212 "ext/ext_json_parse.mll" + c +# 532 "ext/ext_json_parse.ml" += Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in +# 213 "ext/ext_json_parse.mll" + ( + Buffer.add_char buf '\\'; + Buffer.add_char buf c; + + scan_string buf start lexbuf + ) +# 541 "ext/ext_json_parse.ml" + + | 7 -> +# 220 "ext/ext_json_parse.mll" + ( + update_loc lexbuf 0; + Buffer.add_char buf lf; + + scan_string buf start lexbuf + ) +# 551 "ext/ext_json_parse.ml" + + | 8 -> +# 227 "ext/ext_json_parse.mll" + ( + let ofs = lexbuf.lex_start_pos in + let len = lexbuf.lex_curr_pos - ofs in + Buffer.add_subbytes buf lexbuf.lex_buffer ofs len; + + scan_string buf start lexbuf + ) +# 562 "ext/ext_json_parse.ml" + + | 9 -> +# 235 "ext/ext_json_parse.mll" + ( + error lexbuf Unterminated_string + ) +# 569 "ext/ext_json_parse.ml" + + | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state + +;; + +# 239 "ext/ext_json_parse.mll" + + + + + + + +let rec parse_json lexbuf = + let buf = Buffer.create 64 in + let look_ahead = ref None in + let token () : token = + match !look_ahead with + | None -> + lex_json buf lexbuf + | Some x -> + look_ahead := None ; + x + in + let push e = look_ahead := Some e in + let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = + match token () with + | True -> True lexbuf.lex_start_p + | False -> False lexbuf.lex_start_p + | Null -> Null lexbuf.lex_start_p + | Number s -> Flo {flo = s; loc = lexbuf.lex_start_p} + | String s -> Str { str = s; loc = lexbuf.lex_start_p} + | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf + | Lbrace -> parse_map lexbuf.lex_start_p String_map.empty lexbuf + | _ -> error lexbuf Unexpected_token +(** Note if we remove [trailing_comma] support + we should report errors (actually more work), for example + {[ + match token () with + | Rbracket -> + if trailing_comma then + error lexbuf Trailing_comma_in_array + else + ]} + {[ + match token () with + | Rbrace -> + if trailing_comma then + error lexbuf Trailing_comma_in_obj + else + + ]} + *) + and parse_array loc_start loc_finish acc lexbuf + : Ext_json_types.t = + match token () with + | Rbracket -> + Arr {loc_start ; content = Ext_array.reverse_of_list acc ; + loc_end = lexbuf.lex_curr_p } + | x -> + push x ; + let new_one = json lexbuf in + begin match token () with + | Comma -> + parse_array loc_start loc_finish (new_one :: acc) lexbuf + | Rbracket + -> Arr {content = (Ext_array.reverse_of_list (new_one::acc)); + loc_start ; + loc_end = lexbuf.lex_curr_p } + | _ -> + error lexbuf Expect_comma_or_rbracket + end + and parse_map loc_start acc lexbuf : Ext_json_types.t = + match token () with + | Rbrace -> + Obj { map = acc ; loc = loc_start} + | String key -> + begin match token () with + | Colon -> + let value = json lexbuf in + begin match token () with + | Rbrace -> Obj {map = String_map.add acc key value ; loc = loc_start} + | Comma -> + parse_map loc_start (String_map.add acc key value ) lexbuf + | _ -> error lexbuf Expect_comma_or_rbrace + end + | _ -> error lexbuf Expect_colon + end + | _ -> error lexbuf Expect_string_or_rbrace + in + let v = json lexbuf in + match token () with + | Eof -> v + | _ -> error lexbuf Expect_eof + +let parse_json_from_string s = + parse_json (Lexing.from_string s ) + +let parse_json_from_chan fname in_chan = + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan fname in + parse_json lexbuf + +let parse_json_from_file s = + let in_chan = open_in s in + let lexbuf = + Ext_position.lexbuf_from_channel_with_fname + in_chan s in + match parse_json lexbuf with + | exception e -> close_in in_chan ; raise e + | v -> close_in in_chan; v + + + + + +# 688 "ext/ext_json_parse.ml" + +end +module External_arg_spec : sig +#1 "external_arg_spec.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. *) + +type cst = private + | Arg_int_lit of int + | Arg_string_lit of string + | Arg_js_null + | Arg_js_true + | Arg_js_false + | Arg_js_json of string + + +type label = private + | Label of string * cst option + | Empty of cst option + | Optional of string + (* it will be ignored , side effect will be recorded *) + +type attr = + | NullString of (int * string) list (* `a does not have any value*) + | NonNullString of (int * string) list (* `a of int *) + | Int of (int * int ) list (* ([`a | `b ] [@bs.int])*) + | Arg_cst of cst + | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*) + (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *) + | Array + | Extern_unit + | Nothing + | Ignore + | Unwrap + +type t = + { + arg_type : attr; + arg_label :label + } + +val cst_json : Location.t -> string -> cst +val cst_int : int -> cst +val cst_string : string -> cst + +val empty_label : label +val empty_lit : cst -> label +val label : string -> cst option -> label +val optional : string -> label +val empty_kind : attr -> t + +end = struct +#1 "external_arg_spec.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. *) + +(** type definitions for external argument *) + +type cst = + | Arg_int_lit of int + | Arg_string_lit of string + + | Arg_js_null + | Arg_js_true + | Arg_js_false + | Arg_js_json of string +type label = + | Label of string * cst option + | Empty of cst option + | Optional of string + (* it will be ignored , side effect will be recorded *) + +type attr = + | NullString of (int * string) list (* `a does not have any value*) + | NonNullString of (int * string) list (* `a of int *) + | Int of (int * int ) list (* ([`a | `b ] [@bs.int])*) + | Arg_cst of cst + | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*) + (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *) + | Array + | Extern_unit + | Nothing + | Ignore + | Unwrap + +type t = + { + arg_type : attr; + arg_label : label + } + + +exception Error of Location.t * Ext_json_parse.error + +let pp_invaild_json fmt err = + Format.fprintf fmt "@[Invalid json literal: %a@]@." + Ext_json_parse.report_error err + +let () = + Location.register_error_of_exn (function + | Error (loc,err) -> + Some (Location.error_of_printer loc pp_invaild_json err) + | _ -> None + ) + + +let cst_json (loc : Location.t) s : cst = + match Ext_json_parse.parse_json_from_string s with + | True _ -> Arg_js_true + | False _ -> Arg_js_false + | Null _ -> Arg_js_null + | _ -> Arg_js_json s + | exception Ext_json_parse.Error (start,finish,error_info) + -> + let loc1 = { + loc with + loc_start = + Ext_position.offset loc.loc_start start; + loc_end = + Ext_position.offset loc.loc_start finish; + } in + raise (Error (loc1 , error_info)) + +let cst_int i = Arg_int_lit i +let cst_string s = Arg_string_lit s +let empty_label = Empty None +let empty_lit s = Empty (Some s) +let label s cst = Label(s,cst) +let optional s = Optional s + +let empty_kind arg_type = { arg_label = empty_label ; arg_type } + +end +module Ast_polyvar : sig +#1 "ast_polyvar.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +(** side effect: it will mark used attributes `bs.as` *) +val map_row_fields_into_ints: + Location.t -> + Parsetree.row_field list -> + (int * int ) list + +val map_constructor_declarations_into_ints: + Parsetree.constructor_declaration list -> + [ `Offset of int | `New of int list ] + +val map_row_fields_into_strings: + Location.t -> + Parsetree.row_field list -> + External_arg_spec.attr + + +val is_enum : + Parsetree.row_field list -> + bool + +val is_enum_polyvar : + Parsetree.type_declaration -> + Parsetree.row_field list option + +val is_enum_constructors : + Parsetree.constructor_declaration list -> + bool +end = struct +#1 "ast_polyvar.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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 map_row_fields_into_ints ptyp_loc + (row_fields : Parsetree.row_field list) + = + let _, acc = + Ext_list.fold_left row_fields (0, []) + (fun (i,acc) rtag -> + match rtag with + | Rtag (label, attrs, true, []) + -> + begin match Ast_attributes.iter_process_bs_int_as attrs with + | Some i -> + i + 1, + ((Ast_compatible.hash_label label , i):: acc ) + | None -> + i + 1 , + ((Ast_compatible.hash_label label , i):: acc ) + end + | _ -> + Bs_syntaxerr.err ptyp_loc Invalid_bs_int_type + ) in + List.rev acc + +(** Note this is okay with enums, for variants, + the underlying representation may change due to + unbox +*) +let map_constructor_declarations_into_ints + (row_fields : Parsetree.constructor_declaration list) + = + let mark = ref `nothing in + let _, acc + = + Ext_list.fold_left row_fields (0, []) + (fun (i,acc) rtag -> + let attrs = rtag.pcd_attributes in + match Ast_attributes.iter_process_bs_int_as attrs with + | Some j -> + if j <> i then + ( + if i = 0 then mark := `offset j + else mark := `complex + ) + ; + (j + 1, + (j:: acc ) ) + | None -> + i + 1 , + ( i:: acc ) + ) in + match !mark with + | `nothing -> `Offset 0 + | `offset j -> `Offset j + | `complex -> `New (List.rev acc) + + + +(** It also check in-consistency of cases like + {[ [`a | `c of int ] ]} +*) +let map_row_fields_into_strings ptyp_loc + (row_fields : Parsetree.row_field list) : External_arg_spec.attr = + let case, result = + Ext_list.fold_right row_fields (`Nothing, []) (fun tag (nullary, acc) -> + match nullary, tag with + | (`Nothing | `Null), + Rtag (label, attrs, true, []) + -> + begin match Ast_attributes.iter_process_bs_string_as attrs with + | Some name -> + `Null, ((Ast_compatible.hash_label label, name) :: acc ) + + | None -> + `Null, ((Ast_compatible.hash_label label, Ast_compatible.label_of_name label) :: acc ) + end + | (`Nothing | `NonNull), Rtag(label, attrs, false, ([ _ ])) + -> + begin match Ast_attributes.iter_process_bs_string_as attrs with + | Some name -> + `NonNull, ((Ast_compatible.hash_label label, name) :: acc) + | None -> + `NonNull, ((Ast_compatible.hash_label label, Ast_compatible.label_of_name label) :: acc) + end + | _ -> Bs_syntaxerr.err ptyp_loc Invalid_bs_string_type + + ) in + match case with + | `Nothing -> Bs_syntaxerr.err ptyp_loc Invalid_bs_string_type + | `Null -> External_arg_spec.NullString result + | `NonNull -> NonNullString result + + +let is_enum row_fields = + List.for_all (fun (x : Parsetree.row_field) -> + match x with + | Rtag(_label,_attrs,true, []) -> true + | _ -> false + ) row_fields + + +let is_enum_polyvar (ty : Parsetree.type_declaration) = + match ty.ptype_manifest with + | Some {ptyp_desc = Ptyp_variant(row_fields,Closed,None)} + when is_enum row_fields -> + Some row_fields + | _ -> None + +let is_enum_constructors + (constructors : Parsetree.constructor_declaration list) = + List.for_all + (fun (x : Parsetree.constructor_declaration) -> + match x with + | {pcd_args = + + Pcstr_tuple [] (* Note the enum is encoded using [Pcstr_tuple []]*) + + } -> true + | _ -> false + ) + constructors +end +module Ext_sys : sig +#1 "ext_sys.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. *) + + +(* Not used yet *) +(* val is_directory_no_exn : string -> bool *) + + +val is_windows_or_cygwin : bool + +val getenv_opt : + string -> + string option +end = struct +#1 "ext_sys.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. *) + +(** TODO: not exported yet, wait for Windows Fix*) +let is_directory_no_exn f = + try Sys.is_directory f with _ -> false + + +let is_windows_or_cygwin = Sys.win32 || Sys.cygwin + + +let getenv_opt = Sys.getenv_opt + +end +module Ext_path : sig +#1 "ext_path.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t + + + + + +(** + [combine path1 path2] + 1. add some simplifications when concatenating + 2. when [path2] is absolute, return [path2] +*) +val combine : + string -> + string -> + string + + + +val chop_extension : ?loc:string -> string -> string + + +val chop_extension_if_any : string -> string + +val chop_all_extensions_if_any : + string -> string + +(** + {[ + get_extension "a.txt" = ".txt" + get_extension "a" = "" + ]} +*) +val get_extension : string -> string + + + + +val node_rebase_file : + from:string -> + to_:string -> + string -> + string + +(** + TODO: could be highly optimized + if [from] and [to] resolve to the same path, a zero-length string is returned + Given that two paths are directory + + A typical use case is + {[ + Filename.concat + (rel_normalized_absolute_path cwd (Filename.dirname a)) + (Filename.basename a) + ]} +*) +val rel_normalized_absolute_path : from:string -> string -> string + + +val normalize_absolute_path : string -> string + +val absolute_path : string Lazy.t -> string -> string + +(** [concat dirname filename] + The same as {!Filename.concat} except a tiny optimization + for current directory simplification +*) +val concat : string -> string -> string + +val check_suffix_case : + string -> string -> bool +end = struct +#1 "ext_path.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +type t = + | File of string + | Dir of string + + + + + + +let split_by_sep_per_os : string -> string list = + if Ext_sys.is_windows_or_cygwin then + fun x -> + (* on Windows, we can still accept -bs-package-output lib/js *) + Ext_string.split_by + (fun x -> match x with |'/' |'\\' -> true | _ -> false) x + else + fun x -> Ext_string.split x '/' + +(** example + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + ]} + + The other way + {[ + + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/ocaml_array.ml" + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib/external/pervasives.cmj" + ]} + {[ + "/bb/mbigc/mbig2899/bgit/bucklescript/jscomp/stdlib//ocaml_array.ml" + ]} + {[ + /a/b + /c/d + ]} +*) +let node_relative_path + ~from:(file_or_dir_2 : t ) + (file_or_dir_1 : t) + = + let relevant_dir1 = + match file_or_dir_1 with + | Dir x -> x + | File file1 -> Filename.dirname file1 in + let relevant_dir2 = + match file_or_dir_2 with + | Dir x -> x + | File file2 -> Filename.dirname file2 in + let dir1 = split_by_sep_per_os relevant_dir1 in + let dir2 = split_by_sep_per_os relevant_dir2 in + let rec go (dir1 : string list) (dir2 : string list) = + match dir1, dir2 with + | "." :: xs, ys -> go xs ys + | xs , "." :: ys -> go xs ys + | x::xs , y :: ys when x = y + -> go xs ys + | _, _ -> + Ext_list.map_append dir2 dir1 (fun _ -> Literals.node_parent) + in + match go dir1 dir2 with + | (x :: _ ) as ys when x = Literals.node_parent -> + String.concat Literals.node_sep ys + | ys -> + String.concat Literals.node_sep + @@ Literals.node_current :: ys + + +let node_concat ~dir base = + dir ^ Literals.node_sep ^ base + +let node_rebase_file ~from ~to_ file = + + node_concat + ~dir:( + if from = to_ then Literals.node_current + else node_relative_path ~from:(Dir from) (Dir to_)) + file + + +(*** + {[ + Filename.concat "." "";; + "./" + ]} +*) +let combine path1 path2 = + if Filename.is_relative path2 then + if Ext_string.is_empty path2 then + path1 + else + if path1 = Filename.current_dir_name then + path2 + else + if path2 = Filename.current_dir_name + then path1 + else + Filename.concat path1 path2 + else + path2 + + +let chop_extension ?(loc="") name = + try Filename.chop_extension name + with Invalid_argument _ -> + Ext_pervasives.invalid_argf + "Filename.chop_extension ( %s : %s )" loc name + +let chop_extension_if_any fname = + try Filename.chop_extension fname with Invalid_argument _ -> fname + +let rec chop_all_extensions_if_any fname = + match Filename.chop_extension fname with + | x -> chop_all_extensions_if_any x + | exception _ -> fname + +let get_extension x = + let pos = Ext_string.rindex_neg x '.' in + if pos < 0 then "" + else Ext_string.tail_from x pos + + +let (//) x y = + if x = Filename.current_dir_name then y + else if y = Filename.current_dir_name then x + else Filename.concat x y + +(** + {[ + split_aux "//ghosg//ghsogh/";; + - : string * string list = ("/", ["ghosg"; "ghsogh"]) + ]} + Note that + {[ + Filename.dirname "/a/" = "/" + Filename.dirname "/a/b/" = Filename.dirname "/a/b" = "/a" + ]} + Special case: + {[ + basename "//" = "/" + basename "///" = "/" + ]} + {[ + basename "" = "." + basename "" = "." + dirname "" = "." + dirname "" = "." + ]} +*) +let split_aux p = + let rec go p acc = + let dir = Filename.dirname p in + if dir = p then dir, acc + else + let new_path = Filename.basename p in + if Ext_string.equal new_path Filename.dir_sep then + go dir acc + (* We could do more path simplification here + leave to [rel_normalized_absolute_path] + *) + else + go dir (new_path :: acc) + + in go p [] + + + + + +(** + TODO: optimization + if [from] and [to] resolve to the same path, a zero-length string is returned + + This function is useed in [es6-global] and + [amdjs-global] format and tailored for `rollup` +*) +let rel_normalized_absolute_path ~from to_ = + let root1, paths1 = split_aux from in + let root2, paths2 = split_aux to_ in + if root1 <> root2 then root2 + else + let rec go xss yss = + match xss, yss with + | x::xs, y::ys -> + if Ext_string.equal x y then go xs ys + else if x = Filename.current_dir_name then go xs yss + else if y = Filename.current_dir_name then go xss ys + else + let start = + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + Ext_list.fold_left yss start (fun acc v -> acc // v) + | [], [] -> Ext_string.empty + | [], y::ys -> Ext_list.fold_left ys y (fun acc x -> acc // x) + | x::xs, [] -> + Ext_list.fold_left xs Ext_string.parent_dir_lit (fun acc _ -> acc // Ext_string.parent_dir_lit ) + in + let v = go paths1 paths2 in + + if Ext_string.is_empty v then Literals.node_current + else + if + v = "." + || v = ".." + || Ext_string.starts_with v "./" + || Ext_string.starts_with v "../" + then v + else "./" ^ v + +(*TODO: could be hgighly optimized later + {[ + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/a/b/../c../d/e/f";; + + normalize_absolute_path "/gsho/./..";; + + normalize_absolute_path "/gsho/./../..";; + + normalize_absolute_path "/a/b/c/d";; + + normalize_absolute_path "/a/b/c/d/";; + + normalize_absolute_path "/a/";; + + normalize_absolute_path "/a";; + ]} +*) +(** See tests in {!Ounit_path_tests} *) +let normalize_absolute_path x = + let drop_if_exist xs = + match xs with + | [] -> [] + | _ :: xs -> xs in + let rec normalize_list acc paths = + match paths with + | [] -> acc + | x :: xs -> + if Ext_string.equal x Ext_string.current_dir_lit then + normalize_list acc xs + else if Ext_string.equal x Ext_string.parent_dir_lit then + normalize_list (drop_if_exist acc ) xs + else + normalize_list (x::acc) xs + in + let root, paths = split_aux x in + let rev_paths = normalize_list [] paths in + let rec go acc rev_paths = + match rev_paths with + | [] -> Filename.concat root acc + | last::rest -> go (Filename.concat last acc ) rest in + match rev_paths with + | [] -> root + | last :: rest -> go last rest + + + + +let absolute_path cwd s = + let process s = + let s = + if Filename.is_relative s then + Lazy.force cwd // s + else s in + (* Now simplify . and .. components *) + let rec aux s = + let base,dir = Filename.basename s, Filename.dirname s in + if dir = s then dir + else if base = Filename.current_dir_name then aux dir + else if base = Filename.parent_dir_name then Filename.dirname (aux dir) + else aux dir // base + in aux s in + process s + + +let absolute cwd s = + match s with + | File x -> File (absolute_path cwd x ) + | Dir x -> Dir (absolute_path cwd x) + +let concat dirname filename = + if filename = Filename.current_dir_name then dirname + else if dirname = Filename.current_dir_name then filename + else Filename.concat dirname filename + + +let check_suffix_case = + Ext_string.ends_with +end +module Bs_version : sig +#1 "bs_version.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 version : string + +val header : string + +val package_name : string +end = struct +#1 "bs_version.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 version = "5.0.1" +let header = + "// Generated by BUCKLESCRIPT VERSION 5.0.1, PLEASE EDIT WITH CARE" +let package_name = "bs-platform" + +end +module Ext_option : sig +#1 "ext_option.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. *) + + + + + + + + +(** Utilities for [option] type *) + +val map : 'a option -> ('a -> 'b) -> 'b option + +val iter : 'a option -> ('a -> unit) -> unit + +val exists : 'a option -> ('a -> bool) -> bool +end = struct +#1 "ext_option.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 map v f = + match v with + | None -> None + | Some x -> Some (f x ) + +let iter v f = + match v with + | None -> () + | Some x -> f x + +let exists v f = + match v with + | None -> false + | Some x -> f x +end +module External_ffi_types : sig +#1 "external_ffi_types.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. *) + +type module_bind_name = + | Phint_name of string + (* explicit hint name *) + | Phint_nothing + +type external_module_name = + { bundle : string ; + module_bind_name : module_bind_name + } + +type pipe = bool +type js_call = { + name : string; + external_module_name : external_module_name option; + splice : bool ; + scopes : string list +} + +type js_send = { + name : string ; + splice : bool ; + pipe : pipe ; + js_send_scopes : string list; +} (* we know it is a js send, but what will happen if you pass an ocaml objct *) + +type js_global_val = { + name : string ; + external_module_name : external_module_name option; + scopes : string list +} + +type js_new_val = { + name : string ; + external_module_name : external_module_name option; + scopes : string list; +} + +type js_module_as_fn = + { external_module_name : external_module_name; + splice : bool + } + +type arg_type = External_arg_spec.attr + +type arg_label = External_arg_spec.label + + +type obj_create = External_arg_spec.t list + +type js_get = + { js_get_name : string ; + js_get_scopes : string list; + } + +type js_set = + { js_set_name : string ; + js_set_scopes : string list + } + + +type js_get_index = { + js_get_index_scopes : string list +} + +type js_set_index = { + js_set_index_scopes : string list +} + + + +type external_spec = + | Js_global of js_global_val + | Js_module_as_var of external_module_name + | Js_module_as_fn of js_module_as_fn + | Js_module_as_class of external_module_name + | Js_call of js_call + | Js_send of js_send + | Js_new of js_new_val + | Js_set of js_set + | Js_get of js_get + | Js_get_index of js_get_index + | Js_set_index of js_set_index + +type return_wrapper = + | Return_unset + | Return_identity + | Return_undefined_to_opt + | Return_null_to_opt + | Return_null_undefined_to_opt + | Return_replaced_with_unit + +type t = + | Ffi_bs of + External_arg_spec.t list * + return_wrapper * + external_spec + | Ffi_obj_create of obj_create + | Ffi_normal + (* When it's normal, it is handled as normal c functional ffi call *) + + +val name_of_ffi : external_spec -> string + +val check_ffi : ?loc:Location.t -> external_spec -> bool + +val to_string : t -> string + +(** Note *) +val from_string : string -> t + + +end = struct +#1 "external_ffi_types.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. *) + +type module_bind_name = + | Phint_name of string + (* explicit hint name *) + + | Phint_nothing + + +type external_module_name = + { bundle : string ; + module_bind_name : module_bind_name + } + +type pipe = bool +type js_call = { + name : string; + external_module_name : external_module_name option; + splice : bool ; + scopes : string list ; +} + +type js_send = { + name : string ; + splice : bool ; + pipe : pipe ; + js_send_scopes : string list; +} (* we know it is a js send, but what will happen if you pass an ocaml objct *) + +type js_global_val = { + name : string ; + external_module_name : external_module_name option; + scopes : string list ; +} + +type js_new_val = { + name : string ; + external_module_name : external_module_name option; + scopes : string list; +} + +type js_module_as_fn = + { external_module_name : external_module_name; + splice : bool ; + } +type js_get = + { js_get_name : string ; + js_get_scopes : string list; + } + +type js_set = + { js_set_name : string ; + js_set_scopes : string list + } + +type js_get_index = { + js_get_index_scopes : string list +} + +type js_set_index = { + js_set_index_scopes : string list +} +(** TODO: information between [arg_type] and [arg_label] are duplicated, + design a more compact representation so that it is also easy to seralize by hand +*) +type arg_type = External_arg_spec.attr + +type arg_label = External_arg_spec.label + + +(**TODO: maybe we can merge [arg_label] and [arg_type] *) +type obj_create = External_arg_spec.t list + +type external_spec = + | Js_global of js_global_val + | Js_module_as_var of external_module_name + | Js_module_as_fn of js_module_as_fn + | Js_module_as_class of external_module_name + | Js_call of js_call + | Js_send of js_send + | Js_new of js_new_val + | Js_set of js_set + | Js_get of js_get + | Js_get_index of js_get_index + | Js_set_index of js_set_index + +(* let not_inlineable (x : external_spec) = *) + + +let name_of_ffi ffi = + match ffi with + | Js_get_index _scope -> "[@@bs.get_index ..]" + | Js_set_index _scope -> "[@@bs.set_index ..]" + | Js_get { js_get_name = s} -> Printf.sprintf "[@@bs.get %S]" s + | Js_set { js_set_name = s} -> Printf.sprintf "[@@bs.set %S]" s + | Js_call v -> Printf.sprintf "[@@bs.val %S]" v.name + | Js_send v -> Printf.sprintf "[@@bs.send %S]" v.name + | Js_module_as_fn v -> Printf.sprintf "[@@bs.val %S]" v.external_module_name.bundle + | Js_new v -> Printf.sprintf "[@@bs.new %S]" v.name + | Js_module_as_class v + -> Printf.sprintf "[@@bs.module] %S " v.bundle + | Js_module_as_var v + -> + Printf.sprintf "[@@bs.module] %S " v.bundle + | Js_global v + -> + Printf.sprintf "[@@bs.val] %S " v.name + +type return_wrapper = + | Return_unset + | Return_identity + | Return_undefined_to_opt + | Return_null_to_opt + | Return_null_undefined_to_opt + | Return_replaced_with_unit +type t = + | Ffi_bs of External_arg_spec.t list * + return_wrapper * external_spec + (** [Ffi_bs(args,return,attr) ] + [return] means return value is unit or not, + [true] means is [unit] + *) + | Ffi_obj_create of obj_create + | Ffi_normal + (* When it's normal, it is handled as normal c functional ffi call *) + + + +let valid_js_char = + let a = Array.init 256 (fun i -> + let c = Char.chr i in + (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' || c = '$' + ) in + (fun c -> Array.unsafe_get a (Char.code c)) + +let valid_first_js_char = + let a = Array.init 256 (fun i -> + let c = Char.chr i in + (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$' + ) in + (fun c -> Array.unsafe_get a (Char.code c)) + +(** Approximation could be improved *) +let valid_ident (s : string) = + let len = String.length s in + len > 0 && valid_js_char s.[0] && valid_first_js_char s.[0] && + (let module E = struct exception E end in + try + for i = 1 to len - 1 do + if not (valid_js_char (String.unsafe_get s i)) then + raise E.E + done ; + true + with E.E -> false ) + +let is_package_relative_path (x : string) = + Ext_string.starts_with x "./" || + Ext_string.starts_with x "../" + +let valid_global_name ?loc txt = + if not (valid_ident txt) then + let v = Ext_string.split_by ~keep_empty:true (fun x -> x = '.') txt in + Ext_list.iter v + (fun s -> + if not (valid_ident s) then + Location.raise_errorf ?loc "Not a valid global name %s" txt + ) + +(* + We loose such check (see #2583), + it also helps with the implementation deriving abstract [@bs.as] +*) + +let valid_method_name ?loc txt = + () + (* if not (valid_ident txt) then + Location.raise_errorf ?loc "Not a valid method name %s" txt *) + + + +let check_external_module_name ?loc x = + match x with + | {bundle = ""; _ } + | { module_bind_name = Phint_name "" } -> + Location.raise_errorf ?loc "empty name encountered" + | _ -> () +let check_external_module_name_opt ?loc x = + match x with + | None -> () + | Some v -> check_external_module_name ?loc v + + +let check_ffi ?loc ffi : bool = + let relative = ref false in + begin match ffi with + | Js_global {name} -> + relative := is_package_relative_path name; + valid_global_name ?loc name + | Js_send {name } + | Js_set {js_set_name = name} + | Js_get { js_get_name = name} + -> valid_method_name ?loc name + | Js_get_index _ (* TODO: check scopes *) + | Js_set_index _ + -> () + + | Js_module_as_var external_module_name + | Js_module_as_fn {external_module_name; splice = _} + | Js_module_as_class external_module_name + -> + relative := is_package_relative_path external_module_name.bundle ; + check_external_module_name external_module_name + | Js_new {external_module_name ; name} + | Js_call {external_module_name ; name ; splice = _; scopes = _ } + -> + Ext_option.iter external_module_name (fun external_module_name -> + relative := is_package_relative_path external_module_name.bundle); + check_external_module_name_opt ?loc external_module_name ; + valid_global_name ?loc name + end; + !relative + +let bs_prefix = "BS:" +let bs_prefix_length = String.length bs_prefix + + +(** TODO: Make sure each version is not prefix of each other + Solution: + 1. fixed length + 2. non-prefix approach +*) +let bs_external = bs_prefix ^ Bs_version.version + + +let bs_external_length = String.length bs_external + + +let to_string t = + bs_external ^ Marshal.to_string t [] + + +(* TODO: better error message when version mismatch *) +let from_string s : t = + let s_len = String.length s in + if s_len >= bs_prefix_length && + String.unsafe_get s 0 = 'B' && + String.unsafe_get s 1 = 'S' && + String.unsafe_get s 2 = ':' then + if Ext_string.starts_with s bs_external then + Marshal.from_string s bs_external_length + else + Ext_pervasives.failwithf + ~loc:__LOC__ + "Compiler version mismatch. The project might have been built with one version of BuckleScript, and then with another. Please wipe the artifacts and do a clean build." + else Ffi_normal + +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" + + (* not suporting nested if here..*) +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];; + +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + + +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; + + + +end +module String_hash_set : sig +#1 "string_hash_set.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 Hash_set_gen.S with type key = string + +end = struct +#1 "string_hash_set.ml" +# 1 "ext/hash_set.cppo.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. *) +# 31 "ext/hash_set.cppo.ml" +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 + + +# 64 "ext/hash_set.cppo.ml" +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 + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (key :: old_bucket); + 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 Lam_methname : sig +#1 "lam_methname.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 translate : ?loc:Location.t -> string -> string + +end = struct +#1 "lam_methname.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. *) + + +(** + {[ + _open -> open + _in -> in + _MAX_LENGTH -> MAX_LENGTH + _Capital -> Capital + + _open__ -> _open + open__ -> open + + _'x -> 'x + + _Capital__ -> _Capital + _MAX__ -> _MAX + __ -> __ + __x -> __x + ___ -> _ + ____ -> __ + _ -> _ (* error *) + + + ]} + First we scan '__' from end to start, + If found, discard it. + Otherwise, check if it is [_ + keyword] or followed by capital letter, + If so, discard [_]. + + Limitations: user can not have [_Capital__, _Capital__other] to + make it all compile to [Capital]. + Keyword is fine [open__, open__other]. + So we loose polymorphism over capital letter. + It is okay, otherwise, if [_Captial__] is interpreted as [Capital], then + there is no way to express [_Capital] +*) + +(* Copied from [ocaml/parsing/lexer.mll] *) +let key_words = String_hash_set.of_array [| + "and"; + "as"; + "assert"; + "begin"; + "class"; + "constraint"; + "do"; + "done"; + "downto"; + "else"; + "end"; + "exception"; + "external"; + "false"; + "for"; + "fun"; + "function"; + "functor"; + "if"; + "in"; + "include"; + "inherit"; + "initializer"; + "lazy"; + "let"; + "match"; + "method"; + "module"; + "mutable"; + "new"; + "nonrec"; + "object"; + "of"; + "open"; + "or"; +(* "parser", PARSER; *) + "private"; + "rec"; + "sig"; + "struct"; + "then"; + "to"; + "true"; + "try"; + "type"; + "val"; + "virtual"; + "when"; + "while"; + "with"; + + "mod"; + "land"; + "lor"; + "lxor"; + "lsl"; + "lsr"; + "asr"; +|] +let double_underscore = "__" + +(*https://caml.inria.fr/pub/docs/manual-ocaml/lex.html +{[ + + label-name ::= lowercase-ident +]} +*) +let valid_start_char x = + match x with + | '_' | 'a' .. 'z' -> true + | _ -> false +let translate ?loc name = + assert (not @@ Ext_string.is_empty name); + let i = Ext_string.rfind ~sub:double_underscore name in + if i < 0 then + let name_len = String.length name in + if name.[0] = '_' then begin + let try_key_word = (String.sub name 1 (name_len - 1)) in + if name_len > 1 && + (not (valid_start_char try_key_word.[0]) + || String_hash_set.mem key_words try_key_word) then + try_key_word + else + name + end + else name + else if i = 0 then name + else String.sub name 0 i + + +end +module Ast_external_process : sig +#1 "ast_external_process.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. *) + + + + type response = { + pval_type : Parsetree.core_type ; + pval_prim : string list ; + pval_attributes : Parsetree.attributes; + no_inline_cross_module : bool +} + +(** + [handle_attributes_as_string + loc pval_name.txt pval_type pval_attributes pval_prim] + [pval_name.txt] is the name of identifier + [pval_prim] is the name of string literal + + return value is of [pval_type, pval_prims, new_attrs] +*) +val handle_attributes_as_string : + Bs_loc.t -> + string -> + Ast_core_type.t -> + Ast_attributes.t -> + string -> + response + + + + +(** [pval_prim_of_labels labels] + return [pval_prims] for FFI, it is specialized for + external object which is used in + {[ [%obj { x = 2; y = 1} ] ]} +*) +val pval_prim_of_labels : string Asttypes.loc list -> string list + + +val pval_prim_of_option_labels : + (bool * string Asttypes.loc) list -> + bool -> + string list + +end = struct +#1 "ast_external_process.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. *) + + +[@@@ocaml.warning "+9"] +(* record pattern match complete checker*) + + +let variant_can_bs_unwrap_fields (row_fields : Parsetree.row_field list) : bool = + let validity = + Ext_list.fold_left row_fields `No_fields + begin fun st row -> + match st, row with + | (* we've seen no fields or only valid fields so far *) + (`No_fields | `Valid_fields), + (* and this field has one constructor arg that we can unwrap to *) + Rtag (label, attrs, false, ([ _ ])) + -> + `Valid_fields + | (* otherwise, this field or a previous field was invalid *) + _ -> + `Invalid_field + end + + in + match validity with + | `Valid_fields -> true + | `No_fields + | `Invalid_field -> false + +let spec_of_ptyp nolabel (ptyp : Parsetree.core_type) = + let ptyp_desc = ptyp.ptyp_desc in + match Ast_attributes.iter_process_bs_string_int_unwrap_uncurry ptyp.ptyp_attributes with + | `String -> + begin match ptyp_desc with + | Ptyp_variant ( row_fields, Closed, None) + -> + Ast_polyvar.map_row_fields_into_strings ptyp.ptyp_loc row_fields + | _ -> + Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_string_type + end + | `Ignore -> + Ignore + | `Int -> + begin match ptyp_desc with + | Ptyp_variant ( row_fields, Closed, None) -> + let int_lists = + Ast_polyvar.map_row_fields_into_ints ptyp.ptyp_loc row_fields in + Int int_lists + | _ -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_int_type + end + | `Unwrap -> + begin match ptyp_desc with + | Ptyp_variant (row_fields, Closed, _) + when variant_can_bs_unwrap_fields row_fields -> + Unwrap + | _ -> + Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_unwrap_type + end + | `Uncurry opt_arity -> + let real_arity = Ast_core_type.get_uncurry_arity ptyp in + (begin match opt_arity, real_arity with + | Some arity, `Not_function -> + Fn_uncurry_arity arity + | None, `Not_function -> + Bs_syntaxerr.err ptyp.ptyp_loc Canot_infer_arity_by_syntax + | None, `Arity arity -> + Fn_uncurry_arity arity + | Some arity, `Arity n -> + if n <> arity then + Bs_syntaxerr.err ptyp.ptyp_loc (Inconsistent_arity (arity,n)) + else Fn_uncurry_arity arity + end) + | `Nothing -> + begin match ptyp_desc with + | Ptyp_constr ({txt = Lident "unit"; _}, []) + -> if nolabel then Extern_unit else Nothing + | Ptyp_constr ({txt = Lident "array"; _}, [_]) + -> Array + | Ptyp_variant _ -> + Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type; + Nothing + | _ -> + Nothing + end +(* is_optional = false +*) +let refine_arg_type ~(nolabel:bool) + (ptyp : Ast_core_type.t) : Ast_core_type.t * External_arg_spec.attr = + if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*) + let ptyp_attrs = ptyp.ptyp_attributes in + let result = Ast_attributes.iter_process_bs_string_or_int_as ptyp_attrs in + (* when ppx start dropping attributes + we should warn, there is a trade off whether + we should warn dropped non bs attribute or not + *) + Bs_ast_invariant.warn_discarded_unused_attributes ptyp_attrs; + match result with + | None -> + Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external + | Some (`Int i) -> + Ast_literal.type_int ~loc:ptyp.ptyp_loc (), Arg_cst(External_arg_spec.cst_int i) + | Some (`Str i)-> + Ast_literal.type_string ~loc:ptyp.ptyp_loc (), Arg_cst (External_arg_spec.cst_string i) + | Some (`Json_str s) -> + Ast_literal.type_string ~loc:ptyp.ptyp_loc (), Arg_cst (External_arg_spec.cst_json ptyp.ptyp_loc s) + else (* ([`a|`b] [@bs.string]) *) + ptyp, spec_of_ptyp nolabel ptyp + +let get_basic_type_from_option_label (ptyp_arg : Ast_core_type.t) = + + ptyp_arg + + +(** Given the type of argument, process its [bs.] attribute and new type, + The new type is currently used to reconstruct the external type + and result type in [@@bs.obj] + They are not the same though, for example + {[ + external f : hi:([ `hi | `lo ] [@bs.string]) -> unit -> _ = "" [@@bs.obj] + ]} + The result type would be [ hi:string ] +*) +let get_opt_arg_type + ~(nolabel : bool) + (ptyp_arg : Ast_core_type.t) : + External_arg_spec.attr = + let ptyp = get_basic_type_from_option_label ptyp_arg in + (if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*) + (* extenral f : ?x:_ -> y:int -> _ = "" [@@bs.obj] is not allowed *) + Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external + else (* ([`a|`b] [@bs.string]) *) + spec_of_ptyp nolabel ptyp) + + + +(** + [@@bs.module "react"] + [@@bs.module "react"] + --- + [@@bs.module "@" "react"] + [@@bs.module "@" "react"] + + They should have the same module name + + TODO: we should emit an warning if we bind + two external files to the same module name +*) +type bundle_source = + [`Nm_payload of string (* from payload [@@bs.val "xx" ]*) + |`Nm_external of string (* from "" in external *) + | `Nm_val of string (* from function name *) + ] + +let string_of_bundle_source (x : bundle_source) = + match x with + | `Nm_payload x + | `Nm_external x + | `Nm_val x -> x +type name_source = + [ bundle_source + | `Nm_na + + ] + + + + +type st = + { val_name : name_source; + external_module_name : External_ffi_types.external_module_name option; + module_as_val : External_ffi_types.external_module_name option; + val_send : name_source ; + val_send_pipe : Ast_core_type.t option; + splice : bool ; (* mutable *) + scopes : string list ; + set_index : bool; (* mutable *) + get_index : bool; + new_name : name_source ; + call_name : name_source ; + set_name : name_source ; + get_name : name_source ; + + mk_obj : bool ; + return_wrapper : External_ffi_types.return_wrapper ; + + } + +let init_st = + { + val_name = `Nm_na; + external_module_name = None ; + module_as_val = None; + val_send = `Nm_na; + val_send_pipe = None; + splice = false; + scopes = []; + set_index = false; + get_index = false; + new_name = `Nm_na; + call_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + mk_obj = false ; + return_wrapper = Return_unset; + + } + + +let return_wrapper loc (txt : string) : External_ffi_types.return_wrapper = + match txt with + | "undefined_to_opt" -> Return_undefined_to_opt + | "null_to_opt" -> Return_null_to_opt + | "nullable" + | "null_undefined_to_opt" -> Return_null_undefined_to_opt + | "identity" -> Return_identity + | _ -> + Bs_syntaxerr.err loc Not_supported_directive_in_bs_return + + +(* The processed attributes will be dropped *) +let process_external_attributes + (no_arguments : bool) + (prim_name_or_pval_prim: bundle_source ) + (pval_prim : string) + (prim_attributes : Ast_attributes.t) : Ast_attributes.t * st = + + (* shared by `[@@bs.val]`, `[@@bs.send]`, + `[@@bs.set]`, `[@@bs.get]` , `[@@bs.new]` + `[@@bs.send.pipe]` does not use it + *) + let name_from_payload_or_prim ~loc (payload : Parsetree.payload) : name_source = + match payload with + | PStr [] -> + (prim_name_or_pval_prim :> name_source) + (* It is okay to have [@@bs.val] without payload *) + | _ -> + begin match Ast_payload.is_single_string payload with + | Some (val_name, _) -> `Nm_payload val_name + | None -> + Location.raise_errorf ~loc "Invalid payload" + end + + in + Ext_list.fold_left prim_attributes ([], init_st) + (fun (attrs, st) (({txt ; loc}, payload) as attr ) + -> + if txt = Literals.gentype_import then + let bundle = + "./" ^ Ext_path.chop_extension_if_any + (Filename.basename (Js_config.get_current_file ())) ^ ".gen" + in + attr::attrs, + {st with external_module_name = Some { bundle; module_bind_name = Phint_nothing}} + else if Ext_string.starts_with txt "bs." then + attrs, begin match txt with + | "bs.val" -> + if no_arguments then + {st with val_name = name_from_payload_or_prim ~loc payload} + else + {st with call_name = name_from_payload_or_prim ~loc payload} + + | "bs.module" -> + begin match Ast_payload.assert_strings loc payload with + | [bundle] -> + {st with external_module_name = + Some {bundle; module_bind_name = Phint_nothing}} + | [bundle;bind_name] -> + {st with external_module_name = + Some {bundle; module_bind_name = Phint_name bind_name}} + | [] -> + { st with + module_as_val = + Some + { bundle = + string_of_bundle_source + (prim_name_or_pval_prim :> bundle_source) ; + module_bind_name = Phint_nothing} + } + | _ -> + Bs_syntaxerr.err loc Illegal_attribute + end + | "bs.scope" -> + begin match Ast_payload.assert_strings loc payload with + | [] -> + Bs_syntaxerr.err loc Illegal_attribute + (* We need err on empty scope, so we can tell the difference + between unset/set + *) + | scopes -> { st with scopes = scopes } + end + | "bs.splice" | "bs.variadic" -> {st with splice = true} + | "bs.send" -> + { st with val_send = name_from_payload_or_prim ~loc payload} + | "bs.send.pipe" + -> + { st with val_send_pipe = Some (Ast_payload.as_core_type loc payload)} + | "bs.set" -> + {st with set_name = name_from_payload_or_prim ~loc payload} + | "bs.get" -> {st with get_name = name_from_payload_or_prim ~loc payload} + + | "bs.new" -> {st with new_name = name_from_payload_or_prim ~loc payload} + | "bs.set_index" -> {st with set_index = true} + | "bs.get_index"-> {st with get_index = true} + | "bs.obj" -> {st with mk_obj = true} + | "bs.return" -> + let actions = + Ast_payload.ident_or_record_as_config loc payload in + begin match actions with + | [ ({txt; _ },None) ] -> + { st with return_wrapper = return_wrapper loc txt} + | _ -> + Bs_syntaxerr.err loc Not_supported_directive_in_bs_return + end + | _ -> (Location.prerr_warning loc (Bs_unused_attribute txt); st) + end + else attr :: attrs, st + ) + + + +let rec has_bs_uncurry (attrs : Ast_attributes.t) = + match attrs with + | ({txt = "bs.uncurry"; _ }, _) :: attrs -> + true + | _ :: attrs -> has_bs_uncurry attrs + | [] -> false + + +let check_return_wrapper + loc (wrapper : External_ffi_types.return_wrapper) + result_type = + match wrapper with + | Return_identity -> wrapper + | Return_unset -> + if Ast_core_type.is_unit result_type then + Return_replaced_with_unit + else + wrapper + | Return_undefined_to_opt + | Return_null_to_opt + | Return_null_undefined_to_opt + -> + if Ast_core_type.is_user_option result_type then + wrapper + else + Bs_syntaxerr.err loc Expect_opt_in_bs_return_to_opt + | Return_replaced_with_unit -> + assert false (* Not going to happen from user input*) + + + +type response = { + pval_type : Parsetree.core_type ; + pval_prim : string list ; + pval_attributes : Parsetree.attributes; + no_inline_cross_module : bool +} + +(** Note that the passed [type_annotation] is already processed by visitor pattern before*) +let handle_attributes + (loc : Bs_loc.t) + (pval_prim : string ) + (type_annotation : Parsetree.core_type) + (prim_attributes : Ast_attributes.t) (prim_name : string) + = + (** sanity check here + {[ int -> int -> (int -> int -> int [@bs.uncurry])]} + It does not make sense + *) + if has_bs_uncurry type_annotation.ptyp_attributes then + Location.raise_errorf + ~loc "[@@bs.uncurry] can not be applied to the whole definition" + ; + + let prim_name_or_pval_prim = + if String.length prim_name = 0 then `Nm_val pval_prim + else `Nm_external prim_name (* need check name *) + in + let result_type, arg_types_ty = + (* Note this assumes external type is syntatic (no abstraction)*) + Ast_core_type.list_of_arrow type_annotation in + if has_bs_uncurry result_type.ptyp_attributes then + begin + Location.raise_errorf + ~loc:result_type.ptyp_loc + "[@@bs.uncurry] can not be applied to tailed position" + end ; + let left_attrs, st = + process_external_attributes + (arg_types_ty = []) + prim_name_or_pval_prim pval_prim prim_attributes in + + + if st.mk_obj then + begin match st with + | { + val_name = `Nm_na; + external_module_name = None ; + module_as_val = None; + val_send = `Nm_na; + val_send_pipe = None; + splice = false; + new_name = `Nm_na; + call_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + get_index = false ; + return_wrapper = Return_unset ; + set_index = false ; + mk_obj = _; + scopes = []; + (* wrapper does not work with [bs.obj] + TODO: better error message *) + } -> + if String.length prim_name <> 0 then + Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string"; + let arg_kinds, new_arg_types_ty, result_types = + Ext_list.fold_right arg_types_ty ( [], [], []) + (fun (label,ty,attr,loc) ( arg_labels, arg_types, result_types) -> + let arg_label = Ast_compatible.convert label in + let new_arg_label, new_arg_types, output_tys = + match arg_label with + | Nolabel -> + let new_ty, arg_type = refine_arg_type ~nolabel:true ty in + if arg_type = Extern_unit then + External_arg_spec.empty_kind arg_type, (label,new_ty,attr,loc)::arg_types, result_types + else + Location.raise_errorf ~loc "expect label, optional, or unit here" + | Labelled name -> + let new_ty, arg_type = refine_arg_type ~nolabel:false ty in + begin match arg_type with + | Ignore -> + External_arg_spec.empty_kind arg_type, + (label,new_ty,attr,loc)::arg_types, result_types + | Arg_cst i -> + let s = Lam_methname.translate ~loc name in + {arg_label = External_arg_spec.label s (Some i); + arg_type }, + arg_types, (* ignored in [arg_types], reserved in [result_types] *) + ((name , [], new_ty) :: result_types) + | Nothing | Array -> + let s = (Lam_methname.translate ~loc name) in + {arg_label = External_arg_spec.label s None ; arg_type }, + (label,new_ty,attr,loc)::arg_types, + ((name , [], new_ty) :: result_types) + | Int _ -> + let s = Lam_methname.translate ~loc name in + {arg_label = External_arg_spec.label s None; arg_type}, + (label,new_ty,attr,loc)::arg_types, + ((name, [], Ast_literal.type_int ~loc ()) :: result_types) + | NullString _ -> + let s = Lam_methname.translate ~loc name in + {arg_label = External_arg_spec.label s None; arg_type}, + (label,new_ty,attr,loc)::arg_types, + ((name, [], Ast_literal.type_string ~loc ()) :: result_types) + | Fn_uncurry_arity _ -> + Location.raise_errorf ~loc + "The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet" + | Extern_unit -> assert false + | NonNullString _ + -> + Location.raise_errorf ~loc + "bs.obj label %s does not support such arg type" name + | Unwrap -> + Location.raise_errorf ~loc + "bs.obj label %s does not support [@bs.unwrap] arguments" name + end + | Optional name -> + let arg_type = get_opt_arg_type ~nolabel:false ty in + begin match arg_type with + | Ignore -> + External_arg_spec.empty_kind arg_type, + (label,ty,attr,loc)::arg_types, result_types + | Nothing | Array -> + let s = (Lam_methname.translate ~loc name) in + {arg_label = External_arg_spec.optional s; arg_type}, + (label,ty,attr,loc)::arg_types, + ( (name, [], Ast_comb.to_undefined_type loc (get_basic_type_from_option_label ty)) :: result_types) + | Int _ -> + let s = Lam_methname.translate ~loc name in + {arg_label = External_arg_spec.optional s ; arg_type }, + (label,ty,attr,loc)::arg_types, + ((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types) + | NullString _ -> + let s = Lam_methname.translate ~loc name in + {arg_label = External_arg_spec.optional s ; arg_type }, + (label,ty,attr,loc)::arg_types, + ((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types) + | Arg_cst _ + -> + Location.raise_errorf ~loc "bs.as is not supported with optional yet" + | Fn_uncurry_arity _ -> + Location.raise_errorf ~loc + "The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet" + | Extern_unit -> assert false + | NonNullString _ + -> + Location.raise_errorf ~loc + "bs.obj label %s does not support such arg type" name + | Unwrap -> + Location.raise_errorf ~loc + "bs.obj label %s does not support [@bs.unwrap] arguments" name + end + in + ( + new_arg_label::arg_labels, + new_arg_types, + output_tys)) in + + let result = + if Ast_core_type.is_any result_type then + Ast_core_type.make_obj ~loc result_types + else + fst (refine_arg_type ~nolabel:true result_type) (* result type can not be labeled *) + + in + begin + Ast_compatible.mk_fn_type new_arg_types_ty result + , + prim_name, + External_ffi_types.Ffi_obj_create arg_kinds, + left_attrs, + false + end + + | _ -> Location.raise_errorf ~loc "Attribute found that conflicts with [@@bs.obj]" + + end + + else + let splice = st.splice in + let arg_type_specs, new_arg_types_ty, arg_type_specs_length = + Ext_list.fold_right arg_types_ty + (match st with + | {val_send_pipe = Some obj; _ } -> + let new_ty, arg_type = refine_arg_type ~nolabel:true obj in + begin match arg_type with + | Arg_cst _ -> + Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type " + | _ -> + (* more error checking *) + [External_arg_spec.empty_kind arg_type] + , + [Ast_compatible.no_label, new_ty, [], obj.ptyp_loc] + ,0 + end + + | {val_send_pipe = None ; _ } -> [],[], 0) + (fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) -> + let arg_label = Ast_compatible.convert label in + let arg_label, arg_type, new_arg_types = + match arg_label with + | Optional s -> + let arg_type = get_opt_arg_type ~nolabel:false ty in + begin match arg_type with + | NonNullString _ -> + (* ?x:([`x of int ] [@bs.string]) does not make sense *) + Location.raise_errorf + ~loc + "[@@bs.string] does not work with optional when it has arities in label %s" s + | _ -> + External_arg_spec.optional s, arg_type, + ((label, ty, attr,loc) :: arg_types) end + | Labelled s -> + begin match refine_arg_type ~nolabel:false ty with + | new_ty, (Arg_cst ( i) as arg_type) -> + External_arg_spec.label s (Some i), arg_type, arg_types + | new_ty, arg_type -> + External_arg_spec.label s None, arg_type, (label, new_ty,attr,loc) :: arg_types + end + | Nolabel -> + begin match refine_arg_type ~nolabel:true ty with + | new_ty , (Arg_cst ( i) as arg_type) -> + External_arg_spec.empty_lit i , arg_type, arg_types + | new_ty , arg_type -> + External_arg_spec.empty_label, arg_type, (label, new_ty,attr,loc) :: arg_types + end + in + (if i = 0 && splice then + match arg_type with + | Array -> () + | _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); + ({ External_arg_spec.arg_label ; + arg_type + } :: arg_type_specs, + new_arg_types, + if arg_type = Ignore then i + else i + 1 + ) + ) in + + let ffi : External_ffi_types.external_spec = match st with + | {set_index = true; + + val_name = `Nm_na; + external_module_name = None ; + module_as_val = None; + val_send = `Nm_na; + val_send_pipe = None; + splice = false; + scopes ; + get_index = false; + new_name = `Nm_na; + call_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + + return_wrapper = _; + mk_obj = _ ; + + } + -> + if String.length prim_name <> 0 then + Location.raise_errorf ~loc "[@@bs.set_index] expect external names to be empty string"; + if arg_type_specs_length = 3 then + Js_set_index {js_set_index_scopes = scopes} + else + Location.raise_errorf ~loc "Ill defined attribute [@@bs.set_index](arity of 3)" + + | {set_index = true; _} + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.set_index]") + + + | {get_index = true; + + val_name = `Nm_na; + external_module_name = None ; + module_as_val = None; + val_send = `Nm_na; + val_send_pipe = None; + + splice = false; + scopes ; + new_name = `Nm_na; + call_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + set_index = false; + mk_obj; + return_wrapper ; + } -> + if String.length prim_name <> 0 then + Location.raise_errorf ~loc "[@@bs.get_index] expect external names to be empty string"; + if arg_type_specs_length = 2 then + Js_get_index {js_get_index_scopes = scopes} + else Location.raise_errorf ~loc + "Ill defined attribute [@@bs.get_index] (arity expected 2 : while %d)" arg_type_specs_length + + | {get_index = true; _} + + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.get_index]") + + + + + | {module_as_val = Some external_module_name ; + + get_index = false; + val_name ; + new_name ; + + external_module_name = None ; + val_send = `Nm_na; + val_send_pipe = None; + scopes = []; (* module as var does not need scopes *) + splice; + call_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + set_index = false; + return_wrapper = _; + mk_obj = _ ; + } -> + begin match arg_types_ty, new_name, val_name with + | [], `Nm_na, _ -> Js_module_as_var external_module_name + | _, `Nm_na, _ -> Js_module_as_fn {splice; external_module_name } + | _, #bundle_source, #bundle_source -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.module].") + + | _, (`Nm_val _ | `Nm_external _) , `Nm_na + -> Js_module_as_class external_module_name + | _, `Nm_payload _ , `Nm_na + -> + Location.raise_errorf ~loc + "Incorrect FFI attribute found: (bs.new should not carry a payload here)" + end + | {module_as_val = Some x; _} + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.module].") + + | {call_name = (`Nm_val name | `Nm_external name | `Nm_payload name) ; + splice; + scopes ; + external_module_name; + + val_name = `Nm_na ; + module_as_val = None; + val_send = `Nm_na ; + val_send_pipe = None; + + set_index = false; + get_index = false; + new_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + mk_obj = _ ; + return_wrapper = _ ; + } -> + Js_call {splice; name; external_module_name; scopes } + | {call_name = #bundle_source ; _ } + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.val]") + + + | {val_name = (`Nm_val name | `Nm_external name | `Nm_payload name); + external_module_name; + + call_name = `Nm_na ; + module_as_val = None; + val_send = `Nm_na ; + val_send_pipe = None; + set_index = false; + get_index = false; + new_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na; + mk_obj = _; + return_wrapper = _; + splice = false ; + scopes ; + } + -> + Js_global { name; external_module_name; scopes} + | {val_name = #bundle_source ; _ } + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.val]") + + | {splice ; + scopes ; + external_module_name = (Some _ as external_module_name); + + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + val_send = `Nm_na ; + val_send_pipe = None; + set_index = false; + get_index = false; + new_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + mk_obj = _ ; + return_wrapper= _ ; + } + -> + let name = string_of_bundle_source prim_name_or_pval_prim in + if arg_type_specs_length = 0 then + Js_global { name; external_module_name; scopes} + else Js_call {splice; name; external_module_name; scopes} + | {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name); + splice; + scopes; + val_send_pipe = None; + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + new_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + external_module_name = None ; + mk_obj = _ ; + return_wrapper = _ ; + } -> + + (* PR #2162 - since when we assemble arguments the first argument in + [@@bs.send] is ignored + *) + begin match arg_type_specs with + | [] -> + Location.raise_errorf + ~loc "Ill defined attribute [@@bs.send] (the external needs to be a regular function call with at least one argument)" + | {arg_type = Arg_cst _ ; arg_label = _} :: _ + -> + Location.raise_errorf + ~loc "Ill defined attribute [@@bs.send] (first argument can't be const)" + | _ :: _ -> + Js_send {splice ; name; js_send_scopes = scopes ; pipe = false} + end + + | {val_send = #bundle_source; _ } + -> Location.raise_errorf ~loc "You used a FFI attribute that can't be used with [@@bs.send]" + + | {val_send_pipe = Some typ; + (* splice = (false as splice); *) + val_send = `Nm_na; + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + new_name = `Nm_na; + set_name = `Nm_na ; + get_name = `Nm_na ; + external_module_name = None ; + mk_obj = _; + return_wrapper = _; + scopes; + splice ; + } -> + (** can be one argument *) + Js_send {splice ; + name = string_of_bundle_source prim_name_or_pval_prim; + js_send_scopes = scopes; + pipe = true} + + | {val_send_pipe = Some _ ; _} + -> Location.raise_errorf ~loc "conflict attributes found with [@@bs.send.pipe]" + + | {new_name = (`Nm_val name | `Nm_external name | `Nm_payload name); + external_module_name; + + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + val_send = `Nm_na ; + val_send_pipe = None; + set_name = `Nm_na ; + get_name = `Nm_na ; + splice = false; + scopes; + mk_obj = _ ; + return_wrapper = _ ; + + } + -> Js_new {name; external_module_name; scopes} + | {new_name = #bundle_source ; _ } + -> + Bs_syntaxerr.err loc (Conflict_ffi_attribute "Attribute found that conflicts with [@@bs.new]") + + + | {set_name = (`Nm_val name | `Nm_external name | `Nm_payload name); + + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + val_send = `Nm_na ; + val_send_pipe = None; + new_name = `Nm_na ; + get_name = `Nm_na ; + external_module_name = None; + splice = false; + mk_obj = _ ; + return_wrapper = _; + scopes ; + } + -> + if arg_type_specs_length = 2 then + Js_set { js_set_scopes = scopes ; js_set_name = name} + else Location.raise_errorf ~loc "Ill defined attribute [@@bs.set] (two args required)" + + | {set_name = #bundle_source; _} + -> Location.raise_errorf ~loc "conflict attributes found with [@@bs.set]" + + | {get_name = (`Nm_val name | `Nm_external name | `Nm_payload name); + + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + val_send = `Nm_na ; + val_send_pipe = None; + new_name = `Nm_na ; + set_name = `Nm_na ; + external_module_name = None; + splice = false ; + mk_obj = _; + return_wrapper = _; + scopes + } + -> + if arg_type_specs_length = 1 then + Js_get { js_get_name = name; js_get_scopes = scopes } + else + Location.raise_errorf ~loc "Ill defined attribute [@@bs.get] (only one argument)" + | {get_name = #bundle_source; _} + -> Location.raise_errorf ~loc "Attribute found that conflicts with [@@bs.get]" + + | {get_name = `Nm_na; + val_name = `Nm_na ; + call_name = `Nm_na ; + module_as_val = None; + set_index = false; + get_index = false; + val_send = `Nm_na ; + val_send_pipe = None; + new_name = `Nm_na ; + set_name = `Nm_na ; + external_module_name = None; + splice = _ ; + scopes = _; + mk_obj = _; + return_wrapper = _; + + } + -> Location.raise_errorf ~loc "Could not infer which FFI category it belongs to, maybe you forgot [%@%@bs.val]? " in + begin + let relative = External_ffi_types.check_ffi ~loc ffi in + (* result type can not be labeled *) + (* currently we don't process attributes of + return type, in the future we may *) + let new_result_type = result_type in + (* get_arg_type ~nolabel:true false result_type in *) + let return_wrapper : External_ffi_types.return_wrapper = + check_return_wrapper loc st.return_wrapper new_result_type + in + Ast_compatible.mk_fn_type new_arg_types_ty new_result_type, + prim_name, + Ffi_bs (arg_type_specs,return_wrapper , ffi), + left_attrs, + relative + end + +let handle_attributes_as_string + pval_loc + pval_prim + (typ : Ast_core_type.t) attrs v : response = + let pval_type, prim_name, ffi, processed_attrs, relative = + handle_attributes pval_loc pval_prim typ attrs v in + { pval_type; + pval_prim = [prim_name; External_ffi_types.to_string ffi]; + pval_attributes = processed_attrs; + no_inline_cross_module = relative + } + + + +let pval_prim_of_labels (labels : string Asttypes.loc list) + = + let arg_kinds = + Ext_list.fold_right labels [] + (fun {loc ; txt } arg_kinds + -> + let arg_label = + External_arg_spec.label + (Lam_methname.translate ~loc txt) None in + {External_arg_spec.arg_type = Nothing ; + arg_label } :: arg_kinds + ) + in + let encoding = + External_ffi_types.to_string (Ffi_obj_create arg_kinds) in + [""; encoding] + +let pval_prim_of_option_labels +(labels : (bool * string Asttypes.loc) list) +(ends_with_unit : bool) + = + let arg_kinds = + Ext_list.fold_right labels + (if ends_with_unit then + [External_arg_spec.empty_kind Extern_unit] + else []) + (fun (is_option,{loc ; txt }) arg_kinds + -> + let label_name = (Lam_methname.translate ~loc txt) in + let arg_label = + if is_option then + External_arg_spec.optional label_name + else External_arg_spec.label label_name None + in + {External_arg_spec.arg_type = Nothing ; + arg_label } :: arg_kinds + ) + in + let encoding = + External_ffi_types.to_string (Ffi_obj_create arg_kinds) in + [""; encoding] + + +end +module Ast_pat : sig +#1 "ast_pat.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. *) + +type t = Parsetree.pattern + +val is_unit_cont : yes:'a -> no:'a -> t -> 'a + +(** [arity_of_fun pat e] tells the arity of + expression [fun pat -> e]*) +val arity_of_fun : t -> Parsetree.expression -> int + + +val is_single_variable_pattern_conservative : t -> bool + +end = struct +#1 "ast_pat.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. *) + + +type t = Parsetree.pattern + + +let is_unit_cont ~yes ~no (p : t) = + match p with + | {ppat_desc = Ppat_construct({txt = Lident "()"}, None)} + -> yes + | _ -> no + + +(** [arity_of_fun pat e] tells the arity of + expression [fun pat -> e] +*) +let arity_of_fun + (pat : Parsetree.pattern) + (e : Parsetree.expression) = + let rec aux (e : Parsetree.expression) = + match e.pexp_desc with + | Pexp_fun (arg_label, _, pat, e) + when Ast_compatible.is_arg_label_simple arg_label -> + 1 + aux e + | Pexp_fun _ + -> Location.raise_errorf + ~loc:e.pexp_loc "Label is not allowed in JS object" + | _ -> 0 in + is_unit_cont ~yes:0 ~no:1 pat + aux e + + +let rec is_single_variable_pattern_conservative (p : t ) = + match p.ppat_desc with + | Parsetree.Ppat_any + | Parsetree.Ppat_var _ -> true + | Parsetree.Ppat_alias (p,_) + | Parsetree.Ppat_constraint (p, _) -> + is_single_variable_pattern_conservative p + + | _ -> false + +end +module Bs_ast_mapper : sig +#1 "bs_ast_mapper.mli" + + + +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ +open Asttypes +open Parsetree +open Ast_mapper + +let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + +let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; +(* #if true then *) + type_declaration_list: mapper -> type_declaration list -> type_declaration list; +(* #end *) + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; +(* #if true then *) + value_bindings_rec: mapper -> value_binding list -> value_binding list; + value_bindings: mapper -> value_binding list -> value_binding list; +(* #end *) + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + +end = struct +#1 "bs_ast_mapper.ml" + + +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2012 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* A generic Parsetree mapping class *) + +(* +[@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) +*) + + +open Parsetree +open Ast_helper +open Location + +type mapper = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; +(* #if true then *) + type_declaration_list: mapper -> type_declaration list -> type_declaration list; +(* #end *) + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; +(* #if true then *) + value_bindings_rec: mapper -> value_binding list -> value_binding list; + value_bindings: mapper -> value_binding list -> value_binding list; +(* #end *) + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; +} + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (map_loc sub l, sub.attributes sub attrs, + b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let object_field sub = function + | Otag (l, attrs, t) -> + Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + +(* #if true then *) + let map_type_declaration_list sub l = List.map (sub.type_declaration sub) l +(* #end *) + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (ovf, lid, ct) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Misc.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> +(* #if false then + type_ ~loc rf (List.map (sub.type_declaration sub) l) +#else *) + type_ ~loc rf (sub.type_declaration_list sub l) +(* #end *) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Misc.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> +(* #if false then + value ~loc r (List.map (sub.value_binding sub) vbs) +#else *) + value ~loc r + ((if r = Recursive then sub.value_bindings_rec else sub.value_bindings) sub vbs) +(* #end *) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> +(* #if false then + type_ ~loc rf (List.map (sub.type_declaration sub) l) +#else *) + type_ ~loc rf (sub.type_declaration_list sub l) +(* #end *) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> +(* #if false then + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) +#else *) + let_ ~loc ~attrs r + ( (if r = Recursive then sub.value_bindings_rec else sub.value_bindings) + sub vbs + ) + (sub.expr sub e) +(* #end *) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> +(* #if false then + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) +#else *) + let_ ~loc ~attrs r + ((if r = Recursive then sub.value_bindings_rec else sub.value_bindings) + sub vbs + ) + (sub.class_expr sub ce) +(* #end *) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (ovf, lid, ce) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) +end + +(* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + +let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; +(* #if true then *) + type_declaration_list = T.map_type_declaration_list; +(* #end *) + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + +(* #if true then *) + value_bindings = (fun this vbs -> + match vbs with + | [vb] -> [this.value_binding this vb] + | _ -> List.map (this.value_binding this) vbs + ); + + value_bindings_rec = (fun this vbs -> + match vbs with + | [vb] -> [this.value_binding this vb] + | _ -> List.map (this.value_binding this) vbs + ); +(* #end *) + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + +end +module Ast_util : sig +#1 "ast_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. *) + + + +type loc = Location.t +type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list +type 'a cxt = loc -> Bs_ast_mapper.mapper -> 'a + +(** In general three kinds of ast generation. + - convert a curried to type to uncurried + - convert a curried fun to uncurried fun + - convert a uncuried application to normal +*) +type uncurry_expression_gen = + (Parsetree.pattern -> + Parsetree.expression -> + Parsetree.expression_desc) cxt +type uncurry_type_gen = + (Ast_compatible.arg_label -> (* label for error checking *) + Parsetree.core_type -> + Parsetree.core_type -> + Parsetree.core_type) cxt + +(** TODO: the interface is not reusable, it depends on too much context *) +(** syntax: {[f arg0 arg1 [@bs]]}*) +val uncurry_fn_apply : + (Parsetree.expression -> + Parsetree.expression list -> + Parsetree.expression_desc ) cxt + +(** syntax : {[f## arg0 arg1 ]}*) +val method_apply : + (Parsetree.expression -> + string -> + Parsetree.expression list -> + Parsetree.expression_desc) cxt + +(** syntax {[f#@ arg0 arg1 ]}*) +val property_apply : + (Parsetree.expression -> + string -> + Parsetree.expression list -> + Parsetree.expression_desc) cxt + + +(** + [function] can only take one argument, that is the reason we did not adopt it + syntax: + {[ fun [@bs] pat pat1-> body ]} + [to_uncurry_fn (fun pat -> (fun pat1 -> ... body))] + +*) +val to_uncurry_fn : uncurry_expression_gen + + +(** syntax: + {[fun [@bs.this] obj pat pat1 -> body]} +*) +val to_method_callback : uncurry_expression_gen + + +(** syntax : + {[ int -> int -> int [@bs]]} +*) +val to_uncurry_type : uncurry_type_gen + + +(** syntax + {[ method : int -> itn -> int ]} +*) +val to_method_type : uncurry_type_gen + +(** syntax: + {[ 'obj -> int -> int [@bs.this] ]} +*) +val to_method_callback_type : uncurry_type_gen + + + + + +val record_as_js_object : + (label_exprs -> + Parsetree.expression_desc) cxt + +val js_property : + loc -> + Parsetree.expression -> string -> Parsetree.expression_desc + +val handle_debugger : + loc -> Ast_payload.t -> Parsetree.expression_desc + +val handle_raw : + check_js_regex: bool -> loc -> Ast_payload.t -> Parsetree.expression + +val handle_external : + loc -> string -> Parsetree.expression + +val handle_raw_structure : + loc -> Ast_payload.t -> Parsetree.structure_item + +val ocaml_obj_as_js_object : + (Parsetree.pattern -> + Parsetree.class_field list -> + Parsetree.expression_desc) cxt + +end = struct +#1 "ast_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. *) + +open Ast_helper +type 'a cxt = Ast_helper.loc -> Bs_ast_mapper.mapper -> 'a +type loc = Location.t + +type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list +type uncurry_expression_gen = + (Parsetree.pattern -> + Parsetree.expression -> + Parsetree.expression_desc) cxt +type uncurry_type_gen = + (Ast_compatible.arg_label -> + Parsetree.core_type -> + Parsetree.core_type -> + Parsetree.core_type) cxt + +let uncurry_type_id = + Ast_literal.Lid.js_fn + +let method_id = + Ast_literal.Lid.js_meth + +let method_call_back_id = + Ast_literal.Lid.js_meth_callback + +let arity_lit = "Arity_" + +let mk_args loc (n : int) (tys : Parsetree.core_type list) : Parsetree.core_type = + Typ.variant ~loc + [ Rtag ( + + {loc; txt = arity_lit ^ string_of_int n} + + , + [], (n = 0), tys)] Closed None + +let generic_lift txt loc args result = + let xs = + match args with + | [ ] -> [mk_args loc 0 [] ; result ] + | [ x ] -> [ mk_args loc 1 [x] ; result ] + | _ -> + [mk_args loc (List.length args ) [Typ.tuple ~loc args] ; result ] + in + Typ.constr ~loc {txt ; loc} xs + +let lift_curry_type loc = + generic_lift uncurry_type_id loc + +let lift_method_type loc = + generic_lift method_id loc + +let lift_js_method_callback loc + = + generic_lift method_call_back_id loc +(** Note that currently there is no way to consume [Js.meth_callback] + so it is fine to encode it with a freedom, + but we need make it better for error message. + - all are encoded as + {[ + type fn = (`Args_n of _ , 'result ) Js.fn + type method = (`Args_n of _, 'result) Js.method + type method_callback = (`Args_n of _, 'result) Js.method_callback + ]} + For [method_callback], the arity is never zero, so both [method] + and [fn] requires (unit -> 'a) to encode arity zero +*) + + + +let arrow = Ast_compatible.arrow + + +let js_property loc obj (name : string) = + Parsetree.Pexp_send + ((Ast_compatible.app1 ~loc + (Exp.ident ~loc + {loc; + txt = Ldot (Ast_literal.Lid.js_internal, Literals.unsafe_downgrade)}) + obj), + + {loc; txt = name} + + ) + +(* TODO: + have a final checking for property arities + [#=], +*) + +(* + if not (Ast_compatible.is_arg_label_simple label) then + Bs_syntaxerr.err loc Label_in_uncurried_bs_attribute; +*) +let generic_apply kind loc + (self : Bs_ast_mapper.mapper) + (obj : Parsetree.expression) + (args : Parsetree.expression list) cb = + let obj = self.expr self obj in + let args = + Ext_list.map args (fun e -> self.expr self e) in + let len = List.length args in + let arity, fn, args = + match args with + | [ {pexp_desc = + Pexp_construct ({txt = Lident "()"}, None)}] + -> + 0, cb loc obj, [] + | _ -> + len, cb loc obj, args in + if arity < 10 then + let txt = + match kind with + | `Fn | `PropertyFn -> + Longident.Ldot (Ast_literal.Lid.js_internal, + Literals.fn_run ^ string_of_int arity) + | `Method -> + Longident.Ldot(Ast_literal.Lid.js_internal, + Literals.method_run ^ string_of_int arity + ) in + Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Ast_compatible.no_label,fn) :: Ext_list.map args (fun x -> Ast_compatible.no_label,x)) + else + let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in + let string_arity = string_of_int arity in + let pval_prim, pval_type = + match kind with + | `Fn | `PropertyFn -> + ["#fn_run"; string_arity], + arrow ~loc (lift_curry_type loc args_type result_type ) fn_type + | `Method -> + ["#method_run" ; string_arity], + arrow ~loc (lift_method_type loc args_type result_type) fn_type + in + Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type + ( fn :: args ) + + +let uncurry_fn_apply loc self fn args = + generic_apply `Fn loc self fn args (fun _ obj -> obj ) + +let property_apply loc self obj name args + = generic_apply `PropertyFn loc self obj args + (fun loc obj -> Exp.mk ~loc (js_property loc obj name)) + +let method_apply loc self obj name args = + generic_apply `Method loc self obj args + (fun loc obj -> Exp.mk ~loc (js_property loc obj name)) + +let generic_to_uncurry_type kind loc (mapper : Bs_ast_mapper.mapper) label + (first_arg : Parsetree.core_type) + (typ : Parsetree.core_type) = + if not (Ast_compatible.is_arg_label_simple label) then + Bs_syntaxerr.err loc Label_in_uncurried_bs_attribute; + + let rec aux acc (typ : Parsetree.core_type) = + (* in general, + we should collect [typ] in [int -> typ] before transformation, + however: when attributes [bs] and [bs.this] found in typ, + we should stop + *) + match Ast_attributes.process_attributes_rev typ.ptyp_attributes with + | Nothing, _ -> + begin match typ.ptyp_desc with + | Ptyp_arrow (label, arg, body) + -> + if not (Ast_compatible.is_arg_label_simple label) then + Bs_syntaxerr.err typ.ptyp_loc Label_in_uncurried_bs_attribute; + aux (mapper.typ mapper arg :: acc) body + | _ -> mapper.typ mapper typ, acc + end + | _, _ -> mapper.typ mapper typ, acc + in + let first_arg = mapper.typ mapper first_arg in + let result, rev_extra_args = aux [first_arg] typ in + let args = List.rev rev_extra_args in + let filter_args args = + match args with + | [{Parsetree.ptyp_desc = + (Ptyp_constr ({txt = Lident "unit"}, []) + )}] + -> [] + | _ -> args in + match kind with + | `Fn -> + let args = filter_args args in + lift_curry_type loc args result + | `Method -> + let args = filter_args args in + lift_method_type loc args result + + | `Method_callback + -> lift_js_method_callback loc args result + + +let to_uncurry_type = + generic_to_uncurry_type `Fn +let to_method_type = + generic_to_uncurry_type `Method +let to_method_callback_type = + generic_to_uncurry_type `Method_callback + +let generic_to_uncurry_exp kind loc (self : Bs_ast_mapper.mapper) pat body + = + let rec aux acc (body : Parsetree.expression) = + match Ast_attributes.process_attributes_rev body.pexp_attributes with + | Nothing, _ -> + begin match body.pexp_desc with + | Pexp_fun (arg_label,_, arg, body) + -> + if not (Ast_compatible.is_arg_label_simple arg_label) then + Bs_syntaxerr.err loc Label_in_uncurried_bs_attribute; + aux (self.pat self arg :: acc) body + | _ -> self.expr self body, acc + end + | _, _ -> self.expr self body, acc + in + let first_arg = self.pat self pat in + let () = + match kind with + | `Method_callback -> + if not @@ Ast_pat.is_single_variable_pattern_conservative first_arg then + Bs_syntaxerr.err first_arg.ppat_loc Bs_this_simple_pattern + | _ -> () + in + + let result, rev_extra_args = aux [first_arg] body in + let body = + Ext_list.fold_left rev_extra_args result (fun e p -> Ast_compatible.fun_ ~loc p e ) + in + let len = List.length rev_extra_args in + let arity = + match kind with + | `Fn -> + begin match rev_extra_args with + | [ p] + -> + Ast_pat.is_unit_cont ~yes:0 ~no:len p + + | _ -> len + end + | `Method_callback -> len in + if arity < 10 then + let txt = + match kind with + | `Fn -> + Longident.Ldot ( Ast_literal.Lid.js_internal, Literals.fn_mk ^ string_of_int arity) + | `Method_callback -> + Longident.Ldot (Ast_literal.Lid.js_internal, Literals.fn_method ^ string_of_int arity) in + Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Ast_compatible.no_label, body]) + + else + let pval_prim = + [ (match kind with + | `Fn -> "#fn_mk" + | `Method_callback -> "#fn_method"); + string_of_int arity] in + let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in + let pval_type = arrow ~loc fn_type ( + match kind with + | `Fn -> + lift_curry_type loc args_type result_type + | `Method_callback -> + lift_js_method_callback loc args_type result_type + ) in + Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type + (fun prim -> Ast_compatible.app1 ~loc prim body) + +let to_uncurry_fn = + generic_to_uncurry_exp `Fn +let to_method_callback = + generic_to_uncurry_exp `Method_callback + + +let handle_debugger loc (payload : Ast_payload.t) = + match payload with + | PStr [] -> + Parsetree.Pexp_apply + (Exp.ident {txt = Ldot(Ast_literal.Lid.js_internal, Literals.debugger ); loc}, + [ Ast_compatible.no_label, Ast_literal.val_unit ~loc ()]) + | _ -> + Location.raise_errorf ~loc "bs.debugger does not accept payload" + + +let handle_raw ~check_js_regex loc payload = + begin match Ast_payload.as_string_exp ~check_js_regex payload with + | Not_String_Lteral -> + Location.raise_errorf ~loc + "bs.raw can only be applied to a string" + | Ast_payload.JS_Regex_Check_Failed -> + Location.raise_errorf ~loc "this is an invalid js regex" + | Correct exp -> + let pexp_desc = + Parsetree.Pexp_apply ( + Exp.ident {loc; + txt = + Ldot (Ast_literal.Lid.js_internal, + Literals.raw_expr)}, + [Ast_compatible.no_label,exp] + ) + in + { exp with pexp_desc } + end + +let handle_external loc x = + let raw_exp : Ast_exp.t = + Ast_compatible.app1 + (Exp.ident ~loc + {loc; txt = Ldot (Ast_literal.Lid.js_internal, + Literals.raw_expr)}) + ~loc + (Ast_compatible.const_exp_string ~loc x ~delimiter:Ext_string.empty) in + let empty = (* FIXME: the empty delimiter does not make sense*) + Exp.ident ~loc + {txt = Ldot (Ldot(Lident"Js", "Undefined"), "empty");loc} + in + let undefined_typeof = + Exp.ident {loc ; txt = Ldot(Lident "Js","undefinedToOption")} in + let typeof = + Exp.ident {loc ; txt = Ldot(Lident "Js","typeof")} in + + Ast_compatible.app1 ~loc undefined_typeof ( + Exp.ifthenelse ~loc + (Ast_compatible.app2 ~loc + (Exp.ident ~loc {loc ; txt = Ldot (Lident "Pervasives", "=")} ) + (Ast_compatible.app1 ~loc typeof raw_exp) + (Ast_compatible.const_exp_string ~loc "undefined") + ) + empty + (Some raw_exp) + ) + + +let handle_raw_structure loc payload = + begin match Ast_payload.as_string_exp ~check_js_regex:false payload with + | Correct exp + -> + let pexp_desc = + Parsetree.Pexp_apply( + Exp.ident {txt = Ldot (Ast_literal.Lid.js_internal, Literals.raw_stmt); loc}, + [ Ast_compatible.no_label,exp]) in + Ast_helper.Str.eval + { exp with pexp_desc } + + | Not_String_Lteral + -> + Location.raise_errorf ~loc "bs.raw can only be applied to a string" + | JS_Regex_Check_Failed + -> + Location.raise_errorf ~loc "this is an invalid js regex" + end + + +let ocaml_obj_as_js_object + loc (mapper : Bs_ast_mapper.mapper) + (self_pat : Parsetree.pattern) + (clfs : Parsetree.class_field list) = + let self_type_lit = "self_type" in + + (** Attention: we should avoid type variable conflict for each method + Since the method name is unique, there would be no conflict + OCaml does not allow duplicate instance variable and duplicate methods, + but it does allow duplicates between instance variable and method name, + we should enforce such rules + {[ + object + val x = 3 + method x = 3 + end [@bs] + ]} should not compile with a meaningful error message + *) + + let generate_val_method_pair + loc (mapper : Bs_ast_mapper.mapper) + val_name is_mutable = + + let result = Typ.var ~loc val_name in + result , + ((val_name , [], result ) :: + (if is_mutable then + [val_name ^ Literals.setter_suffix,[], + to_method_type loc mapper Ast_compatible.no_label result (Ast_literal.type_unit ~loc ()) ] + else + []) ) + in + (* Note mapper is only for API compatible + * TODO: we should check label name to avoid conflict + *) + let self_type loc = Typ.var ~loc self_type_lit in + + let generate_arg_type loc (mapper : Bs_ast_mapper.mapper) + method_name arity : Ast_core_type.t = + let result = Typ.var ~loc method_name in + if arity = 0 then + to_method_type loc mapper Ast_compatible.no_label (Ast_literal.type_unit ~loc ()) result + + else + let tyvars = + Ext_list.init arity (fun i -> Typ.var ~loc (method_name ^ string_of_int i)) + in + begin match tyvars with + | x :: rest -> + let method_rest = + Ext_list.fold_right rest result (fun v acc -> Ast_compatible.arrow ~loc v acc) + in + to_method_type loc mapper Ast_compatible.no_label x method_rest + | _ -> assert false + end in + + let generate_method_type + loc + (mapper : Bs_ast_mapper.mapper) + ?alias_type method_name arity = + let result = Typ.var ~loc method_name in + + let self_type = + let v = self_type loc in + match alias_type with + | None -> v + | Some ty -> Typ.alias ~loc ty self_type_lit + in + if arity = 0 then + to_method_callback_type loc mapper Ast_compatible.no_label self_type result + else + let tyvars = + Ext_list.init arity (fun i -> Typ.var ~loc (method_name ^ string_of_int i)) + in + begin match tyvars with + | x :: rest -> + let method_rest = + Ext_list.fold_right rest result (fun v acc -> Ast_compatible.arrow ~loc v acc) + in + (to_method_callback_type loc mapper Ast_compatible.no_label self_type + (Ast_compatible.arrow ~loc x method_rest)) + | _ -> assert false + end in + + + (** we need calculate the real object type + and exposed object type, in some cases there are equivalent + + for public object type its [@bs.meth] it does not depend on itself + while for label argument it is [@bs.this] which depends internal object + *) + let internal_label_attr_types, public_label_attr_types = + Ext_list.fold_right clfs ([], []) + (fun ({pcf_loc = loc} as x : Parsetree.class_field) + (label_attr_types, public_label_attr_types) -> + match x.pcf_desc with + | Pcf_method ( + label, + public_flag, + Cfk_concrete + (Fresh, e)) + -> + begin match e.pexp_desc with + | Pexp_poly + (({pexp_desc = Pexp_fun (arg_label, _, pat, e)} ), + None) + when Ast_compatible.is_arg_label_simple arg_label + -> + let arity = Ast_pat.arity_of_fun pat e in + let method_type = + generate_arg_type x.pcf_loc mapper label.txt arity in + ((label.Asttypes.txt, [], method_type) :: label_attr_types), + (if public_flag = Public then + (label.Asttypes.txt, [], method_type) :: public_label_attr_types + else + public_label_attr_types) + + | Pexp_poly( _, Some _) + -> + Location.raise_errorf ~loc "polymorphic type annotation not supported yet" + | Pexp_poly (_, None) -> + Location.raise_errorf ~loc + "Unsupported syntax, expect syntax like `method x () = x ` " + | _ -> + Location.raise_errorf ~loc "Unsupported syntax in js object" + end + | Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) -> + let label_type, label_attr = + generate_val_method_pair x.pcf_loc mapper label.txt + (mutable_flag = Mutable ) + in + (Ext_list.append label_attr label_attr_types, public_label_attr_types) + | Pcf_val (label, mutable_flag, Cfk_concrete(Override, val_exp)) -> + Location.raise_errorf ~loc "override flag not support currently" + | Pcf_val (label, mutable_flag, Cfk_virtual _) -> + Location.raise_errorf ~loc "virtual flag not support currently" + + | Pcf_method (_, _, Cfk_concrete(Override, _) ) -> + Location.raise_errorf ~loc "override flag not supported" + + | Pcf_method (_, _, Cfk_virtual _ ) + -> + Location.raise_errorf ~loc "virtural method not supported" + + | Pcf_inherit _ + | Pcf_initializer _ + | Pcf_attribute _ + | Pcf_extension _ + | Pcf_constraint _ -> + Location.raise_errorf ~loc "Only method support currently" + ) in + let internal_obj_type = Ast_core_type.make_obj ~loc internal_label_attr_types in + let public_obj_type = Ast_core_type.make_obj ~loc public_label_attr_types in + let (labels, label_types, exprs, _) = + Ext_list.fold_right clfs ([], [], [], false) + (fun (x : Parsetree.class_field) + (labels, + label_types, + exprs, aliased ) -> + match x.pcf_desc with + | Pcf_method ( + label, + _public_flag, + Cfk_concrete + (Fresh, e)) + -> + begin match e.pexp_desc with + | Pexp_poly + (({pexp_desc = Pexp_fun (arg_label, None, pat, e)} as f), + None) + when Ast_compatible.is_arg_label_simple arg_label + -> + let arity = Ast_pat.arity_of_fun pat e in + let alias_type = + if aliased then None + else Some internal_obj_type in + let label_type = + generate_method_type ?alias_type + x.pcf_loc mapper label.txt arity in + (label::labels, + label_type::label_types, + {f with + pexp_desc = + let f = Ast_pat.is_unit_cont pat ~yes:e ~no:f in + to_method_callback loc mapper self_pat f + } :: exprs, + true + ) + | Pexp_poly( _, Some _) + -> + Location.raise_errorf ~loc + "polymorphic type annotation not supported yet" + + | Pexp_poly (_, None) -> + Location.raise_errorf + ~loc "Unsupported syntax, expect syntax like `method x () = x ` " + | _ -> + Location.raise_errorf ~loc "Unsupported syntax in js object" + end + | Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) -> + let label_type, label_attr = + generate_val_method_pair x.pcf_loc mapper label.txt + (mutable_flag = Mutable ) + in + (label::labels, + label_type :: label_types, + (mapper.expr mapper val_exp :: exprs), + aliased + ) + + | Pcf_val (label, mutable_flag, Cfk_concrete(Override, val_exp)) -> + Location.raise_errorf ~loc "override flag not support currently" + | Pcf_val (label, mutable_flag, Cfk_virtual _) -> + Location.raise_errorf ~loc "virtual flag not support currently" + + | Pcf_method (_, _, Cfk_concrete(Override, _) ) -> + Location.raise_errorf ~loc "override flag not supported" + + | Pcf_method (_, _, Cfk_virtual _ ) + -> + Location.raise_errorf ~loc "virtural method not supported" + + + | Pcf_inherit _ + | Pcf_initializer _ + | Pcf_attribute _ + | Pcf_extension _ + | Pcf_constraint _ -> + Location.raise_errorf ~loc "Only method support currently" + ) in + let pval_type = + Ext_list.fold_right2 labels label_types public_obj_type + (fun label label_type acc -> + Ast_compatible.label_arrow + ~loc:label.Asttypes.loc + label.Asttypes.txt + label_type acc + ) in + Ast_external_mk.local_extern_cont + loc + ~pval_prim:(Ast_external_process.pval_prim_of_labels labels) + (fun e -> + Ast_compatible.apply_labels ~loc e + (Ext_list.map2 labels exprs (fun l expr -> l.txt, expr) ) ) + ~pval_type + + +let record_as_js_object + loc + (self : Bs_ast_mapper.mapper) + (label_exprs : label_exprs) + : Parsetree.expression_desc = + + let labels,args, arity = + Ext_list.fold_right label_exprs ([],[],0) (fun ({txt ; loc}, e) (labels,args,i) -> + match txt with + | Lident x -> + ({Asttypes.loc = loc ; txt = x} :: labels, (x, self.expr self e) :: args, i + 1) + | Ldot _ | Lapply _ -> + Location.raise_errorf ~loc "invalid js label ") in + Ast_external_mk.local_external_obj loc + ~pval_prim:(Ast_external_process.pval_prim_of_labels labels) + ~pval_type:(Ast_core_type.from_labels ~loc arity labels) + args + + +end +module Ast_exp_apply : sig +#1 "ast_exp_apply.mli" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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 app_exp_mapper : + Parsetree.expression -> + Bs_ast_mapper.mapper -> + Parsetree.expression -> + Ast_compatible.args -> + Parsetree.expression +end = struct +#1 "ast_exp_apply.ml" +(* Copyright (C) 2018 Authors of BuckleScript + * + * 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. *) + +open Ast_helper +type exp = Parsetree.expression + +let rec no_need_bound (exp : exp) = + match exp.pexp_desc with + | Pexp_ident { txt = Lident _} -> true + | Pexp_constraint(e,_) -> no_need_bound e + | _ -> false + +let ocaml_obj_id = "__ocaml_internal_obj" + +let bound (e : exp) (cb : exp -> _) = + if no_need_bound e then cb e + else + let loc = e.pexp_loc in + Exp.let_ ~loc Nonrecursive + [ Vb.mk ~loc (Pat.var ~loc {txt = ocaml_obj_id; loc}) e ] + (cb (Exp.ident ~loc {txt = Lident ocaml_obj_id; loc})) + +let default_expr_mapper = Bs_ast_mapper.default_mapper.expr + +let check_and_discard (args : Ast_compatible.args) = + Ext_list.map args (fun (label,x) -> + if not (Ast_compatible.is_arg_label_simple label) then + Bs_syntaxerr.err x.pexp_loc Label_in_uncurried_bs_attribute; + x + ) + +type app_pattern = { + op : string; + loc : Location.t; + args : Parsetree.expression list +} + +(* match fn as *) +let view_as_app (fn : exp) s : app_pattern option = + match fn.pexp_desc with + | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident op; loc}}, args ) + when Ext_list.has_string s op + -> + Some {op; loc; args = check_and_discard args} + | _ -> None + + + +let inner_ops = ["##"; "#@"] +let infix_ops = [ "|."; "#=" ; "##"] +let app_exp_mapper + (e : exp) + (self : Bs_ast_mapper.mapper) + (fn : exp) + (args : Ast_compatible.args) : exp = + (* - (f##paint) 1 2 + - (f#@paint) 1 2 + *) + match view_as_app fn inner_ops with + | Some { op; loc; + args = [obj; + {pexp_desc = Pexp_ident {txt = Lident name;_ } ; _}]} + -> + {e with pexp_desc = + (if op = "##" then + Ast_util.method_apply + else Ast_util.property_apply) + loc self obj name (check_and_discard args) } + | Some {op; loc} -> + Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op + | None -> + match view_as_app e infix_ops with + | Some { op = "|."; args = [obj_arg; fn];loc} -> + (* + a |. f + a |. f b c [@bs] --> f a b c [@bs] + a |. M.(f b c) --> M.f a M.b M.c + a |. M.Some + *) + let new_obj_arg = self.expr self obj_arg in + begin match fn with + | {pexp_desc = Pexp_apply (fn, args); pexp_loc; pexp_attributes} -> + let fn = self.expr self fn in + let args = Ext_list.map args (fun (lab,exp) -> lab, self.expr self exp ) in + Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes; + { pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, new_obj_arg) :: args); + pexp_attributes = []; + pexp_loc = pexp_loc} + | {pexp_desc = Pexp_construct(ctor,None); pexp_loc; pexp_attributes} -> + {fn with pexp_desc = Pexp_construct(ctor, Some new_obj_arg)} + | _ -> + begin match Ast_open_cxt.destruct fn [] with + | {pexp_desc = Pexp_tuple xs; pexp_attributes = tuple_attrs}, wholes -> + (bound new_obj_arg @@ fun bounded_obj_arg -> + { + pexp_desc = + Pexp_tuple ( + Ext_list.map xs (fun fn -> + match fn with + | {pexp_desc = Pexp_apply (fn,args); pexp_loc; pexp_attributes } + -> + let fn = self.expr self fn in + let args = Ext_list.map args (fun (lab,exp) -> lab, self.expr self exp ) in + Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes; + { Parsetree.pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, bounded_obj_arg) :: args); + pexp_attributes = []; + pexp_loc = pexp_loc} + | {pexp_desc = Pexp_construct(ctor,None); pexp_loc; pexp_attributes} + -> + {fn with pexp_desc = Pexp_construct(ctor, Some bounded_obj_arg)} + | _ -> + Ast_compatible.app1 ~loc:fn.pexp_loc + (self.expr self fn ) + bounded_obj_arg + )); + pexp_attributes = tuple_attrs; + pexp_loc = fn.pexp_loc; + } + ) + | {pexp_desc = Pexp_apply (e, args); pexp_attributes}, (_ :: _ as wholes) -> + let fn = self.expr self (Ast_open_cxt.restore_exp e wholes) in + let args = Ext_list.map args (fun (lab,exp) -> lab, self.expr self (Ast_open_cxt.restore_exp exp wholes)) in + Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes; + { pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, new_obj_arg) :: args); + pexp_attributes = []; + pexp_loc = loc} + | _ -> Ast_compatible.app1 ~loc (self.expr self fn) new_obj_arg + end + end + | Some { op = "##" ; loc; args = [obj; rest]} -> + (* - obj##property + - obj#(method a b ) + we should warn when we discard attributes + gpr#1063 foo##(bar##baz) we should rewrite (bar##baz) + first before pattern match. + currently the pattern match is written in a top down style. + Another corner case: f##(g a b [@bs]) + *) + begin match rest with + {pexp_desc = Pexp_apply( + {pexp_desc = Pexp_ident {txt = Lident name;_ } ; _}, + args + ); pexp_attributes = attrs } + -> + Bs_ast_invariant.warn_discarded_unused_attributes attrs ; + {e with pexp_desc = Ast_util.method_apply loc self obj name (check_and_discard args)} + | + {pexp_desc = Pexp_ident {txt = Lident name;_ } ; _} + (* f##paint *) + -> + { e with pexp_desc = + Ast_util.js_property loc (self.expr self obj) name + } + | _ -> Location.raise_errorf ~loc "invalid ## syntax" + end + + (* we can not use [:=] for precedece cases + like {[i @@ x##length := 3 ]} + is parsed as {[ (i @@ x##length) := 3]} + since we allow user to create Js objects in OCaml, it can be of + ref type + {[ + let u = object (self) + val x = ref 3 + method setX x = self##x := 32 + method getX () = !self##x + end + ]} + *) + | Some {op = "#="; loc; args = [obj; arg]} -> + begin match view_as_app obj ["##"] with + | Some { args = [obj; {pexp_desc = Pexp_ident {txt = Lident name}}]} + -> + Exp.constraint_ ~loc + { e with + pexp_desc = + Ast_util.method_apply loc self obj + (name ^ Literals.setter_suffix) [arg] } + (Ast_literal.type_unit ~loc ()) + | _ -> assert false + end + | Some { op = "|."; loc; } -> + Location.raise_errorf ~loc + "invalid |. syntax, it can only be used as binary operator" + | Some {op = "##"; loc } -> + Location.raise_errorf ~loc + "Js object ## expect syntax like obj##(paint (a,b)) " + | Some {op; } -> Location.raise_errorf "invalid %s syntax" op + | None -> + match + Ext_list.exclude_with_val + e.pexp_attributes + Ast_attributes.is_bs with + | None -> default_expr_mapper self e + | Some pexp_attributes -> + {e with pexp_desc = Ast_util.uncurry_fn_apply e.pexp_loc self fn (check_and_discard args) ; + pexp_attributes } + + + +end +module Ppx_driver : sig +#1 "ppx_driver.mli" +(* Copyright (C) 2019- Authors of BuckleScript + * + * 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 main : + (Parsetree.structure -> Parsetree.structure) -> + (Parsetree.signature -> Parsetree.signature) -> + unit + +end = struct +#1 "ppx_driver.ml" +(* Copyright (C) 2019- Authors of BuckleScript + * + * 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 apply_lazy ~source ~target + (impl : Parsetree.structure -> Parsetree.structure) + (iface : Parsetree.signature -> Parsetree.signature) + = + let ic = open_in_bin source in + let magic = + really_input_string ic (String.length Config.ast_impl_magic_number) + in + if magic <> Config.ast_impl_magic_number + && magic <> Config.ast_intf_magic_number then + failwith "Bs_ast_mapper: OCaml version mismatch or malformed input"; + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + + let ast = + if magic = Config.ast_impl_magic_number + then Obj.magic (impl (Obj.magic ast)) + else Obj.magic (iface (Obj.magic ast)) + in + let oc = open_out_bin target in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc + +let main impl intf = + try + let a = Sys.argv in + let n = Array.length a in + if n > 2 then + apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) + impl + intf + else + begin + Printf.eprintf "Usage: %s [extra_args] \n%!" + Sys.executable_name; + exit 2 + end + with exn -> + begin + Location.report_exception Format.err_formatter exn; + exit 2 + end + +end +module Native_ppx_main : sig +#1 "native_ppx_main.mli" + +end = struct +#1 "native_ppx_main.ml" +(* Copyright (C) 2019- Authors of BuckleScript + * + * 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. *) + + +type mapper = Bs_ast_mapper.mapper + +let default_expr_mapper = Bs_ast_mapper.default_mapper.expr + +let expr_mapper (self : mapper) ( e : Parsetree.expression) = + match e.pexp_desc with + | Pexp_apply(fn, args) -> + Ast_exp_apply.app_exp_mapper e self fn args + | _ -> default_expr_mapper self e + +let my_mapper : mapper = { + Bs_ast_mapper.default_mapper with + expr = expr_mapper +} + +let () = + Ppx_driver.main + (fun x -> my_mapper.structure my_mapper x) + (fun x -> my_mapper.signature my_mapper x) +end diff --git a/lib/4.06.1/unstable/native_ppx.ml.d b/lib/4.06.1/unstable/native_ppx.ml.d new file mode 100644 index 0000000000..873b674398 --- /dev/null +++ b/lib/4.06.1/unstable/native_ppx.ml.d @@ -0,0 +1,129 @@ +../lib/4.06.1/unstable/native_ppx.ml: +../ocaml/parsing/ast_helper.ml +../ocaml/parsing/ast_helper.mli +../ocaml/parsing/ast_iterator.ml +../ocaml/parsing/ast_iterator.mli +../ocaml/parsing/asttypes.mli +../ocaml/parsing/docstrings.ml +../ocaml/parsing/docstrings.mli +../ocaml/parsing/location.ml +../ocaml/parsing/location.mli +../ocaml/parsing/longident.ml +../ocaml/parsing/longident.mli +../ocaml/parsing/parsetree.mli +../ocaml/parsing/syntaxerr.ml +../ocaml/parsing/syntaxerr.mli +../ocaml/utils/arg_helper.ml +../ocaml/utils/arg_helper.mli +../ocaml/utils/clflags.ml +../ocaml/utils/clflags.mli +../ocaml/utils/config.ml +../ocaml/utils/config.mli +../ocaml/utils/identifiable.ml +../ocaml/utils/identifiable.mli +../ocaml/utils/misc.ml +../ocaml/utils/misc.mli +../ocaml/utils/numbers.ml +../ocaml/utils/numbers.mli +../ocaml/utils/profile.ml +../ocaml/utils/profile.mli +../ocaml/utils/terminfo.ml +../ocaml/utils/terminfo.mli +../ocaml/utils/warnings.ml +../ocaml/utils/warnings.mli +./common/bs_loc.ml +./common/bs_loc.mli +./common/bs_version.ml +./common/bs_version.mli +./common/bs_warnings.ml +./common/bs_warnings.mli +./common/js_config.ml +./common/js_config.mli +./common/lam_methname.ml +./common/lam_methname.mli +./ext/ext_array.ml +./ext/ext_array.mli +./ext/ext_bytes.ml +./ext/ext_bytes.mli +./ext/ext_char.ml +./ext/ext_char.mli +./ext/ext_js_regex.ml +./ext/ext_js_regex.mli +./ext/ext_json_parse.ml +./ext/ext_json_parse.mli +./ext/ext_json_types.ml +./ext/ext_list.ml +./ext/ext_list.mli +./ext/ext_option.ml +./ext/ext_option.mli +./ext/ext_path.ml +./ext/ext_path.mli +./ext/ext_pervasives.ml +./ext/ext_pervasives.mli +./ext/ext_position.ml +./ext/ext_position.mli +./ext/ext_string.ml +./ext/ext_string.mli +./ext/ext_sys.ml +./ext/ext_sys.mli +./ext/ext_utf8.ml +./ext/ext_utf8.mli +./ext/ext_util.ml +./ext/ext_util.mli +./ext/hash_set_gen.ml +./ext/hash_set_poly.ml +./ext/hash_set_poly.mli +./ext/literals.ml +./ext/literals.mli +./ext/map_gen.ml +./ext/string_hash_set.ml +./ext/string_hash_set.mli +./ext/string_map.ml +./ext/string_map.mli +./main/native_ppx_main.ml +./main/native_ppx_main.mli +./stubs/bs_hash_stubs.ml +./syntax/ast_attributes.ml +./syntax/ast_attributes.mli +./syntax/ast_comb.ml +./syntax/ast_comb.mli +./syntax/ast_compatible.ml +./syntax/ast_compatible.mli +./syntax/ast_core_type.ml +./syntax/ast_core_type.mli +./syntax/ast_exp.ml +./syntax/ast_exp.mli +./syntax/ast_exp_apply.ml +./syntax/ast_exp_apply.mli +./syntax/ast_external_mk.ml +./syntax/ast_external_mk.mli +./syntax/ast_external_process.ml +./syntax/ast_external_process.mli +./syntax/ast_literal.ml +./syntax/ast_literal.mli +./syntax/ast_open_cxt.ml +./syntax/ast_open_cxt.mli +./syntax/ast_pat.ml +./syntax/ast_pat.mli +./syntax/ast_payload.ml +./syntax/ast_payload.mli +./syntax/ast_polyvar.ml +./syntax/ast_polyvar.mli +./syntax/ast_utf8_string.ml +./syntax/ast_utf8_string.mli +./syntax/ast_utf8_string_interp.ml +./syntax/ast_utf8_string_interp.mli +./syntax/ast_util.ml +./syntax/ast_util.mli +./syntax/bs_ast_invariant.ml +./syntax/bs_ast_invariant.mli +./syntax/bs_ast_mapper.ml +./syntax/bs_ast_mapper.mli +./syntax/bs_syntaxerr.ml +./syntax/bs_syntaxerr.mli +./syntax/external_arg_spec.ml +./syntax/external_arg_spec.mli +./syntax/external_ffi_types.ml +./syntax/external_ffi_types.mli +./syntax/ppx_driver.ml +./syntax/ppx_driver.mli diff --git a/lib/4.06.1+BS/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml similarity index 99% rename from lib/4.06.1+BS/whole_compiler.ml rename to lib/4.06.1/whole_compiler.ml index 5c8ac68252..6185c74ddd 100644 --- a/lib/4.06.1+BS/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -269,7 +269,7 @@ end = struct (**************************************************************************) (* The main OCaml version string has moved to ../VERSION *) -let version = "4.06.2+BS" +let version = "4.06.1+BS" let standard_library = Filename.concat (Filename.dirname Sys.executable_name) "ocaml" let standard_library_default = standard_library @@ -32559,6 +32559,129 @@ let js_id_name_of_hint_name module_name = if Ext_string.is_empty res then module_name else res +end +module Ext_ref : sig +#1 "ext_ref.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. *) + +(** [non_exn_protect ref value f] assusme [f()] + would not raise +*) + +val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b +val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b + +val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +(** [non_exn_protect2 refa refb va vb f ] + assume [f ()] would not raise +*) +val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c + +val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b + +end = struct +#1 "ext_ref.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 non_exn_protect r v body = + let old = !r in + r := v; + let res = body() in + r := old; + res + +let protect r v body = + let old = !r in + try + r := v; + let res = body() in + r := old; + res + with x -> + r := old; + raise x + +let non_exn_protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + +let protect2 r1 r2 v1 v2 body = + let old1 = !r1 in + let old2 = !r2 in + try + r1 := v1; + r2 := v2; + let res = body() in + r1 := old1; + r2 := old2; + res + with x -> + r1 := old1; + r2 := old2; + raise x + +let protect_list rvs body = + let olds = Ext_list.map rvs (fun (x,y) -> !x) in + let () = List.iter (fun (x,y) -> x:=y) rvs in + try + let res = body () in + List.iter2 (fun (x,_) old -> x := old) rvs olds; + res + with e -> + List.iter2 (fun (x,_) old -> x := old) rvs olds; + raise e + end module Ml_binary : sig #1 "ml_binary.mli" @@ -33890,6 +34013,7 @@ type 'a kind = 'a Ml_binary.kind let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = Depend.free_structure_names := String_set.empty; + Ext_ref.protect Clflags.transparent_modules false begin fun _ -> List.iter (fun modname -> @@ -33901,7 +34025,7 @@ let read_parse_and_extract (type t) (k : t kind) (ast : t) : String_set.t = | Ml_binary.Ml -> Depend.add_implementation bound_vars ast | Ml_binary.Mli -> Depend.add_signature bound_vars ast ); !Depend.free_structure_names - + end type ('a,'b) ast_info = | Ml of @@ -121682,129 +121806,6 @@ let record_as_js_object args -end -module Ext_ref : sig -#1 "ext_ref.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. *) - -(** [non_exn_protect ref value f] assusme [f()] - would not raise -*) - -val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b -val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b - -val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c - -(** [non_exn_protect2 refa refb va vb f ] - assume [f ()] would not raise -*) -val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c - -val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b - -end = struct -#1 "ext_ref.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 non_exn_protect r v body = - let old = !r in - r := v; - let res = body() in - r := old; - res - -let protect r v body = - let old = !r in - try - r := v; - let res = body() in - r := old; - res - with x -> - r := old; - raise x - -let non_exn_protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - r1 := v1; - r2 := v2; - let res = body() in - r1 := old1; - r2 := old2; - res - -let protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - try - r1 := v1; - r2 := v2; - let res = body() in - r1 := old1; - r2 := old2; - res - with x -> - r1 := old1; - r2 := old2; - raise x - -let protect_list rvs body = - let olds = Ext_list.map rvs (fun (x,y) -> !x) in - let () = List.iter (fun (x,y) -> x:=y) rvs in - try - let res = body () in - List.iter2 (fun (x,_) old -> x := old) rvs olds; - res - with e -> - List.iter2 (fun (x,_) old -> x := old) rvs olds; - raise e - end module Ast_exp_extension : sig #1 "ast_exp_extension.mli" diff --git a/lib/4.06.1+BS/whole_compiler.ml.d b/lib/4.06.1/whole_compiler.ml.d similarity index 99% rename from lib/4.06.1+BS/whole_compiler.ml.d rename to lib/4.06.1/whole_compiler.ml.d index 46a74df796..6eb9d6de34 100644 --- a/lib/4.06.1+BS/whole_compiler.ml.d +++ b/lib/4.06.1/whole_compiler.ml.d @@ -1,4 +1,4 @@ -../lib/4.06.1+BS/whole_compiler.ml: +../lib/4.06.1/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml diff --git a/lib/4.06.1/whole_compiler.mli b/lib/4.06.1/whole_compiler.mli new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/copy.darwin.ninja b/lib/copy.darwin.ninja deleted file mode 100644 index 08b3244164..0000000000 --- a/lib/copy.darwin.ninja +++ /dev/null @@ -1,7 +0,0 @@ - - -rule cp - command = cp $in $out - -ext = darwin -include copy.ninja diff --git a/lib/copy.linux.ninja b/lib/copy.linux.ninja deleted file mode 100644 index 13bcbd6c03..0000000000 --- a/lib/copy.linux.ninja +++ /dev/null @@ -1,5 +0,0 @@ -rule cp - command = cp $in $out - -ext = linux -include copy.ninja diff --git a/lib/copy.ninja b/lib/copy.ninja deleted file mode 100644 index c12faf245a..0000000000 --- a/lib/copy.ninja +++ /dev/null @@ -1,11 +0,0 @@ - - - -build bsc.exe: cp bsc.$ext -build bsb.exe: cp bsb.$ext -build bsb_helper.exe: cp bsb_helper.$ext -build bsppx.exe: cp bsppx.$ext -build refmt.exe: cp refmt.$ext -build reactjs_jsx_ppx_2.exe: cp reactjs_jsx_ppx_2.$ext - - diff --git a/lib/copy.win32.ninja b/lib/copy.win32.ninja deleted file mode 100644 index 9828f9c328..0000000000 --- a/lib/copy.win32.ninja +++ /dev/null @@ -1,5 +0,0 @@ -rule cp - command = cmd /q /c copy $in $out 1>nul - -ext = win32 -include copy.ninja diff --git a/scripts/buildocaml.js b/scripts/buildocaml.js index 53eec6aa9c..ced968bb49 100644 --- a/scripts/buildocaml.js +++ b/scripts/buildocaml.js @@ -1,9 +1,26 @@ - +//@ts-check var cp = require('child_process') var path = require('path') -var prefix = path.normalize(path.join(__dirname,'..','native')) +var fs = require('fs') + + + + + +// FIXME: this works in CI, but for release build, submodule +// is carried, so it needs to be fixed +/** + * @returns{string} + */ +function getVersionPrefix(){ + var version = fs.readFileSync(path.join(__dirname, '..', 'ocaml', 'VERSION'), 'ascii') + return version.substr(0, version.indexOf('+')) +} +exports.getVersionPrefix = getVersionPrefix + function build() { + var prefix = path.normalize(path.join(__dirname,'..','native',getVersionPrefix())) cp.execSync('./configure -prefix ' + prefix + ' -no-ocamlbuild -no-curses -no-graph -no-pthread -no-debugger && make clean && make -j9 world.opt && make install ' , { cwd: path.join(__dirname, '..', 'ocaml'), stdio: [0, 1, 2] }) } diff --git a/scripts/ciTest.js b/scripts/ciTest.js index 0f06670fdd..205da0cded 100644 --- a/scripts/ciTest.js +++ b/scripts/ciTest.js @@ -51,7 +51,7 @@ var ninjaPath = '' function init(){ var vendorOCamlPath = - path.join(__dirname,'..','native','bin') + path.join(__dirname,'..','native', require('./buildocaml.js').getVersionPrefix(),'bin') process.env['PATH'] = vendorOCamlPath + path.delimiter + process.env['PATH'] @@ -81,7 +81,17 @@ function main() { console.log('OCaml:', output) var binDir = path.join(__dirname, '..','jscomp', 'bin') if(ounitTest){ - cp.execSync(`ocamlopt.opt -g -w -40-30 ../stubs/ext_basic_hash_stubs.c -I +compiler-libs ocamlcommon.cmxa unix.cmxa str.cmxa all_ounit_tests.mli all_ounit_tests.ml -o test.exe`, + var fn = fs.copyFileSync ? fs.copyFileSync : fs.renameSync + fn( + path.join( + __dirname, + '..', + 'lib', + require('./buildocaml.js').getVersionPrefix(), + 'unstable', + 'all_ounit_tests.ml'), + path.join(binDir, 'all_ounit_tests.ml')) + cp.execSync(`ocamlopt.opt -g -w -40-30 ../stubs/ext_basic_hash_stubs.c -I +compiler-libs ocamlcommon.cmxa unix.cmxa str.cmxa all_ounit_tests.ml -o test.exe`, { cwd: binDir, stdio : [0,1,2] diff --git a/scripts/install.js b/scripts/install.js index 14b7e7251d..69e68a93e3 100644 --- a/scripts/install.js +++ b/scripts/install.js @@ -19,7 +19,7 @@ var lib_dir = path.join(root_dir, 'lib') var jscomp_dir = path.join(root_dir, 'jscomp') var runtime_dir = path.join(jscomp_dir,'runtime') var others_dir = path.join(jscomp_dir,'others') -var stdlib_dir = path.join(jscomp_dir, 'stdlib-402') + var ocaml_dir = path.join(lib_dir,'ocaml') @@ -29,10 +29,12 @@ var is_windows = config.is_windows var sys_extension = config.sys_extension process.env.BS_RELEASE_BUILD = 'true' +var ocamlVersion = require('./buildocaml.js').getVersionPrefix() +var stdlib_dir = path.join(jscomp_dir, ocamlVersion.includes('4.02') ? 'stdlib-402' : 'stdlib-406') // Add vendor bin path // So that second try will work process.env.PATH = - path.join(__dirname, '..', 'native','bin') + + path.join(__dirname, '..', 'native',ocamlVersion,'bin') + path.delimiter + process.env.PATH @@ -179,7 +181,7 @@ function install(){ }) } -var ocamlVersion = require('./vendored_ocaml_version.js').getVersionPrefix() + /** * raise an exception if not matched @@ -217,9 +219,41 @@ function tryToProvideOCamlCompiler() { } } +/** + * + * @param {string} sys_extension + * + */ +function createCopyNinja(sys_extension){ + var output = '' + switch(sys_extension){ + case '.win32': + output += ` +rule cp + command = cmd /q /c copy $in $out 1>nul +` + break + default: + output += ` +rule cp + command = cp $in $out +` + break + } + output += [ + 'bsc','bsb','bsb_helper','bsppx', + 'refmt','reactjs_jsx_ppx_2' + ].map(function(x){ + return `build ${x}.exe: cp ${x}${sys_extension}` + }).join('\n') + output += '\n' + return output +} + function copyPrebuiltCompilers() { + fs.writeFileSync(path.join(lib_dir,'copy.ninja'),createCopyNinja(sys_extension),'ascii') cp.execFileSync(ninja_bin_output, - ["-f", "copy" + sys_extension + ".ninja"], + ["-f", 'copy.ninja'], { cwd: lib_dir, stdio: [0, 1, 2] }) } @@ -270,7 +304,7 @@ function provideCompiler() { var releaseNinja = ` ocamlopt = ocamlopt.opt ext = .exe -INCL= ${ocamlVersion.includes('4.02') ? '4.02.3+BS' : '4.06.1+BS'} +INCL= ${require('./buildocaml.js').getVersionPrefix()} include body.ninja ` fs.writeFileSync(path.join(lib_dir,'release.ninja'),releaseNinja,'ascii') diff --git a/scripts/ninja.js b/scripts/ninja.js index aa0a4cd787..8c2bde203f 100755 --- a/scripts/ninja.js +++ b/scripts/ninja.js @@ -75,7 +75,7 @@ var getOcamldepFile = ()=>{ if(useEnv){ return `ocamldep.opt` } else{ - return path.join(__dirname,'..','native','bin','ocamldep.opt') + return path.join(__dirname,'..','native',require('./buildocaml.js').getVersionPrefix(), 'bin','ocamldep.opt') } } @@ -1067,7 +1067,7 @@ function updateRelease(){ function updateDev(){ if(useEnv){ writeFile(path.join(jscompDir,'env.ninja'),` -include envConfig.ninja +${getEnnvConfigNinja()} stdlib = ${version6() ? `stdlib-406` : `stdlib-402`} subninja compilerEnv.ninja subninja runtime/env.ninja @@ -1078,9 +1078,9 @@ build all: phony runtime others $stdlib test `) } else { writeFile(path.join(jscompDir, 'build.ninja'), ` -include vendorConfig.ninja +${getVendorConfigNinja()} stdlib = ${version6() ? `stdlib-406` : `stdlib-402`} -snapshot_path = ${version6()? '4.06.1+BS' : '4.02.3+BS'} +snapshot_path = ${require('./buildocaml.js').getVersionPrefix()} subninja compiler.ninja subninja snapshot.ninja subninja runtime/build.ninja @@ -1137,6 +1137,24 @@ function setSortedToString(xs){ return arr.join(' ') } +/** + * @returns {string} + */ +function getVendorConfigNinja(){ + var prefix = `../native/${require('./buildocaml.js').getVersionPrefix()}/bin` + return ` +ocamlopt = ${prefix}/ocamlopt.opt +ocamllex = ${prefix}/ocamllex.opt +ocamlmklib = ${prefix}/ocamlmklib +` +} +function getEnnvConfigNinja(){ + return ` +ocamlopt = ocamlopt.opt +ocamllex = ocamllex.opt +ocamlmklib = ocamlmklib +` +} /** * Note don't run `ninja -t clean -g` * Since it will remove generated ml file which has @@ -1147,7 +1165,7 @@ function nativeNinja() { var sourceDirs = ['stubs', 'ext', 'common', 'syntax', 'depends', 'core', 'super_errors', 'outcome_printer', 'bsb', 'ounit', 'ounit_tests', 'main'] var includes = sourceDirs.map(x => `-I ${x}`).join(' ') var cppoNative = ` -include ${useEnv ? 'envConfig.ninja' : 'vendorConfig.ninja'} +${useEnv ? getEnnvConfigNinja() : getVendorConfigNinja()} rule link command = $ocamlopt -g -I +compiler-libs $flags $libs $in -o $out build ${cppoFile}: link ${cppoMonoFile} diff --git a/scripts/prebuilt.js b/scripts/prebuilt.js index 0b69069f64..4ef38dfb24 100644 --- a/scripts/prebuilt.js +++ b/scripts/prebuilt.js @@ -8,14 +8,14 @@ var root_config = { cwd: root, stdio: [0, 1, 2] } process.env.BS_RELEASE_BUILD = 'true' -var version = require('./vendored_ocaml_version.js').getVersionPrefix() +var version = require('./buildocaml.js').getVersionPrefix() var fs = require('fs') function buildCompiler() { var prebuilt = 'prebuilt.ninja' var content = ` -ocamlopt = ../native/bin/ocamlopt.opt +ocamlopt = ../native/${version}/bin/ocamlopt.opt ext = ${sys_extension} -INCL = ${version.includes('4.06') ? '4.06.1+BS' : '4.02.3+BS'} +INCL = ${version} include body.ninja ` fs.writeFileSync(path.join(root,'lib',prebuilt),content,'ascii') diff --git a/scripts/test.go b/scripts/test.go deleted file mode 100644 index 5baee7657f..0000000000 --- a/scripts/test.go +++ /dev/null @@ -1,207 +0,0 @@ -package main - -import ( - "path" - "flag" - "fmt" - "io/ioutil" - "log" - "os" - "os/exec" - "path/filepath" - "sync" - "time" - "runtime" -) - - - -func checkError(err error, theme ...string) { - if err != nil { - log.Fatalf("Error in theme:%v\n====\n%s\n====\n", theme, err.Error()) - } -} - -func testTheme(theme string) { - fmt.Println("Removing", theme) - os.RemoveAll(theme) - cmd := exec.Command("bsb", "-theme", theme, "-init", theme) - output, err := cmd.CombinedOutput() - - fmt.Println(string(output)) - checkError(err, theme) - - fmt.Println("Start to install", theme) - cmd = exec.Command("npm", "install") - cmd.Dir = theme - output, err = cmd.CombinedOutput() - fmt.Println(string(output)) - checkError(err, theme) - - fmt.Println("Started to build ", theme) - cmd2 := exec.Command("npm", "run", "build") - cmd2.Dir = theme - output2, err := cmd2.CombinedOutput() - fmt.Println(string(output2)) - checkError(err, theme) - - os.RemoveAll(theme) - fmt.Println("Finish building", theme) -} - - -var ninja string - - -var cmd = exec.Command - -func checkFileExist(f string) bool{ - if _, err := os.Stat(f); os.IsNotExist(err){ - return false - } - return true -} -// Avoid rebuilding OCaml again -func init() { - vendorOCamlPath, _ := filepath.Abs(filepath.Join(".", "native", "bin")) - os.Setenv("PATH", - vendorOCamlPath+string(os.PathListSeparator)+os.Getenv("PATH")) - var extension string - - if runtime.GOOS == "linux" { - extension = "linux" - } else if runtime.GOOS == "darwin" { - extension = "darwin" - } else { - log.Fatalf("not supported platform for testing") - } - vendored :=filepath.Join("vendor","ninja", "snapshot", "ninja."+extension) - if checkFileExist(vendored){ - ninja = vendored - } else if new:= filepath.Join("lib","ninja.exe"); checkFileExist(new) { - ninja = new - } else { - fmt.Println("ninja could not be configured") - os.Exit(2) - - } -} - -func bsbInDir(builddir, dir string) { - script:= "input.js" - destDir := filepath.Join(builddir, dir) - - if !checkFileExist(path.Join(destDir,script)){ - fmt.Println("Warn:", dir, "does not have input.js") - return - } - c := cmd("node", script) - c.Dir = destDir - out, err := c.CombinedOutput() - - if err != nil { - fmt.Println("failed in ", dir) - outS := string(out) - fmt.Println(outS) - fmt.Println(err) - os.Exit(2) - } - fmt.Println(string(out)) - fmt.Println("success in ", dir) - -} - -func main() { - installGlobal := flag.Bool("install-global", false, "don't install global") - ounitTest := flag.Bool("ounit", false, "don't do ounit test") - mochaTest := flag.Bool("mocha", false, "don't run mocha") - themeTest := flag.Bool("theme", false, "no bsb theme test") - bsbTest := flag.Bool("bsb", false, "no bsb test") - all := flag.Bool("all",false,"test all") - // disableAll := flag.Bool("disable-all", false, "disable all tets") - flag.Parse() - if *all { - *installGlobal = true - *ounitTest = true - *mochaTest = true - *themeTest = true - *bsbTest = true - } - output, _ := cmd("which", "ocaml").CombinedOutput() - fmt.Println("OCaml:", string(output)) - if *ounitTest { - btest := cmd("make", "-C", "jscomp/bin", "test") - btest.Stdout = os.Stdout - btest.Stderr = os.Stderr - berror := btest.Run() - if berror != nil { - os.Exit(2) - } - } - if *mochaTest { - - make := cmd("sh", "-c", "mocha jscomp/test/**/*test.js") - make.Stdout = os.Stdout - make.Stderr = os.Stderr - error := make.Run() - if error != nil { - fmt.Println(error) - os.Exit(2) - } - } - - if *installGlobal { - ginstall := cmd("npm", "i", "-g", ".") - fmt.Println("install bucklescript globally") - start := time.Now() - ginstall.Stdout = os.Stdout - ginstall.Stderr = os.Stderr - error := ginstall.Run() - if error != nil { - log.Fatalf("install failed") - } else { - - fmt.Println("install finished takes", time.Since(start)) - } - bsbDir, _ := cmd("bsb", "-where").CombinedOutput() - fmt.Println("BSBDIR:", string(bsbDir)) - } - - if *themeTest { - var wg sync.WaitGroup - for _, theme := range []string{ - "basic", - "basic-reason", - "generator", - "minimal", - "node", - "react", - } { - fmt.Println("Test theme", theme) - wg.Add(1) - go (func(theme string) { - defer wg.Done() - testTheme(theme) - })(theme) - } - wg.Wait() - } - if *bsbTest { - var wg sync.WaitGroup - buildTestDir := filepath.Join("jscomp", "build_tests") - files, err := ioutil.ReadDir(buildTestDir) - checkError(err) - - for _, file := range files { - file := file - wg.Add(1) - if file.IsDir() { - go func(){ - defer wg.Done() - bsbInDir(buildTestDir, file.Name()) - }() - } - } - wg.Wait() - } -} diff --git a/scripts/vendored_ocaml_version.js b/scripts/vendored_ocaml_version.js deleted file mode 100644 index 65978ba43d..0000000000 --- a/scripts/vendored_ocaml_version.js +++ /dev/null @@ -1,15 +0,0 @@ -//@ts-check -var fs = require('fs') -var path = require('path') - - -// FIXME: this works in CI, but for release build, submodule -// is carried, so it needs to be fixed -/** - * @returns{string} - */ -function getVersionPrefix(){ - var version = fs.readFileSync(path.join(__dirname, '..', 'ocaml', 'VERSION'), 'ascii') - return version.substr(0, version.indexOf('+')) -} -exports.getVersionPrefix = getVersionPrefix \ No newline at end of file