From 93618e1eb380ae835dd64cfb210e861b5792bcd6 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Tue, 21 Jun 2016 10:28:13 -0400 Subject: [PATCH] add check mode to address #441 --- jscomp/core.mllib | 1 + jscomp/js_main.ml | 2 +- jscomp/lam_compile_external_call.ml | 120 +++++++++------------------- jscomp/lam_external_def.ml | 102 +++++++++++++++++++++++ jscomp/lam_external_def.mli | 72 +++++++++++++++++ jscomp/test/.depend | 4 + jscomp/test/gpr_441.ml | 5 ++ jscomp/test/test.mllib | 4 +- lib/js/test/gpr_441.js | 6 ++ 9 files changed, 232 insertions(+), 84 deletions(-) create mode 100644 jscomp/lam_external_def.ml create mode 100644 jscomp/lam_external_def.mli create mode 100644 jscomp/test/gpr_441.ml create mode 100644 lib/js/test/gpr_441.js diff --git a/jscomp/core.mllib b/jscomp/core.mllib index a9ea89c6d0..947291b9d1 100644 --- a/jscomp/core.mllib +++ b/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 diff --git a/jscomp/js_main.ml b/jscomp/js_main.ml index 0989570774..4109e09219 100644 --- a/jscomp/js_main.ml +++ b/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 diff --git a/jscomp/lam_compile_external_call.ml b/jscomp/lam_compile_external_call.ml index 1d7f6b6a3f..5257304e39 100644 --- a/jscomp/lam_compile_external_call.ml +++ b/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,12 +140,15 @@ 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 @@ -201,7 +156,7 @@ let handle_attributes ({prim_attributes ; prim_name} as _prim : prim ) : Locati | "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 diff --git a/jscomp/lam_external_def.ml b/jscomp/lam_external_def.ml new file mode 100644 index 0000000000..2281c7c355 --- /dev/null +++ b/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" diff --git a/jscomp/lam_external_def.mli b/jscomp/lam_external_def.mli new file mode 100644 index 0000000000..7143701e4d --- /dev/null +++ b/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 diff --git a/jscomp/test/.depend b/jscomp/test/.depend index b0d4f41b0b..40b771a104 100644 --- a/jscomp/test/.depend +++ b/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 \ diff --git a/jscomp/test/gpr_441.ml b/jscomp/test/gpr_441.ml new file mode 100644 index 0000000000..eb7ea160c3 --- /dev/null +++ b/jscomp/test/gpr_441.ml @@ -0,0 +1,5 @@ + +(* external new_rectangle : *) +(* unit -> int Js.t = "" [@@bs.new] [@@bs.module "@Rectangle"] *) + +(* let rect = new_rectangle *) diff --git a/jscomp/test/test.mllib b/jscomp/test/test.mllib index 56335953bc..9f9861de09 100644 --- a/jscomp/test/test.mllib +++ b/jscomp/test/test.mllib @@ -329,4 +329,6 @@ largest_int_flow noassert -test_unsafe_cmp \ No newline at end of file +test_unsafe_cmp + +gpr_441 \ No newline at end of file diff --git a/lib/js/test/gpr_441.js b/lib/js/test/gpr_441.js new file mode 100644 index 0000000000..b6c60ac800 --- /dev/null +++ b/lib/js/test/gpr_441.js @@ -0,0 +1,6 @@ +// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.5 , PLEASE EDIT WITH CARE +'use strict'; + + + +/* No side effect */