generate symbol fields for debugging purpose

Author: bobzhang

jscomp/core/js_dump.ml

@@ -50,7 +50,7 @@
 
 *)
 
-
+let name_symbol = Js_op.Symbol_name
 module P = Ext_pp
 module E = Js_exp_make
 (* module S = Js_stmt_make *)
@@ -125,11 +125,11 @@ let exn_block_as_obj
     | _ -> assert false in   
   Object (
     if stack then   
-      Ext_list.mapi_append el (fun i e -> field_name i, e)
-        ["Error", 
+      Ext_list.mapi_append el (fun i e -> Js_op.Lit (field_name i), e)
+        [ Js_op.Lit "Error", 
          E.new_ (E.js_global "Error") []
         ]
-    else Ext_list.mapi  el (fun i e -> field_name i, e)
+    else Ext_list.mapi  el (fun i e -> Js_op.Lit (field_name i), e)
   )
 
 let rec iter_lst cxt (f : P.t) ls element inter = 
@@ -812,10 +812,13 @@ and expression_desc cxt ~(level:int) f x : cxt  =
          E.runtime_call Js_runtime_modules.option "some" [e])
   | Caml_block(el,_, _, Blk_module fields) ->        
       expression_desc cxt ~level f (Object (
-        (Ext_list.map_combine fields el Ext_ident.convert)))
+        (Ext_list.map_combine 
+          fields el 
+          (fun  x -> Js_op.Lit (Ext_ident.convert x) ))))
   (*name convention of Record is slight different from modules*)        
   | Caml_block(el,_, _, Blk_record fields) ->        
-      expression_desc cxt ~level f (Object ((Ext_list.combine_array fields el )))      
+      expression_desc cxt ~level f (Object 
+        ((Ext_list.combine_array fields el  (fun i -> Js_op.Lit i))))      
 
   | Caml_block(el,_,_, Blk_poly_var name) ->
     begin match el with 
@@ -825,13 +828,13 @@ and expression_desc cxt ~(level:int) f x : cxt  =
           ~level 
           f 
           (Object 
-             ((Literals.polyvar_hash, 
+             ((Js_op.Lit Literals.polyvar_hash, 
                if !Js_config.debug then hash
                else {hash with comment = Some name}
               ) ::
-              (Literals.polyvar_value, value) ::
+              (Js_op.Lit Literals.polyvar_value, value) ::
               if !Js_config.debug then 
-                ["name", E.str name]
+                [name_symbol, E.str name]
               else []
              )          
           )
@@ -843,11 +846,11 @@ and expression_desc cxt ~(level:int) f x : cxt  =
     let objs = 
       let tails =   
         Ext_list.combine_array_append p.fields el      
-          (if !Js_config.debug then ["NAME",E.str p.name]
+          (if !Js_config.debug then [name_symbol,E.str p.name]
            else []
-          ) in 
+          ) (fun i -> Js_op.Lit i) in 
       if p.num_nonconst = 1 then tails
-      else (L.tag,
+      else (Js_op.Lit L.tag,
         if !Js_config.debug then tag else {tag with comment = Some p.name}) :: tails in 
     if p.num_nonconst = 1 && not !Js_config.debug then 
       pp_comment_option f (Some p.name);
@@ -858,17 +861,17 @@ and expression_desc cxt ~(level:int) f x : cxt  =
       let tails =   
         Ext_list.mapi_append el (fun i e -> 
           (match is_cons, i with 
-          | true,  0 -> Literals.hd
-          | true,  1 -> Literals.tl 
+          | true,  0 -> Js_op.Lit Literals.hd
+          | true,  1 -> Js_op.Lit Literals.tl 
           | _ ->
-            "_" ^ string_of_int i) , e )
+          Js_op.Lit ("_" ^ string_of_int i)) , e )
           (if !Js_config.debug then 
-             ["NAME", E.str p.name]
+             [name_symbol, E.str p.name]
            else []) in         
       if p.num_nonconst = 1 then       
         tails
       else         
-        (L.tag,
+        (Js_op.Lit L.tag,
           if !Js_config.debug then tag else {tag with comment = Some p.name}) :: tails
     in 
     if p.num_nonconst = 1 && not !Js_config.debug 

jscomp/core/js_dump_property.ml

@@ -87,7 +87,12 @@ let property_access f s =
       Js_dump_string.pp_string f s
     end
 
-let property_key f s =     
-  if obj_property_no_need_quot s then 
-    P.string f s 
-  else Js_dump_string.pp_string f s  
+let property_key f (s : J.property_name) =     
+  match s with 
+  | Lit s ->
+    if obj_property_no_need_quot s then 
+      P.string f s 
+    else Js_dump_string.pp_string f s  
+ | Symbol_name -> 
+    P.string f 
+       {|[Symbol.for("name")]|}

jscomp/core/js_dump_property.mli

@@ -31,5 +31,5 @@ val property_access :
 
 val property_key : 
   Ext_pp.t -> 
-  string -> 
+  J.property_name -> 
   unit 

jscomp/core/js_op.ml

@@ -146,14 +146,10 @@ type property = Lam_compat.let_kind =
   | Variable
 
 
-type property_name = (* private *)
-  (* TODO: FIXME [caml_uninitialized_obj] seems to be a bug*)
-  (* | Key of *)
-   string
-  (* | Int_key of int  *)
-  (* | Tag  *)
-  (* | Length *)
-
+type property_name = 
+   | Lit of string
+   | Symbol_name
+  
 type 'a access = 
   | Getter
   | Setter

jscomp/core/lam_compile_external_obj.ml

@@ -48,7 +48,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params)  (args : J.express
     | [] , []  ->  [], [], []
     | {obj_arg_label = Obj_label {name = label;  }; obj_arg_type = Arg_cst cst } :: labels  , args -> 
       let accs, eff, assign = aux labels args in 
-      (label, Lam_compile_const.translate_arg_cst cst )::accs, eff, assign 
+      (Js_op.Lit label, Lam_compile_const.translate_arg_cst cst )::accs, eff, assign 
     (* | {obj_arg_label = EmptyCst _ } :: rest  , args -> assert false  *)
     | {obj_arg_label = Obj_empty  }::labels, arg::args 
       ->  (* unit type*)
@@ -63,7 +63,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params)  (args : J.express
         | Splice2 _ 
         | Splice0 -> assert false
         | Splice1 x ->
-          (label, x) :: accs , Ext_list.append new_eff  eff , assign          
+          (Js_op.Lit label, x) :: accs , Ext_list.append new_eff  eff , assign          
       end (* evaluation order is undefined *)
 
     | ({obj_arg_label = Obj_optional {name = label}; obj_arg_type } as arg_kind)::labels, arg::args 
@@ -77,7 +77,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params)  (args : J.express
           | Splice2 _
           | Splice0 -> assert false 
           | Splice1 x ->
-            (label, x) :: accs , Ext_list.append new_eff  eff , assign
+            (Js_op.Lit label, x) :: accs , Ext_list.append new_eff  eff , assign
           end )
         ~not_sure:(fun _ -> accs, eff , (arg_kind,arg)::assign )
     | {obj_arg_label = Obj_empty  | Obj_label _ | Obj_optional _  } :: _ , [] -> assert false 

jscomp/ext/ext_list.ml

@@ -76,22 +76,22 @@ let rec map_combine l1 l2 f =
   | (_, _) -> 
     invalid_arg "Ext_list.map_combine"
 
-let rec combine_array_unsafe arr l i j acc =    
+let rec combine_array_unsafe arr l i j acc f =    
   if i = j then acc
   else 
     match l with
     | [] -> invalid_arg "Ext_list.combine"
     | h :: tl ->
-      (Array.unsafe_get arr i , h) ::
-      combine_array_unsafe arr tl (i + 1) j acc
+      (f (Array.unsafe_get arr i) , h) ::
+      combine_array_unsafe arr tl (i + 1) j acc f
 
-let combine_array_append arr l acc = 
+let combine_array_append arr l acc f = 
   let len = Array.length arr in
-  combine_array_unsafe arr l 0 len acc
+  combine_array_unsafe arr l 0 len acc f
 
-let combine_array arr l = 
+let combine_array arr l f = 
   let len = Array.length arr in
-  combine_array_unsafe arr l 0 len []  
+  combine_array_unsafe arr l 0 len [] f 
 
 let rec map_split_opt 
   (xs : 'a list)  (f : 'a -> 'b option * 'c option) 

jscomp/ext/ext_list.mli

@@ -37,13 +37,15 @@ val map_combine :
 val combine_array:
   'a array ->
   'b list -> 
-  ('a * 'b) list   
+  ('a -> 'c) ->
+  ('c * 'b) list   
 
 val combine_array_append:
   'a array ->
   'b list ->
-  ('a * 'b) list -> 
-  ('a * 'b) list   
+  ('c * 'b) list -> 
+  ('a -> 'c) ->
+  ('c * 'b) list   
 
 val has_string :   
   string list ->

jscomp/test/build.ninja

@@ -142,6 +142,7 @@ build test/cps_test.cmi test/cps_test.cmj : cc test/cps_test.ml | test/mt.cmj $s
 build test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj : cc test/cross_module_inline_test.ml | $stdlib
 build test/custom_error_test.cmi test/custom_error_test.cmj : cc test/custom_error_test.ml | $stdlib
 build test/debug_keep_test.cmi test/debug_keep_test.cmj : cc test/debug_keep_test.ml | $stdlib
+build test/debug_mode_value.cmi test/debug_mode_value.cmj : cc test/debug_mode_value.ml | $stdlib
 build test/debug_tmp.cmi test/debug_tmp.cmj : cc test/debug_tmp.ml | $stdlib
 build test/debugger_test.cmi test/debugger_test.cmj : cc test/debugger_test.ml | $stdlib
 build test/default_export_test.cmi test/default_export_test.cmj : cc test/default_export_test.ml | $stdlib
@@ -321,6 +322,7 @@ build test/gpr_4069_test.cmi test/gpr_4069_test.cmj : cc test/gpr_4069_test.ml |
 build test/gpr_4265_test.cmi test/gpr_4265_test.cmj : cc test/gpr_4265_test.ml | test/mt.cmj $stdlib
 build test/gpr_4274_test.cmi test/gpr_4274_test.cmj : cc test/gpr_4274_test.ml | $stdlib
 build test/gpr_4280_test.cmi test/gpr_4280_test.cmj : cc test/gpr_4280_test.ml | test/mt.cmj $stdlib
+build test/gpr_4407_test.cmi test/gpr_4407_test.cmj : cc test/gpr_4407_test.ml | test/debug_mode_value.cmj test/mt.cmj $stdlib
 build test/gpr_441.cmi test/gpr_441.cmj : cc test/gpr_441.ml | $stdlib
 build test/gpr_459_test.cmi test/gpr_459_test.cmj : cc test/gpr_459_test.ml | test/mt.cmj $stdlib
 build test/gpr_627_test.cmi test/gpr_627_test.cmj : cc test/gpr_627_test.ml | test/mt.cmj $stdlib

jscomp/test/debug_mode_value.js

@@ -0,0 +1,11 @@
+'use strict';
+
+
+var u = {
+  _0: 1,
+  _1: 2,
+  [Symbol.for("name")]: "A"
+};
+
+exports.u = u;
+/* No side effect */

jscomp/test/debug_mode_value.ml

@@ -0,0 +1,14 @@
+
+[@@@bs.config {
+  flags = [|
+  (* "-drawlambda"; *)
+  (* "-dlambda";  *)
+  (* "-dtypedtree"; *)
+  (* "-bs-diagnose" *)
+  "-bs-g"  
+  |]
+}]
+
+type t = A of int * int 
+
+let u  = A (1,2)