Merge pull request #4404 from BuckleScript/precise_field_info

precise & complete meta field info

Author: bobzhang

jscomp/core/js_of_lam_block.ml

@@ -56,6 +56,7 @@ let field (field_info : Lam_compat.field_dbg_info) e i =
   | Fld_poly_var_content 
   | Fld_record_inline _
   | Fld_variant
+  | Fld_array
     -> 
     E.array_index_by_int  
       ?comment:(Lam_compat.str_of_field_info field_info) e i 

jscomp/core/lam_compat.ml

@@ -171,10 +171,11 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_poly_var_content
   | Fld_extension
   | Fld_variant
-
+  | Fld_array 
 let str_of_field_info (x : field_dbg_info) : string option =  
   match x with 
-  | Fld_na  s -> Some s
+  | Fld_na  s -> if s = "" then None else Some s
+  | Fld_array
   | Fld_extension
   | Fld_variant
   | Fld_poly_var_tag 

jscomp/core/lam_compat.mli

@@ -80,6 +80,7 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_poly_var_content
   | Fld_extension 
   | Fld_variant
+  | Fld_array
 
 val str_of_field_info : 
   field_dbg_info -> 

jscomp/main/builtin_cmi_datasets.ml

@@ -41,8 +41,6 @@ external not : bool -> bool = "%boolnot"
 
 external raise : exn -> 'a = "%raise"
 external ignore : 'a -> unit = "%ignore"
-external fst : 'a * 'b -> 'a = "%field0"
-external snd : 'a * 'b -> 'b = "%field1"
 external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
 external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
 
@@ -61,6 +59,7 @@ module Obj : sig
   (* The compiler ensures (|0) operation *)
   external set_tag : t -> int -> unit = "tag" [@@bs.set]  
   external repr : 'a -> t = "%identity"
+  external obj : t -> 'a = "%identity"
   external magic : 'a -> 'b = "%identity"  
   external size : t -> int = "#obj_length"
 end 

jscomp/main/builtin_cmj_datasets.ml

@@ -79,8 +79,6 @@ let unsafe_pop (q : 'a t) =
 external ( +~ ) : nativeint -> nativeint -> nativeint =
    "caml_int32_add"
 
-(*ATTENTION: refer {!Oo.id} *)
-external oo_id : Obj.t -> int  = "%field1"
 
 open Caml_hash_primitive
 
@@ -134,7 +132,8 @@ let caml_hash (count : int) _limit (seed : nativeint)
           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))
+            hash.contents <- caml_hash_mix_int hash.contents 
+              (Caml_nativeint_extern.of_int (Obj.obj (Obj.field obj 1) : int))
           else 
             begin 
               hash.contents <- caml_hash_mix_int hash.contents (Caml_nativeint_extern.of_int tag) ;

jscomp/runtime/bs_stdlib_mini.mli

@@ -522,8 +522,8 @@ let float_of_bits (Int64 x : t) : float =
    Float64_array.unsafe_get (Float64_array.fromBuffer (Int32_array.buffer int32)) 0 *)
 
 let  bits_of_float : float -> t  = fun x -> 
-    let buf = ([%raw{|function(x){return new Int32Array(new Float64Array([x]).buffer)}|}] : _ -> _) x in 
-    mk ~lo:(fst buf) ~hi:(snd buf)
+    let lo,hi = ([%raw{|function(x){return new Int32Array(new Float64Array([x]).buffer)}|}] : _ -> _) x in 
+    mk ~lo ~hi
   (* let to_nat (x : int32) = x |> Caml_int32_extern.to_int |>  Caml_nativeint_extern.of_int in
 
   let u = Float64_array.make [| x |] in

jscomp/runtime/caml_hash.ml

@@ -46,8 +46,8 @@ 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
    {[
@@ -71,7 +71,7 @@ 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 meths : closure array = Obj.obj (Obj.field (Obj.repr obj) 0) in (* the first field of object is mehods *)
   let offs =  caml_methods_cache.(cacheid) in
   if (Obj.magic meths.(offs) : int) = tag then meths.(offs - 1)
   else

jscomp/runtime/caml_int64.ml

@@ -22,17 +22,17 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
- let undefinedHeader = [| |]
+let undefinedHeader = [| |]
 
 let some ( x : Obj.t) : Obj.t = 
   if Obj.magic x =  None then 
     (let block = Obj.repr (undefinedHeader, 0) in
     Obj.set_tag block 256;
     block)
   else 
-    if x != Obj.repr Js.null && fst (Obj.magic x ) == Obj.repr undefinedHeader then   
+    if x != Obj.repr Js.null && match (Obj.magic x ) with (x,_) -> x == Obj.repr undefinedHeader then   
       (
-      let nid =   snd (Obj.magic x) + 1 in 
+      let nid =   match (Obj.magic x) with (_,x) -> x + 1 in 
       let block = Obj.repr (undefinedHeader, nid) in 
        Obj.set_tag block 256;        
        block
@@ -60,11 +60,11 @@ 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 : Obj.t) : Obj.t =   
-  if  x != Obj.repr Js.null && fst (Obj.magic x)  == Obj.repr undefinedHeader 
+  if  x != Obj.repr Js.null && match (Obj.magic x) with (x,_) -> x == Obj.repr undefinedHeader 
   then 
-    let depth : int = snd  (Obj.magic x)  in 
+    (match (Obj.magic x) with (_, (depth : int)) ->  
     if depth = 0 then Obj.magic None
-    else Obj.magic (undefinedHeader, depth - 1)
+    else Obj.magic (undefinedHeader, depth - 1))
   else Obj.magic x