caml_fresh_oo_id/caml_set_oo_id support

Author: bobzhang

Diff for: jscomp/core/js_of_lam_exception.ml

@@ -78,5 +78,7 @@ let caml_set_oo_id args =
     (*   ->  *)
     (*   make_exception exception_str  *)
     (* | _ -> *)
-
     (* end *)
+    
+let caml_fresh_oo_id args = 
+  E.runtime_call Js_runtime_modules.exceptions "caml_fresh_oo_id" args 

Diff for: jscomp/core/js_of_lam_exception.mli

@@ -31,6 +31,11 @@
 val get_builtin_by_name : string -> J.expression
 
 
-val caml_set_oo_id : J.expression list -> J.expression
+val caml_set_oo_id : 
+  J.expression list -> J.expression
+
+val caml_fresh_oo_id :
+  J.expression list -> J.expression
+
 val make : J.expression  -> J.expression
 (* val make_extension : J.expression  -> J.expression *)

Diff for: jscomp/core/lam_convert.ml

@@ -229,7 +229,18 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
       prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
     | Blk_extension_slot -> 
       let info : Lam_tag_info.t = Blk_extension_slot in
+      ( 
+#if OCAML_VERSION =~ ">4.03.0" then
+      match args with 
+      | [ Lconst (Const_string name);
+          Lprim {primitive = Pccall {prim_name = "caml_fresh_oo_id"} ; }
+        ] -> 
+        prim ~primitive:(Pcreate_extension name) ~args:[] loc
+      | _ ->
+#end       
       prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
+      )
+
     | Blk_na -> 
       let info : Lam_tag_info.t = Blk_na in
       prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
@@ -400,32 +411,33 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
   let may_depends = Lam_module_ident.Hash_set.create 0 in
 
   let rec
-    convert_ccall (a : Primitive_compat.t)  (args : Lambda.lambda list) loc : Lam.t =
-    let prim_name = a.prim_name in
+    convert_ccall (a_prim : Primitive_compat.t)  (args : Lambda.lambda list) loc : Lam.t =
+    let prim_name = a_prim.prim_name in
     let prim_name_len  = String.length prim_name in
-    match External_ffi_types.from_string a.prim_native_name with
+    match External_ffi_types.from_string a_prim.prim_native_name with
     | Ffi_normal ->
       if prim_name_len > 0 && String.unsafe_get prim_name 0 = '#' then
-        convert_js_primitive a args loc
+        convert_js_primitive a_prim args loc
       else
         (* COMPILER CHECK *)
         (* Here the invariant we should keep is that all exception
            created should be captured
         *)
-          (match prim_name  ,  args with
+          (
+#if OCAML_VERSION =~ ">4.03.0" then
+#else
+          match prim_name  ,  args with
           | "caml_set_oo_id" ,
-            [ Lprim (Pmakeblock(tag,Blk_extension_slot, _
-#if OCAML_VERSION =~ ">4.03.0" then 
-                      ,_ (*FIXME caml_set_oo_id is no longer needed?*)
-#end                      
-                      ),
+            [ Lprim (Pmakeblock(tag,Blk_extension_slot, _),
                      Lconst (Const_base(Const_string(name,_))) :: _,
                      loc
                     )]
             -> prim ~primitive:(Pcreate_extension name) ~args:[] loc
           | _ , _->
+#end          
             let args = Ext_list.map args convert_aux in
-            prim ~primitive:(Pccall a) ~args loc)
+            prim ~primitive:(Pccall a_prim) ~args loc
+          )
     | Ffi_obj_create labels ->
       let args = Ext_list.map args  convert_aux in
       prim ~primitive:(Pjs_object_create labels) ~args loc

Diff for: jscomp/core/lam_dispatch_primitive.ml

@@ -581,10 +581,15 @@ let translate loc (prim_name : string)
     (** Note we captured [exception/extension] creation in the early pass, this primitive is 
         like normal one to set the identifier *)
 
+#if OCAML_VERSION =~ ">4.03.0" then
+    | "caml_fresh_oo_id" 
+      ->
+      Js_of_lam_exception.caml_fresh_oo_id args   
+#else
     | "caml_set_oo_id" 
       ->
       Js_of_lam_exception.caml_set_oo_id args 
-
+#end      
     | "caml_sys_const_big_endian" -> 
       (** return false *)
       E.bool Sys.big_endian

Diff for: jscomp/runtime/caml_exceptions.ml

@@ -52,13 +52,14 @@ let caml_set_oo_id (b : Caml_builtin_exceptions.exception_block)  =
   id := Nativeint.add !id  1n; 
   b
 
-let get_id () = 
+
+let caml_fresh_oo_id () = 
   id := Nativeint.add !id 1n; !id
 
 let object_tag = 248
 
 let create (str : string) : Caml_builtin_exceptions.exception_block = 
-  let v = ( str, get_id ()) in 
+  let v = ( str, caml_fresh_oo_id ()) in 
   Bs_obj.set_tag (Obj.repr v) object_tag;
   v 
 

Diff for: jscomp/runtime/caml_exceptions.mli

@@ -31,7 +31,8 @@
 val caml_set_oo_id :
   Caml_builtin_exceptions.exception_block -> Caml_builtin_exceptions.exception_block
 
-val get_id : unit -> nativeint
+val caml_fresh_oo_id : 
+  unit -> nativeint
 
 val create : string -> Caml_builtin_exceptions.exception_block
 (* val makeExtension : string -> Caml_builtin_exceptions.exception_block *)

Diff for: lib/js/caml_exceptions.js

@@ -9,13 +9,13 @@ function caml_set_oo_id(b) {
   return b;
 }
 
-function get_id(param) {
+function caml_fresh_oo_id(param) {
   id[0] += 1;
   return id[0];
 }
 
 function create(str) {
-  var v_001 = get_id(/* () */0);
+  var v_001 = caml_fresh_oo_id(/* () */0);
   var v = /* tuple */[
     str,
     v_001
@@ -40,7 +40,7 @@ function isCamlExceptionOrOpenVariant(e) {
 }
 
 exports.caml_set_oo_id = caml_set_oo_id;
-exports.get_id = get_id;
+exports.caml_fresh_oo_id = caml_fresh_oo_id;
 exports.create = create;
 exports.isCamlExceptionOrOpenVariant = isCamlExceptionOrOpenVariant;
 /* No side effect */