add goog module support, -js-module goog:, add magic number

Author: Hongbo Zhang

.gitignore

@@ -55,5 +55,6 @@ osc
 jscomp/pre_load.js
 boot
 *.dump
+
 coverage
-*.log
+*.log

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

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 

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

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"
+
+

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
 

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

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)

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