Merge pull request #4423 from BuckleScript/change_names

fix #4407 compatibility layer between debug mode and non-debug mode

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/core/lam_convert.ml

@@ -32,6 +32,10 @@ let prim = Lam.prim
 let lam_extension_id loc (head : Lam.t) =
   prim ~primitive:lam_caml_id ~args:[head] loc    
 
+let lazy_block_info : Lam_tag_info.t = 
+  Blk_record 
+    [|Literals.lazy_done; 
+      Literals.lazy_val|]  
 
 let unbox_extension info (args : Lam.t list) mutable_flag loc =
     prim ~primitive:(Pmakeblock (0,info,mutable_flag)) ~args loc 
@@ -281,15 +285,15 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
           [ Lam.const Const_js_true ; 
            result
           ] in 
-        prim ~primitive:(Pmakeblock (tag,Blk_record [|"RE_LAZY_DONE";"value"|],Mutable)) ~args loc  
+        prim ~primitive:(Pmakeblock (tag,lazy_block_info,Mutable)) ~args loc  
       | [computation] -> 
         let args = 
           [ Lam.const Const_js_false ; 
             (* FIXME: arity 0 does not get proper supported*)
             prim ~primitive:(Pjs_fn_make 0) ~args:[Lam.function_ ~arity:1 ~params:[Ident.create "param"] ~body:computation] 
             loc             
           ] in 
-        prim ~primitive:(Pmakeblock (tag,Blk_record [|"RE_LAZY_DONE";"value"|],Mutable)) ~args loc  
+        prim ~primitive:(Pmakeblock (tag,lazy_block_info,Mutable)) ~args loc  
 
       | _ -> assert false
       end

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/ext/literals.ml

@@ -142,8 +142,11 @@ let ns_sep = "-"
 let exception_id = "RE_EXN_ID"
 
 let polyvar_hash = "HASH"
-let polyvar_value = "value"
+let polyvar_value = "VAL"
 
 let cons = "::"
 let hd = "hd"
-let tl = "tl"
+let tl = "tl"
+
+let lazy_done = "LAZY_DONE"
+let lazy_val = "VAL"

jscomp/ext/literals.mli

@@ -144,4 +144,6 @@ val polyvar_value : string
 
 val cons : string
 val hd : string
-val tl : string
+val tl : string
+val lazy_done : string
+val lazy_val : string