move caml_set_oo_id into caml_oo module

jscomp/core/js_of_lam_exception.ml

@@ -45,7 +45,3 @@ let make exception_str  : J.expression =
 
 
 
-(* TODO: only used in camlinternalOO, split it off as a separate module? *)
-let caml_set_oo_id args = 
-   E.runtime_call Js_runtime_modules.exceptions "caml_set_oo_id" args 
-

jscomp/core/js_of_lam_exception.mli

@@ -23,8 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-val caml_set_oo_id : 
-  J.expression list -> J.expression
 
 
 val make : J.expression  -> J.expression

jscomp/core/lam_dispatch_primitive.ml

@@ -584,7 +584,7 @@ let translate loc (prim_name : string)
       call Js_runtime_modules.caml_js_exceptions  
     | "caml_set_oo_id" (* needed in {!camlinternalOO.set_id} *)
       ->
-      Js_of_lam_exception.caml_set_oo_id args 
+      call Js_runtime_modules.oo
 
     | "caml_sys_get_argv" 
     (** TODO: refine

jscomp/runtime/block.ml

@@ -32,7 +32,7 @@ type obj = Caml_obj_extern.t
 (* Note that when we introduce it in {!Js_dump} 
    we need introduce dependency properly *)
 let __ tag block = 
-  Caml_obj_extern.set_tag block tag; block
+  Obj.set_tag block tag; block
 
 
 

jscomp/runtime/bs_stdlib_mini.mli

@@ -53,7 +53,14 @@ external ( -. ) : float -> float -> float = "%subfloat"
 external ( *. ) : float -> float -> float = "%mulfloat"
 external ( /. ) : float -> float -> float = "%divfloat"
 
-module Obj : sig   
+module Obj : sig
+  type t 
+  external field : t -> int -> t = "%obj_field" 
+  external set_field : t -> int -> t -> unit = "%obj_set_field"
+  external tag : t -> int = "caml_obj_tag" 
+  (* The compiler ensures (|0) operation *)
+  external set_tag : t -> int -> unit = "tag" [@@bs.set]  
+  external repr : 'a -> t = "%identity"
   external magic : 'a -> 'b = "%identity"  
 end 
 

jscomp/runtime/caml_chrome_debugger.ml

@@ -154,7 +154,7 @@ let __ = Block.__
 
 let variant meta tag xs =
   setupOnce () [@bs];
-  xs |. Caml_obj_extern.set_tag tag;
+  xs |. Obj.set_tag tag;
   xs |. addProp (cacheSymbol "BsVariant") {value = meta }
 
 let simpleVariant meta xs =

jscomp/runtime/caml_exceptions.ml

@@ -36,23 +36,7 @@ type t = {
    {[ a = caml_set_oo_id([248,"tag", caml_oo_last_id++]) ]}
 *)
 
-let%private id = ref 0
-
-
-(* see  #251
-   {[
-     CAMLprim value caml_set_oo_id (value obj) {
-       Field(obj, 1) = oo_last_id;
-       oo_last_id += 2;
-       return obj;
-     }
-
-   ]}*)
-let caml_set_oo_id (b : Caml_obj_extern.t)  : Caml_obj_extern.t = 
-  Caml_obj_extern.set_field (Caml_obj_extern.repr b) 1 (Caml_obj_extern.repr id.contents);
-  id .contents <-  id.contents  + 1; 
-  b
-(* FXIME: this is only relevant to OO module now *)
+let id = ref 0
 
 
 let create (str : string) : string = 

jscomp/runtime/caml_hash.ml

@@ -125,15 +125,15 @@ let caml_hash (count : int) _limit (seed : nativeint)
       else if Js.typeof obj = "undefined" then 
         ()
       else if Js.typeof obj = "symbol" then 
-        assert false (* TODO *)
+        ()
       else if Js.typeof obj = "function" then
         () 
       else 
         let size = Caml_obj_extern.size_of_t obj in 
         match Js.undefinedToOption size with
         | None -> ()
         | Some size -> 
-          let obj_tag = Caml_obj_extern.tag obj in
+          let obj_tag = Obj.tag obj in
           let tag = (size lsl 10) lor obj_tag in 
           if tag = 248 (* Obj.object_tag*) then 
             hash.contents <- caml_hash_mix_int hash.contents (Caml_nativeint_extern.of_int (oo_id  obj))
@@ -143,7 +143,7 @@ let caml_hash (count : int) _limit (seed : nativeint)
               let block = 
                 let v = size - 1 in if v <  num.contents then v else num.contents in 
               for i = 0 to block do
-                 push_back queue (Caml_obj_extern.field obj i ) 
+                 push_back queue (Obj.field obj i ) 
               done 
             end
     done;

jscomp/runtime/caml_js_exceptions.ml

@@ -10,7 +10,7 @@ exception Error of  t
    {[
      exception A of int;;
      let v = A  3 ;;
-     Caml_obj_extern.tag (Caml_obj_extern.field (Caml_obj_extern.repr v) 0);;
+     Obj.tag (Obj.field (Obj.repr v) 0);;
      - : int = 248
    ]}
    This function has to be in this module Since 

jscomp/runtime/caml_module.ml

@@ -65,7 +65,7 @@ let init_mod (loc : string * int * int) (shape : shape) =
         ) 
     | Module comps 
       -> 
-      let v = Caml_obj_extern.repr (module struct end :  Empty) in
+      let v = Obj.repr (module struct end :  Empty) in
       set_field struct_ idx v ;
       let len = Array.length comps in
       for i = 0 to len - 1 do
@@ -74,7 +74,7 @@ let init_mod (loc : string * int * int) (shape : shape) =
       done
     | Value v ->
       set_field struct_ idx v in
-  let res = Caml_obj_extern.repr (module struct end :  Empty) in
+  let res = Obj.repr (module struct end :  Empty) in
   let dummy_name = "dummy" in
   loop shape res dummy_name;
   get_field res dummy_name 

jscomp/runtime/caml_obj.ml

@@ -59,8 +59,8 @@ end
   block creation
 *)
 let caml_obj_block tag size = 
-  let v = Caml_obj_extern.repr (Caml_array_extern.new_uninitialized size) in 
-  Caml_obj_extern.set_tag  v tag ; 
+  let v = Obj.repr (Caml_array_extern.new_uninitialized size) in 
+  Obj.set_tag  v tag ; 
   v
 
 (**
@@ -116,7 +116,7 @@ let caml_obj_truncate (x : Caml_obj_extern.t) (new_size : int) =
   if len <> new_size  then
     begin
       for i = new_size  to len - 1  do
-        Caml_obj_extern.set_field x  i (Obj.magic 0)
+        Obj.set_field x  i (Obj.magic 0)
       done;
       Caml_obj_extern.set_length x new_size
     end
@@ -203,33 +203,33 @@ let rec caml_compare (a : Caml_obj_extern.t) (b : Caml_obj_extern.t) : int =
   | "number", "number" -> 
       Pervasives.compare (Obj.magic a : int) (Obj.magic b : int)
   | "number", _ ->        
-      if b == Caml_obj_extern.repr Js.null || Caml_obj_extern.tag b = 256 then 1 (* Some (Some ..) < x *)
+      if b == Obj.repr Js.null || Obj.tag b = 256 then 1 (* Some (Some ..) < x *)
       else 
         -1 (* Integer < Block in OCaml runtime GPR #1195, except Some.. *)
   | _, "number" -> 
-      if a == Caml_obj_extern.repr Js.null || Caml_obj_extern.tag a = 256 then -1
+      if a == Obj.repr Js.null || Obj.tag a = 256 then -1
       else 1
   | _ ->        
-      if a == Caml_obj_extern.repr Js.null then 
+      if a == Obj.repr Js.null then 
         (* [b] could not be null otherwise would equal *)
-        if Caml_obj_extern.tag b = 256 then 1 else -1
-     else if b == Caml_obj_extern.repr Js.null then 
-        if Caml_obj_extern.tag a = 256 then -1 else 1    
+        if Obj.tag b = 256 then 1 else -1
+     else if b == Obj.repr Js.null then 
+        if Obj.tag a = 256 then -1 else 1    
      else    
-        let tag_a = Caml_obj_extern.tag a in
-        let tag_b = Caml_obj_extern.tag b in
+        let tag_a = Obj.tag a in
+        let tag_b = Obj.tag b in
         (* double_array_tag: 254
         *)
         if tag_a = 256 then   
           if tag_b = 256 then 
-            Pervasives.compare (Obj.magic (Caml_obj_extern.field a 1) : int)
-             (Obj.magic (Caml_obj_extern.field b 1) : int)
+            Pervasives.compare (Obj.magic (Obj.field a 1) : int)
+             (Obj.magic (Obj.field b 1) : int)
             (* Some None < Some (Some None)) *)
           else  (* b could not be undefined/None *)
              (* Some None < Some ..*) 
              -1 
         else if tag_a = 248 (* object/exception *)  then
-          Pervasives.compare (Obj.magic (Caml_obj_extern.field a 1) : int) (Obj.magic (Caml_obj_extern.field b 1 ))
+          Pervasives.compare (Obj.magic (Obj.field a 1) : int) (Obj.magic (Obj.field b 1 ))
         else if tag_a = 251 (* abstract_tag *) then
           raise (Invalid_argument "equal: abstract value")
         else if tag_a <> tag_b then
@@ -251,19 +251,19 @@ and aux_same_length  (a : Caml_obj_extern.t) (b : Caml_obj_extern.t) i same_leng
   if i = same_length then
     0
   else
-    let res = caml_compare (Caml_obj_extern.field a i) (Caml_obj_extern.field b i) in
+    let res = caml_compare (Obj.field a i) (Obj.field b i) in
     if res <> 0 then res
     else aux_same_length  a b (i + 1) same_length
 and aux_length_a_short (a : Caml_obj_extern.t)  (b : Caml_obj_extern.t)  i short_length    =
   if i = short_length then -1
   else
-    let res = caml_compare (Caml_obj_extern.field a i) (Caml_obj_extern.field b i) in
+    let res = caml_compare (Obj.field a i) (Obj.field b i) in
     if res <> 0 then res
     else aux_length_a_short a b (i+1) short_length
 and aux_length_b_short (a : Caml_obj_extern.t) (b : Caml_obj_extern.t) i short_length =
   if i = short_length then 1
   else
-    let res = caml_compare (Caml_obj_extern.field a i) (Caml_obj_extern.field b i) in
+    let res = caml_compare (Obj.field a i) (Obj.field b i) in
     if res <> 0 then res
     else aux_length_b_short a b (i+1) short_length
 and aux_obj_compare (a: Caml_obj_extern.t) (b: Caml_obj_extern.t) =
@@ -314,23 +314,23 @@ let rec caml_equal (a : Caml_obj_extern.t) (b : Caml_obj_extern.t) : bool =
       if b_type = "number" || b_type = "undefined" || b == [%raw{|null|}] then false 
       else 
         (* [a] [b] could not be null, so it can not raise *)
-        let tag_a = Caml_obj_extern.tag a in
-        let tag_b = Caml_obj_extern.tag b in
+        let tag_a = Obj.tag a in
+        let tag_b = Obj.tag b in
         (* double_array_tag: 254
            forward_tag:250
         *)
         if tag_a = 250 then
-          caml_equal (Caml_obj_extern.field a 0) b
+          caml_equal (Obj.field a 0) b
         else if tag_b = 250 then
-          caml_equal a (Caml_obj_extern.field b 0)
+          caml_equal a (Obj.field b 0)
         else if tag_a = 248 (* object/exception *)  then
-          (Obj.magic  (Caml_obj_extern.field a 1)) ==  (Obj.magic (Caml_obj_extern.field b 1 ))
+          (Obj.magic  (Obj.field a 1)) ==  (Obj.magic (Obj.field b 1 ))
         else if tag_a = 251 (* abstract_tag *) then
           raise (Invalid_argument "equal: abstract value")
         else if tag_a <> tag_b then
           false
         else if tag_a = 256 then 
-          (Obj.magic (Caml_obj_extern.field a 1) : int) = Obj.magic (Caml_obj_extern.field b 1)
+          (Obj.magic (Obj.field a 1) : int) = Obj.magic (Obj.field b 1)
         else 
           let len_a = Caml_obj_extern.length a in
           let len_b = Caml_obj_extern.length b in
@@ -345,7 +345,7 @@ and aux_equal_length  (a : Caml_obj_extern.t) (b : Caml_obj_extern.t) i same_len
   if i = same_length then
     true
   else
-    caml_equal (Caml_obj_extern.field a i) (Caml_obj_extern.field b i)
+    caml_equal (Obj.field a i) (Obj.field b i)
     && aux_equal_length  a b (i + 1) same_length
 and aux_obj_equal (a: Caml_obj_extern.t) (b: Caml_obj_extern.t) =
   let result = ref true in
@@ -391,5 +391,5 @@ let caml_min (x : Caml_obj_extern.t) y =
 let caml_max (x : Caml_obj_extern.t) y =    
   if caml_compare x y >= 0 then x else y 
 
-let caml_obj_set_tag = Caml_obj_extern.set_tag  
+let caml_obj_set_tag = Obj.set_tag  
 

jscomp/runtime/caml_obj_extern.ml

@@ -24,20 +24,17 @@
 
 (** *)
 
-type t 
-external tag : t -> int = "caml_obj_tag" 
-external repr : 'a -> t = "%identity"
-external field : t -> int -> t = "%obj_field"
-external set_field : t -> int -> t -> unit = "%obj_set_field"
+type t = Bs_stdlib_mini.Obj.t
+
+
+
 
 external set_length : t -> int -> unit = "length" [@@bs.set]
 external length : t -> int = "#obj_length"
 
-(** The same as {!Obj.set_tag} *)
-external set_tag : t -> int -> unit = "tag" [@@bs.set]
 
 external size_of_t : t -> 'a Js.undefined =
   "length" [@@bs.get]
 
 
-external magic : 'a -> 'b = "%identity"
+

jscomp/runtime/caml_oo.ml

@@ -45,28 +45,46 @@ type closure
 let caml_methods_cache = 
     Caml_array_extern.make 1000 0 
 
+(* refer to {!CamlinternalOO.create_obj_opt}*)
 external get_methods : obj -> closure array =
   "%field0"
 
+(* see  #251
+   {[
+     CAMLprim value caml_set_oo_id (value obj) {
+       Field(obj, 1) = oo_last_id;
+       oo_last_id += 2;
+       return obj;
+     }
 
+   ]}*)
+let caml_set_oo_id (b : obj)  : obj = 
+  Obj.set_field 
+    (Obj.repr b) 1 
+    (Obj.repr Caml_exceptions.id.contents);
+  Caml_exceptions.id.contents <- Caml_exceptions.id.contents  + 1; 
+  b
+
+
+
 let caml_get_public_method 
     (obj : obj) 
     (tag : int) (cacheid  : int) : closure =
   let module Array = Caml_array_extern in 
   let meths = get_methods obj in (* the first field of object is mehods *)
   let offs =  caml_methods_cache.(cacheid) in
-  if (Caml_obj_extern.magic meths.(offs) : int) = tag then meths.(offs - 1)
+  if (Obj.magic meths.(offs) : int) = tag then meths.(offs - 1)
   else
     (* TODO: binary search *)    
     let rec aux (i : int) : int =     
       if i < 3 then assert false       
-      else if (Caml_obj_extern.magic meths.(i) : int) = tag then
+      else if (Obj.magic meths.(i) : int) = tag then
         begin        
           caml_methods_cache.(cacheid) <- i;         
           i
         end
       else         
         aux (i - 2)
     in
-    meths.(aux (Caml_obj_extern.magic ((Caml_obj_extern.magic meths.(0) : int) * 2 + 1) : int) - 1)     
+    meths.(aux (Obj.magic ((Obj.magic meths.(0) : int) * 2 + 1) : int) - 1)     
 

jscomp/runtime/caml_oo.mli

@@ -33,3 +33,5 @@ type obj
 type closure 
 
 val caml_get_public_method : obj -> int -> int -> closure
+
+val caml_set_oo_id : obj -> obj

jscomp/runtime/caml_option.ml

@@ -26,15 +26,15 @@
 
 let some ( x : Caml_obj_extern.t) : Caml_obj_extern.t = 
   if Obj.magic x =  None then 
-    (let block = Caml_obj_extern.repr (undefinedHeader, 0) in
-    Caml_obj_extern.set_tag block 256;
+    (let block = Obj.repr (undefinedHeader, 0) in
+    Obj.set_tag block 256;
     block)
   else 
-    if x != Caml_obj_extern.repr Js.null && fst (Obj.magic x ) == Caml_obj_extern.repr undefinedHeader then   
+    if x != Obj.repr Js.null && fst (Obj.magic x ) == Obj.repr undefinedHeader then   
       (
       let nid =   snd (Obj.magic x) + 1 in 
-      let block = Caml_obj_extern.repr (undefinedHeader, nid) in 
-       Caml_obj_extern.set_tag block 256;        
+      let block = Obj.repr (undefinedHeader, nid) in 
+       Obj.set_tag block 256;        
        block
       )
     else  x 
@@ -60,7 +60,7 @@ let null_to_opt (type t ) ( x : t Js.null) : t option =
 (** The input is already of [Some] form, [x] is not None, 
     make sure [x[0]] will not throw *)
 let valFromOption (x : Caml_obj_extern.t) : Caml_obj_extern.t =   
-  if  x != Caml_obj_extern.repr Js.null && fst (Obj.magic x)  == Caml_obj_extern.repr undefinedHeader 
+  if  x != Obj.repr Js.null && fst (Obj.magic x)  == Obj.repr undefinedHeader 
   then 
     let depth : int = snd  (Obj.magic x)  in 
     if depth = 0 then Obj.magic None
@@ -70,11 +70,11 @@ let valFromOption (x : Caml_obj_extern.t) : Caml_obj_extern.t =
 
 let option_get (x : 'a option) = 
   if x = None then Caml_undefined_extern.empty
-  else Obj.magic (valFromOption (Caml_obj_extern.repr x))
+  else Obj.magic (valFromOption (Obj.repr x))
 
 
 (** [input] is optional polymorphic variant *)  
 let option_get_unwrap (x : 'a option)  =
   if x = None then Caml_undefined_extern.empty
-  else Obj.magic (Caml_obj_extern.field (Caml_obj_extern.repr (valFromOption (Caml_obj_extern.repr x))) 1 )
+  else Obj.magic (Obj.field (Obj.repr (valFromOption (Obj.repr x))) 1 )