check predef exception in the begininng

Author: Hongbo Zhang

jscomp/lam.ml

@@ -46,6 +46,7 @@ type primitive =
   (* Globals *)
   | Pgetglobal of ident
   | Psetglobal of ident
+  | Pglobal_exception of ident       
   (* Operations on heap blocks *)
   | Pmakeblock of int * tag_info * mutable_flag
   | Pfield of int * field_dbg_info
@@ -553,7 +554,11 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args  : t =
     | _ -> assert false 
     end
   | Ploc loc -> assert false (* already compiled away here*)
-  | Pgetglobal id -> prim ~primitive:(Pgetglobal id) ~args
+  | Pgetglobal id ->
+    if Ident.is_predef_exn id then
+      prim ~primitive:(Pglobal_exception id) ~args      
+    else       
+      prim ~primitive:(Pgetglobal id) ~args
   | Psetglobal id -> prim ~primitive:(Psetglobal id) ~args
   | Pmakeblock (tag,info, mutable_flag) 
     -> prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args
@@ -592,7 +597,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args  : t =
       begin match args with 
         | [Lprim {primitive = Pmakeblock (0, _, _) ; 
                   args = [ 
-                    Lprim {primitive = Pgetglobal ({name = "Assert_failure"} as id); args =  []}; 
+                    Lprim {primitive = Pglobal_exception ({name = "Assert_failure"} as id); args =  []}; 
                     _
                   ]
                  } ] when Ident.global id

jscomp/lam.mli

@@ -51,6 +51,7 @@ type primitive =
   | Pbytes_of_string
   | Pgetglobal of ident
   | Psetglobal of ident
+  | Pglobal_exception of ident             
   | Pmakeblock of int * Lambda.tag_info * Asttypes.mutable_flag
   | Pfield of int * Lambda.field_dbg_info
   | Psetfield of int * bool * Lambda.set_field_dbg_info

jscomp/lam_analysis.ml

@@ -72,7 +72,8 @@ let rec no_side_effects (lam : Lam.t) : bool =
 
 
 
-      | Pgetglobal _ 
+      | Pgetglobal _
+      | Pglobal_exception _
       | Pmakeblock _  (* whether it's mutable or not *)
       | Pfield _
       | Pfloatfield _ 
@@ -188,7 +189,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
                     args = [Lconst _]; _},exn,
               Lifthenelse(Lprim{args =  
                                   [Lvar exn1; 
-                                   Lprim {primitive = Pgetglobal ({name="Not_found"}); args = []; _}]
+                                   Lprim {primitive = Pglobal_exception ({name="Not_found"}); args = []; _}]
                                ; _},
                           then_, _)) when Ident.same exn1 exn
     (** we might put this in an optimization pass 

jscomp/lam_compile.ml

@@ -1464,7 +1464,7 @@ and
         Lifthenelse
           (Lprim{primitive = Pintcomp(Ceq);
                  args = [Lvar id2 ; 
-                         Lprim{primitive = Pgetglobal {name = "Not_found"}; _}]},
+                         Lprim{primitive = Pglobal_exception {name = "Not_found"}; _}]},
            cont, _reraise )
       )
       | Ltrywith(
@@ -1473,7 +1473,7 @@ and
           id, 
           Lifthenelse(Lprim{primitive = Pintcomp(Ceq);
                             args = [ 
-                              Lprim { primitive = Pgetglobal {name = "Not_found"; _}; _}; Lvar id2 ]},
+                              Lprim { primitive = Pglobal_exception {name = "Not_found"; _}; _}; Lvar id2 ]},
                       cont, _reraise )
         )) when Ident.same id id2 
       -> 

jscomp/lam_compile_global.ml

@@ -63,10 +63,7 @@ let query_lambda id env =
 let get_exp (key : Lam_compile_env.key) : J.expression = 
   match key with 
    (id, env, expand) -> 
-    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_compile_env.query_and_add_if_not_exist 
         (Lam_module_ident.of_ml id) 
         (Has_env env)
         ~not_found:(fun id -> assert false)

jscomp/lam_compile_primitive.ml

@@ -54,6 +54,8 @@ let translate
   | Pjs_fn_runmethod _ 
     -> assert false (* already handled by {!Lam_compile} *)
   | Pjs_fn_method _ -> assert false
+  | Pglobal_exception id ->
+    Js_of_lam_exception.get_builtin_by_name id.name    
   | Pstringadd ->
     begin match args with      
       | [a;b] ->

jscomp/lam_pass_collect.ml

@@ -131,10 +131,7 @@ let collect_helper  (meta : Lam_stats.meta) (lam : Lam.t)  =
 
   and collect  (lam : Lam.t)  =
     match lam with 
-    (* | Lprim (Pgetglobal ident,[]) *)
-    (*   -> *)
-    (*     if not @@ Ident.is_predef_exn ident  then *)
-    (*       Lam_util.add_required_module ident meta *)
+
         (** TODO: 
             how about module aliases..
             record dependency

jscomp/lam_print.ml

@@ -111,6 +111,8 @@ let primitive ppf (prim : Lam.primitive) = match prim with
   | Pjs_fn_runmethod i -> fprintf ppf "js_fn_runmethod_%i" i 
   | Pdebugger -> fprintf ppf "debugger"
   | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
+  | Pglobal_exception id ->
+    fprintf ppf "global exception %a" Ident.print id                       
   | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
   | Pmakeblock(tag, _, Immutable) -> fprintf ppf "makeblock %i" tag
   | Pmakeblock(tag, _, Mutable) -> fprintf ppf "makemutable %i" tag

jscomp/lam_util.ml

@@ -65,16 +65,12 @@ let sort_dag_args  param_args =
 
 
 let add_required_module (x : Ident.t) (meta : Lam_stats.meta) = 
-  if not @@ Ident.is_predef_exn x then   
-    meta.required_modules <- Lam_module_ident.of_ml x :: meta.required_modules 
+  meta.required_modules <- Lam_module_ident.of_ml x :: meta.required_modules 
 
 let add_required_modules ( x : Ident.t list) (meta : Lam_stats.meta) = 
   let required_modules = 
-    Ext_list.filter_map 
-      (fun x ->
-         if Ident.is_predef_exn x then
-           None 
-         else Some ( Lam_module_ident.of_ml x))  x
+    List.map 
+      (fun x -> Lam_module_ident.of_ml x)  x
     @ meta.required_modules in
   meta.required_modules <- required_modules