add check mode to address #441

jscomp/core.mllib

@@ -13,6 +13,7 @@ ocaml_parse
 lam
 lam_iter
 lam_print
+lam_external_def
 lam_compile_env
 lam_dispatch_primitive
 lam_stats

jscomp/js_main.ml

@@ -77,7 +77,7 @@ let buckle_script_flags =
     " set will generate `.d.ts` file for typescript (experimental)")
   :: ("-bs-diagnose", Arg.Set Js_config.diagnose, 
       " More verbose output")
-  :: ("-bs-rest-files", Arg.Rest collect_file, 
+  :: ("-bs-files", Arg.Rest collect_file, 
       " Provide batch of files, the compiler will sort it before compiling"
      )
   :: Ocaml_options.mk_impl impl

jscomp/lam_compile_external_call.ml

@@ -32,80 +32,36 @@
 module E = Js_exp_make
 
 
+(** 
+   [@@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 external_module_name = 
-  | Single of string 
-  | Bind of string * string 
-
-type 'a external_module = {
-  txt : 'a ;
-  external_module_name : external_module_name option;
-}
-
-let handle_external module_name = 
-  begin 
+let handle_external (module_name : Lam_external_def.external_module_name option) = 
     match module_name with 
-    | Some module_name -> 
-      (* 
-         [@@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
-       *)
+    | Some {bundle ; bind_name} -> 
       let id  = 
-        match module_name with 
-        | Single module_name -> 
-          (Lam_compile_env.add_js_module module_name , module_name)
-        | Bind (module_name, name) -> 
-          (Lam_compile_env.add_js_module 
-             ~id:(Ext_ident.create_js_module name) module_name,
-           module_name)
+        match bind_name with 
+        | None -> 
+          Lam_compile_env.add_js_module bundle , bundle
+        | Some bind_name -> 
+          Lam_compile_env.add_js_module 
+             ~id:(Ext_ident.create_js_module bind_name) bundle,
+           bundle
       in Some id 
     | None -> None 
-  end
 
-type js_call = { 
-  splice : bool ;
-  qualifiers : string list;
-  name : string;
-}
-
-type js_send = { 
-  splice : bool ; 
-  name : string 
-} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
-
-type js_val = { 
-  name : string ;
-  external_module_name : external_module_name option;
-
-} 
-
-type js_new = {  name : string }
-type js_set = { name : string }
-type js_get = { name : string }
-
-type ffi = 
-  | Obj_create 
-  | Js_global of js_val 
-  | Js_global_as_var of  external_module_name
-  | Js_call of js_call external_module
-  | Js_send of js_send
-  | Js_new of js_new external_module
-  | Js_set of js_set
-  | Js_get of js_get
-  | Js_get_index
-  | Js_set_index
-  | Normal 
-  (* When it's normal, it is handled as normal c functional ffi call *)
-type prim = Types.type_expr option Primitive.description
-
-let handle_attributes ({prim_attributes ; prim_name} as _prim  : prim ) : Location.t option * ffi  = 
+
+let handle_attributes ({prim_attributes ; prim_name} as _prim  : Lam_external_def.prim )
+  : Location.t option * Lam_external_def.ffi  = 
   let qualifiers = ref [] in
   let call_name = ref None in
   let external_module_name  = ref None in
@@ -145,19 +101,15 @@ let handle_attributes ({prim_attributes ; prim_name} as _prim  : prim ) : Locati
              | Some name -> 
                js_val := `Value name 
              | None -> 
-               js_val := `Value _prim.prim_name
+               js_val := `Value prim_name
                 (* we can report error here ... *)
            end
          | "bs.val_of_module" 
            (* {[ [@@bs.val_of_module]]}
            *)
            -> 
-           begin match Ast_payload.is_single_string pay_load with 
-           | Some name ->
-             js_val_of_module := `Value(Bind (name, prim_name))
-           | None -> 
-             js_val_of_module := `Value (Single prim_name)
-           end
+           js_val_of_module := 
+             `Value (Lam_external_def.{bundle = prim_name ; bind_name = Ast_payload.is_single_string pay_load})
          |"bs.splice"
            -> 
            js_splice := true
@@ -166,19 +118,19 @@ let handle_attributes ({prim_attributes ; prim_name} as _prim  : prim ) : Locati
            ->
            begin match Ast_payload.is_single_string pay_load with 
              | Some name -> js_send := `Value name
-             | None -> js_send := `Value _prim.prim_name
+             | None -> js_send := `Value prim_name
            end
          | "bs.set"
            ->
            begin match Ast_payload.is_single_string pay_load with
              | Some name -> js_set := `Value name
-             | None -> js_set := `Value _prim.prim_name
+             | None -> js_set := `Value prim_name
            end
          | "bs.get"
            ->
            begin match Ast_payload.is_single_string pay_load with
              | Some name -> js_get := `Value name
-             | None -> js_get := `Value _prim.prim_name
+             | None -> js_get := `Value prim_name
            end
 
          | "bs.call"
@@ -188,20 +140,23 @@ let handle_attributes ({prim_attributes ; prim_name} as _prim  : prim ) : Locati
            ->
            begin match Ast_payload.is_single_string pay_load with 
              | Some name -> call_name :=  Some (x.loc, name)
-             | None -> call_name := Some(x.loc, _prim.prim_name)
+             | None -> call_name := Some(x.loc, prim_name)
            end
          | "bs.module" -> 
            begin match Ast_payload.is_string_or_strings pay_load with 
-             | `Single name -> external_module_name:= Some (Single name)
-             | `Some [a;b] -> external_module_name := Some (Bind (a,b))
+             | `Single name ->
+               external_module_name:= Some (Lam_external_def.{ bundle =  name; bind_name = None})
+             | `Some [bundle;bind_name] -> 
+               external_module_name := 
+                 Some (Lam_external_def.{bundle ; bind_name = Some bind_name})
              | `Some _ -> ()
              | `None -> () (* should emit a warning instead *)
            end
 
          | "bs.new" -> 
            begin match Ast_payload.is_single_string pay_load with 
              | Some x -> js_new := Some x 
-             | None -> js_new := Some _prim.prim_name
+             | None -> js_new := Some prim_name
            end
          | "bs.set_index" 
            -> js_set_index := true
@@ -324,6 +279,7 @@ let translate
     (args : J.expression list) = 
   begin 
     let loc, ffi = handle_attributes prim in
+    let () = Lam_external_def.check_ffi ?loc ffi in 
     match ffi with 
     | Obj_create -> 
       begin 

jscomp/lam_external_def.ml

@@ -0,0 +1,102 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public 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 external_module_name = 
+  { bundle : string ; 
+    bind_name : string option
+  }
+type 'a external_module = {
+  txt : 'a ;
+  external_module_name : external_module_name option;
+}
+
+
+type js_call = { 
+  splice : bool ;
+  qualifiers : string list;
+  name : string;
+}
+
+type js_send = { 
+  splice : bool ; 
+  name : string 
+} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
+
+type js_val = { 
+  name : string ;
+  external_module_name : external_module_name option;
+
+} 
+
+type js_new = {  name : string }
+type js_set = { name : string }
+type js_get = { name : string }
+
+type ffi = 
+  | Obj_create 
+  | Js_global of js_val 
+  | Js_global_as_var of  external_module_name
+  | Js_call of js_call external_module
+  | Js_send of js_send
+  | Js_new of js_new external_module
+  | Js_set of js_set
+  | Js_get of js_get
+  | Js_get_index
+  | Js_set_index
+  | Normal 
+  (* When it's normal, it is handled as normal c functional ffi call *)
+type prim = Types.type_expr option Primitive.description
+
+let check_external_module_name ?loc x = 
+  match x with 
+  | {bundle = ""; _ } | {bind_name = Some ""} -> 
+    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 = 
+  match ffi with 
+  | Js_global {name = ""} 
+  | Js_send {name = ""}
+  | Js_set {name = ""}
+  | Js_get {name = ""}
+    -> Location.raise_errorf ?loc "empty name encountered"
+  | Js_global _ | Js_send _ | Js_set _ | Js_get _  
+  | Obj_create 
+  | Js_get_index | Js_set_index | Normal -> ()
+
+  | Js_global_as_var external_module_name 
+    -> check_external_module_name external_module_name
+  | Js_new {external_module_name ; txt = {name ; _}}
+  | Js_call {external_module_name ; txt = {name ; _}}
+    -> 
+    check_external_module_name_opt ?loc external_module_name ; 
+    if name = "" then
+      Location.raise_errorf ?loc "empty name in externals"

jscomp/lam_external_def.mli

@@ -0,0 +1,72 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public 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 external_module_name = 
+  { bundle : string ; 
+    bind_name : string option
+  }
+type 'a external_module = {
+  txt : 'a ;
+  external_module_name : external_module_name option;
+}
+
+
+type js_call = { 
+  splice : bool ;
+  qualifiers : string list;
+  name : string;
+}
+
+type js_send = { 
+  splice : bool ; 
+  name : string 
+} (* we know it is a js send, but what will happen if you pass an ocaml objct *)
+
+type js_val = { 
+  name : string ;
+  external_module_name : external_module_name option;
+
+} 
+
+type js_new = {  name : string }
+type js_set = { name : string }
+type js_get = { name : string }
+
+type ffi = 
+  | Obj_create 
+  | Js_global of js_val 
+  | Js_global_as_var of  external_module_name
+  | Js_call of js_call external_module
+  | Js_send of js_send
+  | Js_new of js_new external_module
+  | Js_set of js_set
+  | Js_get of js_get
+  | Js_get_index
+  | Js_set_index
+  | Normal 
+  (* When it's normal, it is handled as normal c functional ffi call *)
+type prim = Types.type_expr option Primitive.description
+
+val check_ffi : ?loc:Location.t -> ffi -> unit

jscomp/test/.depend

@@ -222,6 +222,8 @@ google_closure_test.cmj : test_google_closure.cmj mt.cmi
 google_closure_test.cmx : test_google_closure.cmx mt.cmx
 gpr_405_test.cmj : ../stdlib/hashtbl.cmi gpr_405_test.cmi
 gpr_405_test.cmx : ../stdlib/hashtbl.cmx gpr_405_test.cmi
+gpr_441.cmj :
+gpr_441.cmx :
 guide_for_ext.cmj :
 guide_for_ext.cmx :
 hamming_test.cmj : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \
@@ -886,6 +888,8 @@ google_closure_test.cmo : test_google_closure.cmo mt.cmi
 google_closure_test.cmj : test_google_closure.cmj mt.cmj
 gpr_405_test.cmo : ../stdlib/hashtbl.cmi gpr_405_test.cmi
 gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
+gpr_441.cmo :
+gpr_441.cmj :
 guide_for_ext.cmo :
 guide_for_ext.cmj :
 hamming_test.cmo : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \