diff --git a/.gitignore b/.gitignore index 2554eaa1b4..84d9d9b1de 100644 --- a/.gitignore +++ b/.gitignore @@ -55,5 +55,6 @@ osc jscomp/pre_load.js boot *.dump + coverage -*.log \ No newline at end of file +*.log diff --git a/jscomp/config_util.ml b/jscomp/config_util.ml index d08c69d558..48fd88e01c 100644 --- a/jscomp/config_util.ml +++ b/jscomp/config_util.ml @@ -37,14 +37,23 @@ let find_cmj file = Js_cmj_format.from_file f | exception Not_found -> (* TODO: add an logger module *) + let target = String.uncapitalize (Filename.basename file) in begin match - String_map.find (String.uncapitalize (Filename.basename file)) + String_map.find target Js_cmj_datasets.cmj_data_sets with | v - -> Lazy.force v + -> + begin match Lazy.force v with + | exception _ + -> + Ext_log.warn __LOC__ + "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target (Lam_current_unit.get_file ()) ; + Js_cmj_format.no_pure_dummy; (* FIXME *) + | v -> v + end | exception Not_found -> Ext_log.warn __LOC__ "@[%s not found @]" file ; - Js_cmj_format.dummy (); (* FIXME *) + Js_cmj_format.no_pure_dummy (* FIXME *) end end diff --git a/jscomp/js_cmj_format.ml b/jscomp/js_cmj_format.ml index d005c7aed5..6a8e3542d9 100644 --- a/jscomp/js_cmj_format.ml +++ b/jscomp/js_cmj_format.ml @@ -31,14 +31,52 @@ type effect = string option type cmj_table = { values : cmj_value String_map.t; - pure : effect; + effect : effect; + goog_package : string option; } -let dummy ?(pure=Some "dummy") () = - { values = String_map.empty ; pure } +let cmj_magic_number = "BUCKLE20160310" +let cmj_magic_number_length = + String.length cmj_magic_number -let from_file name : cmj_table = Ext_marshal.from_file name +let pure_dummy = + { + values = String_map.empty; + effect = None; + goog_package = None + } -let from_string s : cmj_table = Marshal.from_string s 0 +let no_pure_dummy = + { + values = String_map.empty; + effect = (Some ""); + goog_package = None + } -let to_file name v = Ext_marshal.to_file name v + + +let from_file name : cmj_table = + let ic = open_in_bin name in + let buffer = really_input_string ic cmj_magic_number_length in + if buffer <> cmj_magic_number then + failwith + ("cmj files have incompatible versions, please rebuilt using the new compiler : " + ^ __LOC__) + else + (input_value ic : cmj_table) + + +let from_string s : cmj_table = + let magic_number = String.sub s 0 cmj_magic_number_length in + if magic_number = cmj_magic_number then + Marshal.from_string s cmj_magic_number_length + else + failwith + ("cmj files have incompatible versions, please rebuilt using the new compiler : " + ^ __LOC__) + +let to_file name (v : cmj_table) = + let oc = open_out_bin name in + output_string oc cmj_magic_number; + output_value oc v; + close_out oc diff --git a/jscomp/js_cmj_format.mli b/jscomp/js_cmj_format.mli index 1cd6eb168e..5608675e26 100644 --- a/jscomp/js_cmj_format.mli +++ b/jscomp/js_cmj_format.mli @@ -53,10 +53,13 @@ type effect = string option type cmj_table = { values : cmj_value String_map.t; - pure : effect + effect : effect; + goog_package : string option } -val dummy : ?pure:string option -> unit -> cmj_table +val pure_dummy : cmj_table +val no_pure_dummy : cmj_table + val from_file : string -> cmj_table val from_string : string -> cmj_table diff --git a/jscomp/js_config.ml b/jscomp/js_config.ml index d7dc158be8..7d62b1c90a 100644 --- a/jscomp/js_config.ml +++ b/jscomp/js_config.ml @@ -22,14 +22,36 @@ type env = | Browser | NodeJS - + | Goog of string option let default_env = ref NodeJS let get_env () = !default_env let set_env env = default_env := env - +let cmd_set_module str = + match str with + | "commonjs" -> default_env := NodeJS + | "amdjs" -> + default_env := Browser + | _ -> + if Ext_string.starts_with str "goog" then + let len = String.length str in + if len = 4 then + default_env := Goog (Some "") + else + if str.[4] = ':' && len > 5 then + default_env := Goog (Some (Ext_string.tail_from str 5 )) + else + raise (Arg.Bad (Printf.sprintf "invalid module system %s" str)) + else + raise (Arg.Bad (Printf.sprintf "invalid module system %s" str)) + +let get_goog_package_name () = + match !default_env with + | Goog x -> x + | Browser | NodeJS -> None + let stdlib_set = String_set.of_list [ "arg"; "gc"; @@ -133,3 +155,5 @@ let internalMod = "Caml_internalMod" let bigarray = "Caml_bigarray" let unix = "Caml_unix" let int64 = "Caml_int64" + + diff --git a/jscomp/js_config.mli b/jscomp/js_config.mli index 6031df2d21..06a97c3bbf 100644 --- a/jscomp/js_config.mli +++ b/jscomp/js_config.mli @@ -21,12 +21,12 @@ type env = | Browser | NodeJS - + | Goog of string option val get_env : unit -> env - +val get_goog_package_name : unit -> string option val set_env : env -> unit - +val cmd_set_module : string -> unit val runtime_set : String_set.t val stdlib_set : String_set.t diff --git a/jscomp/js_dump.ml b/jscomp/js_dump.ml index 00504f2566..6c5506a6ef 100644 --- a/jscomp/js_dump.ml +++ b/jscomp/js_dump.ml @@ -61,6 +61,10 @@ module L = struct let return = "return" let eq = "=" let require = "require" + let goog_require = "goog.require" + let goog_module = "goog.module" + let lparen = "(" + let rparen = ")" let exports = "exports" let dot = "." let comma = "," @@ -1425,7 +1429,7 @@ let exports cxt f (idents : Ident.t list) = (* Node style *) -let requires cxt f (modules : (Ident.t * string) list ) = +let requires require_lit cxt f (modules : (Ident.t * string) list ) = P.newline f ; (* the context used to print the following program *) let outer_cxt, reversed_list, margin = @@ -1443,7 +1447,7 @@ let requires cxt f (modules : (Ident.t * string) list ) = P.nspace f (margin - String.length s + 1) ; P.string f L.eq; P.space f; - P.string f L.require; + P.string f require_lit; P.paren_group f 0 @@ (fun _ -> pp_string f ~utf:true ~quote:(best_string_quote s) file ); semi f ; @@ -1457,8 +1461,18 @@ let program f cxt ( x : J.program ) = let () = P.force_newline f in exports cxt f x.exports +let goog_program f goog_package x = + P.newline f ; + P.string f L.goog_module; + P.string f "("; + P.string f (Printf.sprintf "%S" goog_package); + P.string f ")"; + semi f ; + let cxt = requires L.goog_require ( Ext_pp_scope.empty) f x.J.modules in + program f cxt x.program + let node_program f ( x : J.deps_program) = - let cxt = requires ( Ext_pp_scope.empty) f x.modules in + let cxt = requires L.require ( Ext_pp_scope.empty) f x.modules in program f cxt x.program @@ -1515,7 +1529,18 @@ let pp_deps_program ( program : J.deps_program) (f : Ext_pp.t) = node_program f program (* amd_program f program *) | _ -> amd_program f program - end ) ; + end + | Goog opt -> + let goog_package = + let v = Lam_current_unit.get_module_name () in + match opt with + | None + | Some "" + -> v + | Some x -> x ^ "." ^ v + in + goog_program f goog_package program + ) ; P.newline f ; P.string f ( match program.side_effect with diff --git a/jscomp/js_main.ml b/jscomp/js_main.ml index 3b44fa96fe..c2b99cadc6 100644 --- a/jscomp/js_main.ml +++ b/jscomp/js_main.ml @@ -144,10 +144,16 @@ module Options = Main_args.Make_bytecomp_options (struct let anonymous = anonymous end) + +let buckle_script_flags = + ("-js-module", Arg.String Js_config.cmd_set_module, + " set module system: commonjs (default), amdjs, google:package_name") + :: Options.list + let main () = try readenv ppf Before_args; - Arg.parse Options.list anonymous usage; + Arg.parse buckle_script_flags anonymous usage; readenv ppf Before_link; if List.length (List.filter (fun x -> !x) diff --git a/jscomp/js_program_loader.ml b/jscomp/js_program_loader.ml index f0f86936d6..76464679c3 100644 --- a/jscomp/js_program_loader.ml +++ b/jscomp/js_program_loader.ml @@ -23,61 +23,72 @@ module E = Js_exp_make module S = Js_stmt_make -type module_id = Lam_module_ident.t + open Js_output.Ops -let string_of_module_id (x : module_id) : string = +let string_of_module_id (x : Lam_module_ident.t) : string = match x.kind with | Runtime | Ml -> let id = x.id in let file = Printf.sprintf "%s.js" id.name in begin match Js_config.get_env () with - | Browser - (* In browser *) - -> - let target = String.uncapitalize file in - if String_set.mem target Js_config.runtime_set then - "./runtime/" ^ Filename.chop_extension target - else - "./stdlib/" ^ Filename.chop_extension target - | NodeJS -> - if Ext_string.starts_with id.name "Caml_" then - let path = - (* For the runtime, only [JS] files are needed, and - unlike the stdlib, [osc] have some pre-built knowledge - about where it is, since in general, [runtime] - is *transparent* to the user - *) - match Sys.getenv "OCAML_JS_RUNTIME_PATH" with - | exception Not_found -> - Filename.concat - (Filename.dirname (Filename.dirname Sys.executable_name)) - "runtime" - | f -> f in - Ext_filename.node_relative_path !Location.input_name - (Filename.concat path (String.uncapitalize id.name)) - else - begin match Config_util.find file with - (* for some primitive files, no cmj support *) - | exception Not_found -> - Ext_log.warn __LOC__ "@[%s not found in search path - while compiling %s @] " - file !Location.input_name ; - Printf.sprintf "%s" - (String.uncapitalize id.name) - (* maybe from third party library*) - (* Check: be consistent when generating js files - A.ml -> a.js - a.ml -> a.js - check generated [js] file if it's capital or not - Actually, we can not tell its original name just from [id], - so we just always general litte_case.js - *) - | path -> - Ext_filename.node_relative_path !Location.input_name path - - end + | Goog _ -> + (*TODO: we should store + the goog module name in the [cmj] file + *) + let base = String.uncapitalize id.name in + begin match Lam_compile_env.get_goog_package_name x with + | None + | Some "" -> + base + | Some v -> v ^ "." ^ base + end + | Browser + (* In browser *) + -> + let target = String.uncapitalize file in + if String_set.mem target Js_config.runtime_set then + "./runtime/" ^ Filename.chop_extension target + else + "./stdlib/" ^ Filename.chop_extension target + | NodeJS -> + if Ext_string.starts_with id.name "Caml_" then + let path = + (* For the runtime, only [JS] files are needed, and + unlike the stdlib, [osc] have some pre-built knowledge + about where it is, since in general, [runtime] + is *transparent* to the user + *) + match Sys.getenv "OCAML_JS_RUNTIME_PATH" with + | exception Not_found -> + Filename.concat + (Filename.dirname (Filename.dirname Sys.executable_name)) + "runtime" + | f -> f in + Ext_filename.node_relative_path !Location.input_name + (Filename.concat path (String.uncapitalize id.name)) + else + begin match Config_util.find file with + (* for some primitive files, no cmj support *) + | exception Not_found -> + Ext_log.warn __LOC__ "@[%s not found in search path - while compiling %s @] " + file !Location.input_name ; + Printf.sprintf "%s" + (String.uncapitalize id.name) + (* maybe from third party library*) + (* Check: be consistent when generating js files + A.ml -> a.js + a.ml -> a.js + check generated [js] file if it's capital or not + Actually, we can not tell its original name just from [id], + so we just always general litte_case.js + *) + | path -> + Ext_filename.node_relative_path !Location.input_name path + + end end | External name -> name diff --git a/jscomp/lam_compile_env.ml b/jscomp/lam_compile_env.ml index 40f06b6cb9..9bba671574 100644 --- a/jscomp/lam_compile_env.ml +++ b/jscomp/lam_compile_env.ml @@ -80,13 +80,13 @@ let add_js_module ?id module_name = Hashtbl.replace cached_tbl (Lam_module_ident.of_external id module_name) External; id -let find_cached_tbl = Hashtbl.find cached_tbl + let add_cached_tbl = Hashtbl.add cached_tbl let find_and_add_if_not_exist (id, pos) env ~not_found ~found = let oid = Lam_module_ident.of_ml id in - begin match find_cached_tbl oid with + begin match Hashtbl.find cached_tbl oid with | exception Not_found -> let cmj_table = Config_util.find_cmj (id.name ^ ".cmj") in begin match @@ -131,48 +131,89 @@ let find_and_add_if_not_exist (id, pos) env ~not_found ~found = (* TODO: it does not make sense to cache [Runtime] and [externals]*) +type _ t = + | No_env : Js_cmj_format.cmj_table t + | Has_env : Env.t -> module_info t + -let query_and_add_if_not_exist (oid : Lam_module_ident.t) env ~not_found ~found = - match find_cached_tbl oid with +let query_and_add_if_not_exist (type u) + (oid : Lam_module_ident.t) + (env : u t) ~not_found ~found:(found : u -> _) = + match Hashtbl.find cached_tbl oid with | exception Not_found -> begin match oid.kind with | Runtime -> add_cached_tbl oid (Runtime true) ; - found {signature = []; pure = true} - + begin match env with + | Has_env _ -> + found {signature = []; pure = true} + | No_env -> + found (Js_cmj_format.pure_dummy) + end | External _ -> add_cached_tbl oid External; (** This might be wrong, if we happen to expand an js module we should assert false (but this in general should not happen) *) - found {signature = []; pure = false} + begin match env with + | Has_env _ + -> + found {signature = []; pure = false} + | No_env -> + found (Js_cmj_format.no_pure_dummy) + end | Ml -> let cmj_table = Config_util.find_cmj (Lam_module_ident.name oid ^ ".cmj") in - begin - match Type_util.find_serializable_signatures_by_path (Pident oid.id) env with - | None -> not_found () (* actually when [not_found] in the call site, we throw... *) - | Some signature -> - add_cached_tbl oid (Visit {signatures = signature; cmj_table }) ; - found { signature ; pure = cmj_table.pure = None} + begin match env with + | Has_env env -> + begin match + Type_util.find_serializable_signatures_by_path (Pident oid.id) env with + | None -> not_found () (* actually when [not_found] in the call site, we throw... *) + | Some signature -> + add_cached_tbl oid (Visit {signatures = signature; cmj_table }) ; + found { signature ; pure = cmj_table.effect = None} + end + | No_env -> + found cmj_table end end - | Visit {signatures ; cmj_table = {pure; _}; _} -> - found { signature = signatures ; pure = (pure = None)} + | Visit {signatures ; cmj_table = cmj_table; _} -> + begin match env with + | Has_env _ -> + found { signature = signatures ; pure = (cmj_table.effect = None)} + | No_env -> found cmj_table + end | Runtime pure -> - found {signature = [] ; pure } - + begin match env with + | Has_env _ -> + found {signature = [] ; pure } + | No_env -> + found (if pure then Js_cmj_format.pure_dummy + else Js_cmj_format.no_pure_dummy + ) + end | External -> - found {signature = [] ; pure = false} + begin match env with + | Has_env _ -> + found {signature = [] ; pure = false} + | No_env -> found Js_cmj_format.no_pure_dummy + end (* Conservative interface *) -let is_pure id env = - query_and_add_if_not_exist id env +let is_pure id = + query_and_add_if_not_exist id No_env ~not_found:(fun _ -> false) - ~found:(fun x -> x.pure) + ~found:(fun x -> x.effect = None) + +let get_goog_package_name id = + query_and_add_if_not_exist id No_env + ~not_found:(fun _ -> None) + ~found:(fun x -> x.goog_package) + (* TODO: [env] is not hard dependency *) @@ -180,7 +221,7 @@ let get_requried_modules env (extras : module_id list ) (hard_dependencies : _ Hash_set.hashset) : module_id list = let mem (x : Lam_module_ident.t) = - not (is_pure x env ) || Hash_set.mem hard_dependencies x + not (is_pure x ) || Hash_set.mem hard_dependencies x in Hashtbl.iter (fun (id : module_id) _ -> if mem id diff --git a/jscomp/lam_compile_env.mli b/jscomp/lam_compile_env.mli index 396ec0bf2e..46ddab1f56 100644 --- a/jscomp/lam_compile_env.mli +++ b/jscomp/lam_compile_env.mli @@ -47,6 +47,10 @@ type module_info = { pure : bool } +type _ t = + | No_env : Js_cmj_format.cmj_table t + | Has_env : Env.t -> module_info t + val find_and_add_if_not_exist : Ident.t * int -> Env.t -> @@ -54,10 +58,9 @@ val find_and_add_if_not_exist : found:(ident_info -> 'a) -> 'a val query_and_add_if_not_exist : - Lam_module_ident.t -> - Env.t -> - not_found:(unit -> 'a) -> - found:( module_info -> 'a) -> 'a + Lam_module_ident.t -> + 'a t -> not_found:(unit -> 'b) -> + found:('a -> 'b) -> 'b val add_js_module : ?id:Ident.t -> string -> Ident.t (** add third party dependency *) @@ -78,8 +81,8 @@ val add_js_module : ?id:Ident.t -> string -> Ident.t val reset : unit -> unit -val is_pure : Lam_module_ident.t -> Env.t -> bool - +val is_pure : Lam_module_ident.t -> bool +val get_goog_package_name : Lam_module_ident.t -> string option (* The second argument is mostly from [runtime] modules will change the input [hard_dependencies] *) diff --git a/jscomp/lam_compile_global.ml b/jscomp/lam_compile_global.ml index f666abbdc0..3aba5625d6 100644 --- a/jscomp/lam_compile_global.ml +++ b/jscomp/lam_compile_global.ml @@ -30,7 +30,8 @@ open Js_output.Ops *) let query_lambda id env = - Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) env + Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) + (Has_env env) ~not_found:(fun id -> assert false) ~found:(fun {signature = sigs; _} -> (* TODO: add module into taginfo*) @@ -49,7 +50,9 @@ let get_exp (key : Lam_compile_env.key) : J.expression = if Ident.is_predef_exn id then Js_of_lam_exception.get_builtin_by_name id.name else - Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) env + Lam_compile_env.query_and_add_if_not_exist + (Lam_module_ident.of_ml id) + (Has_env env) ~not_found:(fun id -> assert false) ~found:(fun {signature = sigs; _} -> if expand diff --git a/jscomp/lam_compile_group.ml b/jscomp/lam_compile_group.ml index a328c79d1f..c701ca5487 100644 --- a/jscomp/lam_compile_group.ml +++ b/jscomp/lam_compile_group.ml @@ -371,7 +371,7 @@ let compile ~filename non_export env _sigs lam = (if not @@ Ext_string.is_empty filename then Js_cmj_format.to_file (Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".cmj") v); - Js_program_loader.decorate_deps required_modules v.pure js + Js_program_loader.decorate_deps required_modules v.effect js ) | _ -> raise Not_a_module end diff --git a/jscomp/lam_current_unit.ml b/jscomp/lam_current_unit.ml index acd38fc3e5..d9f4f90e90 100644 --- a/jscomp/lam_current_unit.ml +++ b/jscomp/lam_current_unit.ml @@ -24,6 +24,8 @@ let debug_file = ref "" let set_file f = file := f let get_file () = !file +let get_module_name () = + Filename.chop_extension (String.uncapitalize !file) let iset_debug_file _ = () let set_debug_file f = debug_file := f diff --git a/jscomp/lam_current_unit.mli b/jscomp/lam_current_unit.mli index 4fc04ba5b8..9faaa41a88 100644 --- a/jscomp/lam_current_unit.mli +++ b/jscomp/lam_current_unit.mli @@ -20,6 +20,7 @@ val set_file : string -> unit val get_file : unit -> string +val get_module_name : unit -> string val iset_debug_file : string -> unit val set_debug_file : string -> unit diff --git a/jscomp/lam_pass_remove_alias.ml b/jscomp/lam_pass_remove_alias.ml index 939580de14..a8cbcc7725 100644 --- a/jscomp/lam_pass_remove_alias.ml +++ b/jscomp/lam_pass_remove_alias.ml @@ -249,7 +249,7 @@ let simplify_alias | Ltrywith (l1, v, l2) -> Ltrywith(simpl l1,v, simpl l2) | Lsequence (Lprim (Pgetglobal (id),[]), l2) - when Lam_compile_env.is_pure (Lam_module_ident.of_ml id) meta.env + when Lam_compile_env.is_pure (Lam_module_ident.of_ml id) -> simpl l2 | Lsequence(l1, l2) -> Lsequence (simpl l1, simpl l2) | Lwhile(l1, l2) -> Lwhile (simpl l1, simpl l2) diff --git a/jscomp/lam_stats_export.ml b/jscomp/lam_stats_export.ml index 1e81f0db20..5255f48c62 100644 --- a/jscomp/lam_stats_export.ml +++ b/jscomp/lam_stats_export.ml @@ -127,22 +127,23 @@ let export_to_cmj let () = if not @@ Ext_string.is_empty meta.filename then - Ext_pervasives.with_file_as_pp + Ext_pervasives.with_file_as_pp (Ext_filename.chop_extension ~loc:__LOC__ meta.filename ^ ".d.ts") - @@ fun fmt -> + @@ fun fmt -> pp fmt "@[%a@]@." dump meta.exports in - let pure = + let effect = match maybe_pure with | None -> Ext_option.bind ( Ext_list.for_all_ret (fun (id : Lam_module_ident.t) -> - Lam_compile_env.query_and_add_if_not_exist id meta.env + Lam_compile_env.query_and_add_if_not_exist id + (Has_env meta.env ) ~not_found:(fun _ -> false ) ~found:(fun i -> i.pure) ) external_ids) (fun x -> Lam_module_ident.name x) | Some _ -> maybe_pure in - {values; pure } + {values; effect ; goog_package = Js_config.get_goog_package_name ()} diff --git a/jscomp/runtime/Makefile b/jscomp/runtime/Makefile index 2f7595d4b1..e889bcafd7 100644 --- a/jscomp/runtime/Makefile +++ b/jscomp/runtime/Makefile @@ -5,7 +5,8 @@ CAMLC=../bin/osc SOURCE_LIST := $(shell cat runtime.mllib) RUNTIME := $(addsuffix .cmj, $(SOURCE_LIST)) -COMPFLAGS := -w -40 -safe-string +COMPFLAGS := -w -40 -safe-string +# -js-module goog:buckle $(RUNTIME): $(CAMLC) diff --git a/jscomp/runtime/caml_bigarray.ml b/jscomp/runtime/caml_bigarray.ml index 1f85bae00a..a1bfe90fd7 100644 --- a/jscomp/runtime/caml_bigarray.ml +++ b/jscomp/runtime/caml_bigarray.ml @@ -694,4 +694,4 @@ let caml_ba_map_file_bytecode : Unix.file_descr -> ('a, 'b) Bigarray.kind -> 'c Bigarray.layout -> bool -> int array -> int64 -> ('a, 'b, 'c) Bigarray.Genarray.t = - function _ -> failwith "caml_ba_map_file_bytecode not implemented" + function _ -> raise @@ Failure "caml_ba_map_file_bytecode not implemented" diff --git a/jscomp/runtime/caml_format.ml b/jscomp/runtime/caml_format.ml index 087923eb30..27ef16aeb9 100644 --- a/jscomp/runtime/caml_format.ml +++ b/jscomp/runtime/caml_format.ml @@ -69,7 +69,7 @@ let caml_int_of_string s = let d = to_nat @@ parse_digit c in let () = if d < 0n || d >= base then - failwith "int_of_string" in + caml_failwith "int_of_string" in (* let () = [%js.debug] in *) let rec aux acc k = if k = len then acc @@ -79,17 +79,17 @@ let caml_int_of_string s = else let v = to_nat @@ parse_digit a in if v < 0n || v >= base then - failwith "int_of_string" + caml_failwith "int_of_string" else let acc = base *~ acc +~ v in if acc > threshold then - failwith "int_of_string" + caml_failwith "int_of_string" else aux acc ( k + 1) in let res = sign *~ aux d (i + 1) in let or_res = Nativeint.logor res 0n in (if base = 10n && res != or_res then - failwith "int_of_string"); + caml_failwith "int_of_string"); or_res [%%bb.unsafe{| diff --git a/jscomp/runtime/caml_int64.ml b/jscomp/runtime/caml_int64.ml index cd1079627a..2a9b88623a 100644 --- a/jscomp/runtime/caml_int64.ml +++ b/jscomp/runtime/caml_int64.ml @@ -31,6 +31,7 @@ let (+) = Nativeint.add let ( * ) = Nativeint.mul let ( & ) = Nativeint.logand let ( << ) = Nativeint.shift_left +let lognot x = Nativeint.logxor x (-1n) type t = { lo : nativeint ; hi : nativeint} diff --git a/jscomp/runtime/caml_io.ml b/jscomp/runtime/caml_io.ml index 60b7f846fa..1f1a780d2b 100644 --- a/jscomp/runtime/caml_io.ml +++ b/jscomp/runtime/caml_io.ml @@ -26,21 +26,21 @@ let stdout = undef let stderr = undef let caml_ml_open_descriptor_in (i : int) : in_channel = - failwith "caml_ml_open_descriptor_in not implemented" + raise (Failure "caml_ml_open_descriptor_in not implemented") let caml_ml_open_descriptor_out (i : int) : out_channel = - failwith "caml_ml_open_descriptor_out not implemented" + raise (Failure "caml_ml_open_descriptor_out not implemented") let caml_ml_output_char (oc : out_channel) (char : char) = - failwith "caml_ml_output_char not implemented" + raise (Failure "caml_ml_output_char not implemented" ) (** note we need provide both [bytes] and [string] version *) let caml_ml_output (oc : out_channel) (bytes : bytes) offset len = - failwith "caml_ml_output not implemented" + raise @@ Failure "caml_ml_output not implemented" let caml_ml_input (ic : in_channel) (bytes : bytes) offset len : int = - failwith "caml_ml_input ic not implemented" + raise @@ Failure "caml_ml_input ic not implemented" let caml_ml_input_char (ic : in_channel) : char = - failwith "caml_ml_input_char not implemnted" + raise @@ Failure "caml_ml_input_char not implemnted" let caml_ml_out_channels_list () : out_channel list = assert false diff --git a/jscomp/runtime/caml_primitive.ml b/jscomp/runtime/caml_primitive.ml index dd43fff55e..5561a8095d 100644 --- a/jscomp/runtime/caml_primitive.ml +++ b/jscomp/runtime/caml_primitive.ml @@ -68,12 +68,14 @@ function $$caml_hash(count, limit, seed, o) { |}] -external caml_hash : int -> int -> int -> 'a -> int = "" -[@@js.call "$$caml_hash"] [@@js.local] +external caml_hash : int -> int -> int -> 'a -> int = "$$caml_hash" + [@@js.call ] [@@js.local] let caml_nativeint_bswap = caml_int32_bswap let caml_sys_getcwd () = "/" -let caml_convert_raw_backtrace_slot : Printexc.raw_backtrace_slot -> Printexc. backtrace_slot = - function _ -> failwith "caml_convert_raw_backtrace_slot unimplemented" +let caml_convert_raw_backtrace_slot : Printexc.raw_backtrace_slot -> Printexc. backtrace_slot + = + function _ -> + raise @@ Failure "caml_convert_raw_backtrace_slot unimplemented" diff --git a/jscomp/stdlib/Makefile.shared b/jscomp/stdlib/Makefile.shared index 8f3fe484ed..5e0b417c38 100755 --- a/jscomp/stdlib/Makefile.shared +++ b/jscomp/stdlib/Makefile.shared @@ -22,7 +22,8 @@ CAMLC=$(CAMLRUN) $(COMPILER) #COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib \ # -safe-string COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -nostdlib \ - -safe-string + -safe-string +# -js-module goog # OPTCOMPILER=ocamlopt.opt # CAMLOPT=$(CAMLRUN) $(OPTCOMPILER) diff --git a/jscomp/test/.depend b/jscomp/test/.depend index 007ecaa971..f02b8128dc 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -168,8 +168,8 @@ js_date_test.cmo : mt.cmi ../lib/js_date.cmo js_date_test.cmx : mt.cmx ../lib/js_date.cmx js_obj_test.cmo : mt.cmi js_obj_test.cmx : mt.cmx -lam_current_unit.cmo : -lam_current_unit.cmx : +lam_current_unit.cmo : ../stdlib/string.cmi ../stdlib/filename.cmi +lam_current_unit.cmx : ../stdlib/string.cmx ../stdlib/filename.cmx lam_methname.cmo : ../stdlib/string.cmi ../stdlib/list.cmi \ lam_current_unit.cmo ext_string.cmo ext_log.cmo lam_methname.cmx : ../stdlib/string.cmx ../stdlib/list.cmx \ @@ -324,8 +324,8 @@ test_generative_module.cmo : test_generative_module.cmx : test_global_print.cmo : ../stdlib/list.cmi ../stdlib/hashtbl.cmi test_global_print.cmx : ../stdlib/list.cmx ../stdlib/hashtbl.cmx -test_google_closure.cmo : ../stdlib/array.cmi -test_google_closure.cmx : ../stdlib/array.cmx +test_google_closure.cmo : ../lib/js.cmi ../stdlib/array.cmi +test_google_closure.cmx : ../lib/js.cmx ../stdlib/array.cmx test_include.cmo : test_order.cmo ../stdlib/string.cmi ../stdlib/set.cmi \ ../stdlib/list.cmi test_include.cmx : test_order.cmx ../stdlib/string.cmx ../stdlib/set.cmx \ @@ -618,8 +618,8 @@ js_date_test.cmo : mt.cmi ../lib/js_date.cmo js_date_test.cmj : mt.cmj ../lib/js_date.cmj js_obj_test.cmo : mt.cmi js_obj_test.cmj : mt.cmj -lam_current_unit.cmo : -lam_current_unit.cmj : +lam_current_unit.cmo : ../stdlib/string.cmi ../stdlib/filename.cmi +lam_current_unit.cmj : ../stdlib/string.cmj ../stdlib/filename.cmj lam_methname.cmo : ../stdlib/string.cmi ../stdlib/list.cmi \ lam_current_unit.cmo ext_string.cmo ext_log.cmo lam_methname.cmj : ../stdlib/string.cmj ../stdlib/list.cmj \ @@ -774,8 +774,8 @@ test_generative_module.cmo : test_generative_module.cmj : test_global_print.cmo : ../stdlib/list.cmi ../stdlib/hashtbl.cmi test_global_print.cmj : ../stdlib/list.cmj ../stdlib/hashtbl.cmj -test_google_closure.cmo : ../stdlib/array.cmi -test_google_closure.cmj : ../stdlib/array.cmj +test_google_closure.cmo : ../lib/js.cmi ../stdlib/array.cmi +test_google_closure.cmj : ../lib/js.cmj ../stdlib/array.cmj test_include.cmo : test_order.cmo ../stdlib/string.cmi ../stdlib/set.cmi \ ../stdlib/list.cmi test_include.cmj : test_order.cmj ../stdlib/string.cmj ../stdlib/set.cmj \ diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile index 0f73052317..91bb96abf1 100644 --- a/jscomp/test/Makefile +++ b/jscomp/test/Makefile @@ -2,12 +2,13 @@ include ../Makefile.shared CAMLC=../bin/osc -INCLUDES= -I ../stdlib -I ../runtime -I ../lib +INCLUDES= -I ../stdlib -I ../runtime -I ../lib SOURCE_LIST := $(shell cat test.mllib) TESTS := $(addsuffix .cmj, $(SOURCE_LIST) ) COMPFLAGS+= -safe-string -w -40 +# -js-module goog:buckle.test $(TESTS): $(CAMLC) diff --git a/jscomp/test/ext_log.js b/jscomp/test/ext_log.js index e6294b6e0d..ba719636a8 100644 --- a/jscomp/test/ext_log.js +++ b/jscomp/test/ext_log.js @@ -306,4 +306,4 @@ exports.iwarn = iwarn; exports.dwarn = dwarn; exports.info = info; exports.iinfo = iinfo; -/* Format Not a pure module */ +/* Lam_current_unit Not a pure module */ diff --git a/jscomp/test/lam_current_unit.d.ts b/jscomp/test/lam_current_unit.d.ts index 48156b999d..04004ca1e4 100644 --- a/jscomp/test/lam_current_unit.d.ts +++ b/jscomp/test/lam_current_unit.d.ts @@ -2,6 +2,7 @@ export var file: any ; export var debug_file: any ; export var set_file: (f : any) => any ; export var get_file: (param : any) => any ; +export var get_module_name: (param : any) => any ; export var iset_debug_file: (param : any) => any ; export var set_debug_file: (f : any) => any ; export var get_debug_file: (param : any) => any ; diff --git a/jscomp/test/lam_current_unit.js b/jscomp/test/lam_current_unit.js index f47be7d2d8..68e9e3e2e0 100644 --- a/jscomp/test/lam_current_unit.js +++ b/jscomp/test/lam_current_unit.js @@ -1,6 +1,8 @@ // Generated CODE, PLEASE EDIT WITH CARE 'use strict'; +var Filename = require("../stdlib/filename"); +var $$String = require("../stdlib/string"); var file = [""]; @@ -15,6 +17,10 @@ function get_file() { return file[0]; } +function get_module_name() { + return Filename.chop_extension($$String.uncapitalize(file[0])); +} + function iset_debug_file() { return /* () */0; } @@ -41,8 +47,9 @@ exports.file = file; exports.debug_file = debug_file; exports.set_file = set_file; exports.get_file = get_file; +exports.get_module_name = get_module_name; exports.iset_debug_file = iset_debug_file; exports.set_debug_file = set_debug_file; exports.get_debug_file = get_debug_file; exports.is_same_file = is_same_file; -/* No side effect */ +/* Filename Not a pure module */ diff --git a/jscomp/test/test_google_closure.js b/jscomp/test/test_google_closure.js index 10b008f9e5..dc227d879e 100644 --- a/jscomp/test/test_google_closure.js +++ b/jscomp/test/test_google_closure.js @@ -23,11 +23,17 @@ for(var i = 0; i<= 2; ++i){ var match_000 = "" + 3; -var a = match_000; +var c = arr; var b = 101; -var c = arr; +var a = match_000; + +console.log(/* tuple */[ + a, + b, + c + ]); exports.f = f; exports.f2 = f2; diff --git a/jscomp/test/test_google_closure.ml b/jscomp/test/test_google_closure.ml index 5de4479471..b35a26f9fc 100644 --- a/jscomp/test/test_google_closure.ml +++ b/jscomp/test/test_google_closure.ml @@ -15,3 +15,6 @@ let a, b , c = arr.(i)<- (f3 2); done; arr)) + + +let () = Js.log (a,b,c) diff --git a/package.json b/package.json index 780410d8e7..f5f24ea57d 100644 --- a/package.json +++ b/package.json @@ -4,6 +4,7 @@ "babel-cli": "^6.3.17", "benchmark": "^2.1.0", "istanbul": "^0.4.2", + "google-closure-compiler": "^20160208.5.0", "karma": "^0.13.9", "karma-jasmine-html-reporter": "^0.1.8", "lodash": "^3.10.1",