Merge pull request #636 from bloomberg/fix_gpr_627

remove Js_config.is_browser hack, no longer needed for playground

Author: bobzhang

jscomp/lam_compile_group.ml

@@ -422,7 +422,7 @@ let lambda_as_module
     (lam : Lambda.lambda) = 
   begin 
     Js_config.set_current_file filename ;  
-    Js_config.iset_debug_file "jsoo_485_test.ml";
+    Js_config.iset_debug_file "jsoo_400_test.ml";
     let lambda_output = compile ~filename output_prefix false env sigs lam in
     let (//) = Filename.concat in 
     let basename =  

jscomp/stdlib/pervasives.ml

@@ -489,16 +489,3 @@ let exit retcode =
 
 let _ = register_named_value "Pervasives.do_at_exit" do_at_exit
 
-
-(** TEMPORARY CHANGES FOR PLAYGROUND, SHOULD BE REMOVED LATER *)
-
-(** internal types for FFI, these types are not used by normal users *)
-type (-'obj, +'a) js_meth_callback 
-type (-'arg, + 'result) js_meth
-type (-'arg, + 'result) js_fn (** Js uncurried function *)
-
-
-(** Types for JS objects *)
-type +'a js_t (** Js object type *)
-
-type js_re

jscomp/stdlib/pervasives.mli

@@ -1091,14 +1091,3 @@ val unsafe_really_input : in_channel -> bytes -> int -> int -> unit
 
 val do_at_exit : unit -> unit
 
-(** TEMPORARY CHANGES FOR PLAYGROUND, SHOULD BE REMOVED LATER *)
-
-type (-'obj, +'a) js_meth_callback 
-type (-'arg, + 'result) js_meth
-type (-'arg, + 'result) js_fn (** Js uncurried function *)
-
-
-(** Types for JS objects *)
-type +'a js_t (** Js object type *)
-
-type js_re (* Js re type*)

jscomp/syntax/ast_comb.ml

@@ -65,22 +65,17 @@ let tuple_type_pair ?loc kind arity =
 
 
 
-let js_obj_type_id () = 
-  if Js_config.is_browser () then
-    Ast_literal.Lid.pervasives_js_obj
-  else Ast_literal.Lid.js_obj 
+let js_obj_type_id  = 
+  Ast_literal.Lid.js_obj 
 
-let re_id () = 
-  if Js_config.is_browser () then
-    Ast_literal.Lid.pervasives_re_id 
-  else 
-    Ast_literal.Lid.js_re_id 
+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]
+  Typ.constr ~loc {txt = js_obj_type_id; loc} [x]
 
 let to_js_re_type loc  =
-  Typ.constr ~loc { txt = re_id (); loc} []
+  Typ.constr ~loc { txt = re_id ; loc} []
 
 let to_js_undefined_type loc x =
   Typ.constr ~loc

jscomp/syntax/ast_literal.ml

@@ -24,47 +24,23 @@
 
 open Ast_helper
 
-let pervasives = "Pervasives"
+
 module Lid = struct 
   type t = Longident.t 
   let val_unit : t = Lident "()"
   let type_unit : t = Lident "unit"
   let type_string : t = Lident "string"
   (* TODO should be renamed in to {!Js.fn} *)
   (* TODO should be moved into {!Js.t} Later *)
-
-
-
   let js_fn = Longident.Ldot (Lident "Js", "fn")
-  let pervasives_fn = Longident.Ldot (Lident pervasives, "js_fn")
-
   let js_meth = Longident.Ldot (Lident "Js", "meth")
-  let pervasives_meth = Longident.Ldot (Lident pervasives, "js_meth")
-
-
   let js_meth_callback = Longident.Ldot (Lident "Js", "meth_callback")
-  let pervasives_meth_callback = Longident.Ldot (Lident pervasives, "js_meth_callback")
-
   let js_obj = Longident.Ldot (Lident "Js", "t") 
-  let pervasives_js_obj = Longident.Ldot (Lident pervasives, "js_t") 
-
-  let ignore_id = Longident.Ldot (Lident pervasives, "ignore")
-
+  let ignore_id = Longident.Ldot (Lident "Pervasives", "ignore")
   let js_null  = Longident.Ldot (Lident "Js", "null")
   let js_undefined = Longident.Ldot (Lident "Js", "undefined")
   let js_null_undefined = Longident.Ldot (Lident "Js", "null_undefined")
-
-  let pervasives_js_null =
-    Longident.Ldot (Lident pervasives, "js_null")
-  let pervasives_js_undefined =
-    Longident.Ldot (Lident pervasives, "js_undefined")
-
-  let pervasives_js_null_undefined =
-    Longident.Ldot (Lident pervasives, "null_undefined")
-      
-  let pervasives_re_id = Longident.Ldot (Lident pervasives, "js_re")
   let js_re_id = Longident.Ldot (Lident "Js_re", "t")
-
   let js_unsafe = Longident.Lident "Js_unsafe"
 end
 

jscomp/syntax/ast_literal.mli

@@ -28,28 +28,16 @@ module Lid : sig
   type t = Longident.t 
   val val_unit : t 
   val type_unit : t 
-  val pervasives_js_obj : t 
-
   val js_fn : t 
-  val pervasives_fn : t 
-
   val js_meth : t 
-  val pervasives_meth : t 
-
-  val pervasives_meth_callback : 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 pervasives_js_undefined : t
-    
-  val pervasives_re_id : t 
   val js_re_id : t 
-
   val js_unsafe : t 
 end
 

jscomp/syntax/ast_util.ml

@@ -37,23 +37,14 @@ type uncurry_type_gen =
    Parsetree.core_type  ->
    Parsetree.core_type) cxt
 
-let uncurry_type_id () = 
-  if Js_config.is_browser () then 
-     Ast_literal.Lid.pervasives_fn
-  else 
-    Ast_literal.Lid.js_fn
+let uncurry_type_id = 
+  Ast_literal.Lid.js_fn
 
-let method_id () = 
-  if Js_config.is_browser () then 
-     Ast_literal.Lid.pervasives_meth
-  else 
-    Ast_literal.Lid.js_meth
+let method_id  = 
+  Ast_literal.Lid.js_meth
 
-let method_call_back_id () = 
-  if Js_config.is_browser () then 
-    Ast_literal.Lid.pervasives_meth_callback
-  else 
-    Ast_literal.Lid.js_meth_callback
+let method_call_back_id  = 
+  Ast_literal.Lid.js_meth_callback
 
 let arity_lit = "Arity_"
 
@@ -72,14 +63,14 @@ let generic_lift txt loc args result  =
   Typ.constr ~loc {txt ; loc} xs
 
 let lift_curry_type  loc   = 
-  generic_lift  ( uncurry_type_id ()) loc
+  generic_lift   uncurry_type_id loc
 
 let lift_method_type loc  = 
-  generic_lift  (method_id ()) loc
+  generic_lift  method_id loc
 
 let lift_js_method_callback loc
   = 
-  generic_lift (method_call_back_id ()) 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.
@@ -99,24 +90,12 @@ let arrow = Typ.arrow
 
 
 let js_property loc obj name =
-  if Js_config.is_browser () then
-    let downgrade ~loc () = 
-      let var = Typ.var ~loc "a" in 
-      Ast_comb.arrow_no_label ~loc
-        (Ast_comb.to_js_type loc var) var
-    in
-    Ast_external.local_extern_cont loc  
-      ~pval_prim:[Literals.js_unsafe_downgrade] 
-      ~pval_type:(downgrade ~loc ())
-      ~local_fun_name:"cast" 
-      (fun down -> Exp.send ~loc (Exp.apply ~loc down ["", obj]) name  )
-  else 
-    Parsetree.Pexp_send
-      ((Exp.apply ~loc
-          (Exp.ident ~loc
-             {loc;
-              txt = Ldot (Ast_literal.Lid.js_unsafe, Literals.js_unsafe_downgrade)})
-          ["",obj]), name)
+  Parsetree.Pexp_send
+    ((Exp.apply ~loc
+        (Exp.ident ~loc
+           {loc;
+            txt = Ldot (Ast_literal.Lid.js_unsafe, Literals.js_unsafe_downgrade)})
+        ["",obj]), name)
 
 (* TODO: 
    have a final checking for property arities 
@@ -144,7 +123,7 @@ let generic_apply  kind loc
      0, cb loc obj, []
   | _ -> 
     len,  cb loc obj, args in
-  if not (Js_config.is_browser ()) && arity < 10 then 
+  if arity < 10 then 
     let txt = 
       match kind with 
       | `Fn | `PropertyFn ->  
@@ -267,7 +246,7 @@ let generic_to_uncurry_exp kind loc (self : Ast_mapper.mapper)  pat body
         | _ -> len 
       end
     | `Method_callback -> len  in 
-  if arity < 10 &&  not (Js_config.is_browser ()) then 
+  if arity < 10  then 
     let txt = 
       match kind with 
       | `Fn -> 
@@ -301,17 +280,9 @@ let to_method_callback  =
 
 let handle_debugger loc payload = 
   if Ast_payload.as_empty_structure payload then
-    if Js_config.is_browser () then 
-      let predef_unit_type = Ast_literal.type_unit ~loc () in
-      let pval_prim = [Literals.js_debugger] in
-      Ast_external.create_local_external loc 
-        ~pval_prim
-        ~pval_type:(arrow "" predef_unit_type predef_unit_type)
-        [("",  Ast_literal.val_unit ~loc ())]
-    else 
-      Parsetree.Pexp_apply
-        (Exp.ident {txt = Ldot(Ast_literal.Lid.js_unsafe, Literals.js_debugger ); loc}, 
-         ["", Ast_literal.val_unit ~loc ()])
+    Parsetree.Pexp_apply
+      (Exp.ident {txt = Ldot(Ast_literal.Lid.js_unsafe, Literals.js_debugger ); loc}, 
+       ["", Ast_literal.val_unit ~loc ()])
   else Location.raise_errorf ~loc "bs.raw can only be applied to a string"
 
 
@@ -322,16 +293,8 @@ let handle_raw loc payload =
         "bs.raw can only be applied to a string "
 
     | Some exp -> 
-      let pval_prim = [Literals.js_pure_expr] in
       let pexp_desc = 
-        if Js_config.is_browser () then 
-          Ast_external.create_local_external loc 
-            ~pval_prim
-            ~pval_type:(arrow "" 
-                          (Ast_literal.type_string ~loc ()) 
-                          (Ast_literal.type_any ~loc ()) )
-            ["",exp] 
-        else Parsetree.Pexp_apply (
+        Parsetree.Pexp_apply (
             Exp.ident {loc; 
                        txt = 
                          Ldot (Ast_literal.Lid.js_unsafe, 
@@ -350,16 +313,7 @@ let handle_raw_structure loc payload =
     | Some exp 
       -> 
       let pexp_desc = 
-        if Js_config.is_browser () then 
-          let pval_prim = [Literals.js_pure_stmt] in 
-          Ast_external.create_local_external loc 
-            ~pval_prim
-            ~pval_type:(arrow ""
-                          (Ast_literal.type_string ~loc ())
-                          (Ast_literal.type_any ~loc ()))
-            ["",exp]
-        else 
-          Parsetree.Pexp_apply(
+        Parsetree.Pexp_apply(
             Exp.ident {txt = Ldot (Ast_literal.Lid.js_unsafe,  Literals.js_pure_stmt); loc},
             ["",exp]) in 
       Ast_helper.Str.eval 

jscomp/test/.depend

@@ -334,6 +334,8 @@ js_obj_test.cmj : mt.cmi
 js_obj_test.cmx : mt.cmx
 js_val.cmj :
 js_val.cmx :
+jsoo_400_test.cmj : ../stdlib/string.cmi mt.cmi
+jsoo_400_test.cmx : ../stdlib/string.cmx mt.cmx
 jsoo_485.cmj :
 jsoo_485.cmx :
 jsoo_485_test.cmj :
@@ -1090,6 +1092,8 @@ js_obj_test.cmo : mt.cmi
 js_obj_test.cmj : mt.cmj
 js_val.cmo :
 js_val.cmj :
+jsoo_400_test.cmo : ../stdlib/string.cmi mt.cmi
+jsoo_400_test.cmj : ../stdlib/string.cmj mt.cmj
 jsoo_485.cmo :
 jsoo_485.cmj :
 jsoo_485_test.cmo :

jscomp/test/Makefile

@@ -59,7 +59,7 @@ OTHERS := a test_ari test_export2 test_internalOO test_obj_simple_ffi test_scope
 	optional_ffi_test poly_variant_test \
 	bs_rest_test infer_type_test fs_test module_as_function\
 	test_case_set test_mutliple string_bound_get_test inline_string_test\
-	ppx_this_obj_test unsafe_obj_external gpr_627_test jsoo_485_test	
+	ppx_this_obj_test unsafe_obj_external gpr_627_test jsoo_485_test jsoo_400_test	
 
 
 SOURCE_LIST := js_dyn $(OTHERS) 

jscomp/test/jsoo_400_test.js

@@ -0,0 +1,37 @@
+'use strict';
+
+var Mt         = require("./mt");
+var Caml_int32 = require("../../lib/js/caml_int32");
+var Block      = require("../../lib/js/block");
+
+function u() {
+  var exit = 0;
+  var n;
+  try {
+    n = 3;
+    exit = 1;
+  }
+  catch (exn){
+    return 42;
+  }
+  if (exit === 1) {
+    return Caml_int32.div(3, 0);
+  }
+  
+}
+
+Mt.from_pair_suites("jsoo_400_test.ml", /* :: */[
+      /* tuple */[
+        'File "jsoo_400_test.ml", line 8, characters 3-10',
+        function () {
+          return /* ThrowAny */Block.__(3, [function () {
+                      u(/* () */0);
+                      return /* () */0;
+                    }]);
+        }
+      ],
+      /* [] */0
+    ]);
+
+exports.u = u;
+/*  Not a pure module */