[Experiment][DoNotmerge] Represent ocaml records as js objects at runtime.

jscomp/core/j.ml

@@ -110,6 +110,7 @@ and expression_desc =
        since GC does not rely on it
      *)
   | Array_copy of expression (* shallow copy, like [x.slice] *)
+  | Object_assign of (expression option) * expression
   | Array_append of expression * expression (* For [caml_array_append]*)
   (* | Tag_ml_obj of expression *)
   | String_append of expression * expression 

jscomp/core/js_analyzer.ml

@@ -116,7 +116,8 @@ let rec no_side_effect_expression_desc (x : J.expression_desc)  =
     op <> Eq && no_side_effect a && no_side_effect b     
   | Math _ 
   | Array_of_size _
-  | Array_copy _ 
+  | Array_copy _
+  | Object_assign _ 
   (* | Tag_ml_obj _ *)
   | Int_of_boolean _ 
   | J.Anything_to_number _
@@ -268,7 +269,8 @@ let rec eq_expression
     | Char_to_int _ 
     | Is_null_undefined_to_boolean _ 
     | Array_of_size _
-    | Array_copy _ 
+    | Array_copy _
+    | Object_assign _ 
     | Array_append _ 
     | String_append _ 
     | Int_of_boolean _ 

jscomp/core/js_dump.ml

@@ -536,6 +536,21 @@ and
         cxt 
       )
 
+  | Object_assign (e1_opt, e2) -> 
+    P.group f 1 (fun _ ->
+        P.string f "Object.assign(";
+        let cxt = match e1_opt with
+          | Some e1 ->
+            expression 15 cxt f e1
+          | None ->
+            P.string f "{}";
+            cxt in
+        P.string f ", ";
+        let cxt = expression 15 cxt f e2 in
+        P.string f ")";
+        cxt 
+      )
+
   | Dump (level, el) -> 
     let obj = 
       match level with 
@@ -871,7 +886,7 @@ and
         (Blk_tuple | Blk_array | Blk_variant _ | Blk_record _ | Blk_na | Blk_module _
         |  Blk_constructor (_, 1) (* Sync up with {!Js_dump}*)
         ) 
-        -> expression_desc cxt l f  (Array (el, mutable_flag))
+        -> (* XXX *) expression_desc cxt l f  (Array (el, mutable_flag))
       (* TODO: for numbers like 248, 255 we can reverse engineer to make it 
          [Obj.xx_flag], but we can not do this in runtime libraries
       *)
@@ -1129,6 +1144,7 @@ and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t =
       | Call _ 
       | Array_append _ 
       | Array_copy _ 
+      | Object_assign _
       | Caml_block_tag _ 
       | Seq _
       | Dot _

jscomp/core/js_exp_make.ml

@@ -173,6 +173,21 @@ let make_block ?comment tag tag_info es mutable_flag : t =
     comment 
   }    
 
+let make_block ?comment tag tag_info es mutable_flag : t =
+  let comment = 
+    match comment with 
+    | None -> Lam_compile_util.comment_of_tag_info tag_info 
+    | _ -> comment in
+  match tag_info with
+  | Blk_record des ->
+    let property_map = List.mapi (fun i e -> (des.(i), e)) es in
+    {
+      expression_desc = Object property_map;
+      comment 
+    }
+  | _ -> make_block ?comment tag tag_info es mutable_flag 
+
+
 (* let uninitialized_object ?comment tag size : t = 
   { expression_desc = Caml_uninitialized_obj(tag,size); comment } *)
 
@@ -454,6 +469,9 @@ let array_append ?comment e el : t =
 let array_copy ?comment e : t = 
   { comment ; expression_desc = Array_copy e}
 
+let object_assign ?comment e1 e2 : t = 
+  { comment ; expression_desc = Object_assign (e1, e2) }
+
 (* Note that this return [undefined] in JS, 
     it should be wrapped to avoid leak [undefined] into 
     OCaml

jscomp/core/js_exp_make.mli

@@ -157,6 +157,7 @@ val char_to_int : unary_op
 val array_append : binary_op
 
 val array_copy : unary_op
+val object_assign : ?comment:string -> (t option) -> t -> t
 val string_append : binary_op
 (**
    When in ES6 mode, we can use Symbol to guarantee its uniquess,

jscomp/core/js_fold.ml

@@ -370,6 +370,9 @@ class virtual fold =
       | Is_null_undefined_to_boolean _x -> let o = o#expression _x in o
       | Array_of_size _x -> let o = o#expression _x in o
       | Array_copy _x -> let o = o#expression _x in o
+      | Object_assign (_x, _x_i1) ->
+          let o = o#option (fun o -> o#expression) _x in
+          let o = o#expression _x_i1 in o
       | Array_append (_x, _x_i1) ->
           let o = o#expression _x in let o = o#expression _x_i1 in o
       | String_append (_x, _x_i1) ->

jscomp/core/js_long.ml

@@ -55,6 +55,8 @@ let make ~lo ~hi =
     Immutable
 let get_lo x = E.index x 1l
 let get_hi x = E.index x 0l
+let get_lo x = E.dot x "lo"
+let get_hi x = E.dot x "hi"
 
 
 (* below should  not depend on layout *)

jscomp/core/js_map.ml

@@ -396,6 +396,9 @@ class virtual map =
           let _x = o#expression _x in Is_null_undefined_to_boolean _x
       | Array_of_size _x -> let _x = o#expression _x in Array_of_size _x
       | Array_copy _x -> let _x = o#expression _x in Array_copy _x
+      | Object_assign (_x, _x_i1) ->
+          let _x = o#option (fun o -> o#expression) _x in
+          let _x_i1 = o#expression _x_i1 in Object_assign (_x, _x_i1)
       | Array_append (_x, _x_i1) ->
           let _x = o#expression _x in
           let _x_i1 = o#expression _x_i1 in Array_append (_x, _x_i1)

jscomp/core/js_of_lam_block.ml

@@ -38,7 +38,7 @@ let make_block mutable_flag (tag_info : Lambda.tag_info) tag args  =
 
   match mutable_flag, tag_info with
   | _, Blk_array -> Js_of_lam_array.make_array mutable_flag  Pgenarray args
-  | _ , _ -> E.make_block tag tag_info args mutable_flag
+  | _ , _ -> (* XXX *) E.make_block tag tag_info args mutable_flag
   (* | _, (  Tuple | Variant _ ) -> (\** TODO: check with inline record *\) *)
   (*     E.arr Immutable *)
   (*       (E.small_int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
@@ -52,7 +52,10 @@ let field field_info e i =
   match field_info with 
   | Lambda.Fld_na -> 
     E.index e i 
-  | Lambda.Fld_record s 
+  | Lambda.Fld_record s ->
+    if s = "contents"
+    then E.index ~comment:s e i
+    else E.dot e s
   | Lambda.Fld_module s 
     -> E.index ~comment:s e i
 
@@ -69,7 +72,14 @@ let set_field field_info e i e0 =
     ?comment e i 
    ~assigned_value:e0 
 
-
+let set_field field_info e i e0 =
+  match field_info with
+  | Lambda.Fld_set_na ->
+    set_field field_info e i e0
+  | Fld_record_set s ->
+    if s = "contents"
+    then set_field field_info e i e0
+    else E.assign (E.dot e s) e0
 
 
 

jscomp/core/js_of_lam_record.ml

@@ -54,5 +54,5 @@ let field field_info  e i =
    this is due to we encode record as an array, it is going to change
    if we have another encoding       
 *)    
-let copy  = E.array_copy
+let copy ?comment  = E.object_assign ?comment None
 

jscomp/core/lam_analysis.ml

@@ -436,6 +436,18 @@ let eq_record_representation ( p : Types.record_representation) ( p1 : Types.rec
     Actually this patten is quite common in GADT, people have to write duplicated code 
     due to the type system restriction
 *)
+
+let eq_field_dbg_info (lhs : Lambda.field_dbg_info) (rhs : Lambda.field_dbg_info) =
+  match lhs with
+  | Fld_na -> rhs = Fld_na
+  | Fld_record s1 -> (match rhs with Fld_record s2 -> s1 = s2 | _ -> false)
+  | Fld_module s1 -> (match rhs with Fld_module s2 -> s1 = s2 | _ -> false)
+
+let eq_set_field_dbg_info (lhs : Lambda.set_field_dbg_info) (rhs : Lambda.set_field_dbg_info) =
+  match lhs with
+  | Fld_set_na -> rhs = Fld_set_na
+  | Fld_record_set s1 -> (match rhs with Fld_record_set s2 -> s1 = s2 | _ -> false)
+
 let rec 
   eq_lambda (l1 : Lam.t) (l2 : Lam.t) =
   match l1 with 
@@ -548,12 +560,12 @@ and eq_primitive ( lhs : Lam.primitive) (rhs : Lam.primitive) =
   | Pcaml_obj_length -> rhs = Pcaml_obj_length
   | Pcaml_obj_set_length -> rhs = Pcaml_obj_set_length
   | Pccall {prim_name = n0 ;  prim_native_name = nn0} ->  (match rhs with Pccall {prim_name = n1; prim_native_name = nn1} ->    n0 = n1 && nn0 = nn1 | _ -> false )    
-  | Pfield (n0, _dbg_info0) ->  (match rhs with Pfield (n1, _dbg_info1) ->  n0 = n1  | _ -> false )    
-  | Psetfield(i0, b0, _dbg_info0) -> (match rhs with Psetfield(i1, b1, _dbg_info1) ->  i0 = i1 && b0 = b1 | _ -> false)
+  | Pfield (n0, dbg_info0) ->  (match rhs with Pfield (n1, dbg_info1) ->  n0 = n1 && eq_field_dbg_info dbg_info0 dbg_info1 | _ -> false )    
+  | Psetfield(i0, b0, dbg_info0) -> (match rhs with Psetfield(i1, b1, dbg_info1) ->  i0 = i1 && b0 = b1 && eq_set_field_dbg_info dbg_info0 dbg_info1 | _ -> false)
   | Pglobal_exception ident -> (match rhs with Pglobal_exception ident2 ->  Ident.same ident ident2 | _ -> false )
   | Pmakeblock (i, _tag_info, mutable_flag) -> (match rhs with Pmakeblock(i1,_,mutable_flag1) ->  i = i1 && mutable_flag = mutable_flag1  | _ -> false)
-  | Pfloatfield (i0,_dbg_info) -> (match rhs with Pfloatfield (i1,_) -> i0 = i1   | _ -> false)
-  | Psetfloatfield (i0,_dbg_info) ->  (match rhs with Psetfloatfield(i1,_) -> i0 = i1  | _ -> false)
+  | Pfloatfield (i0, dbg_info0) -> (match rhs with Pfloatfield (i1, dbg_info1) -> i0 = i1 && eq_field_dbg_info dbg_info0 dbg_info1 | _ -> false)
+  | Psetfloatfield (i0, dbg_info0) ->  (match rhs with Psetfloatfield(i1, dbg_info1) -> i0 = i1 && eq_set_field_dbg_info dbg_info0 dbg_info1 | _ -> false)
   | Pduprecord (record_repesentation0,i1) -> (match rhs with Pduprecord(record_repesentation1,i2) ->  eq_record_representation record_repesentation0 record_repesentation1 && i1 = i2    | _ -> false)
   | Pjs_call (prim_name, arg_types, ffi) ->  ( match rhs with Pjs_call(prim_name1, arg_types1,ffi1) -> prim_name = prim_name1 && arg_types = arg_types1 && ffi = ffi1 | _ -> false)
   | Pjs_object_create obj_create -> (match rhs with Pjs_object_create obj_create1 -> obj_create = obj_create1 | _ -> false )

jscomp/core/lam_compile.ml

@@ -295,7 +295,8 @@ and compile_recursive_let ~all_bindings
     Js_output.output_of_expression (Declare (Alias, id))
       ReturnFalse arg result, [] 
   | Lprim {primitive = Pmakeblock (0, _, _) ; args =  ls}
-    when List.for_all (fun (x : Lam.t) -> 
+    when (* XXX *)false &&
+     List.for_all (fun (x : Lam.t) -> 
         match x with 
         | Lvar pid -> 
           Ident.same pid id  || 
@@ -335,9 +336,14 @@ and compile_recursive_let ~all_bindings
         Js_output.make  
           (Ext_list.append
              b   
-             [S.exp
+             [
+               S.exp (E.object_assign (Some (E.var id)) v)
+             (* XXX
+               S.exp
                 (E.runtime_call Js_runtime_modules.obj_runtime "caml_update_dummy" 
-                   [ E.var id;  v])]),
+                   [ E.var id;  v])
+              *)
+                   ]),
         [id]
       (* S.define ~kind:Variable id (E.arr Mutable [])::  *)
       | _ -> assert false 

jscomp/core/lam_compile_util.ml

@@ -45,7 +45,7 @@ let comment_of_tag_info  (x : Lambda.tag_info) =
   | Blk_constructor (n, _) -> Some n 
   | Blk_tuple -> Some "tuple"
   | Blk_variant x -> Some ("`" ^  x)
-  | Blk_record _ -> Some "record"
+  | Blk_record _ -> Some "record" (* XXX *)
 
   | Blk_array -> Some "array"
   | Blk_module _ ->  

jscomp/runtime/caml_lexer.ml

@@ -103,25 +103,26 @@ function caml_lex_array(s) {
  */
 function $$caml_lex_engine(tbl, start_state, lexbuf) {
     // Lexing.lexbuf
-    var lex_buffer = 1;
-    var lex_buffer_len = 2;
-    var lex_start_pos = 4;
-    var lex_curr_pos = 5;
-    var lex_last_pos = 6;
-    var lex_last_action = 7;
-    var lex_eof_reached = 8;
+    var lex_buffer = 'lex_buffer';
+    var lex_buffer_len = 'lex_buffer_len';
+    var lex_start_pos = 'lex_start_pos';
+    var lex_curr_pos = 'lex_curr_pos';
+    var lex_last_pos = 'lex_last_pos';
+    var lex_last_action = 'lex_last_action';
+    var lex_eof_reached = 'lex_eof_reached';
     // Lexing.lex_tables
-    var lex_base = 0;
-    var lex_backtrk = 1;
-    var lex_default = 2;
-    var lex_trans = 3;
-    var lex_check = 4;
-    if (!tbl.lex_default) {
+    var lex_base = 'lex_base';
+    var lex_backtrk = 'lex_backtrk';
+    var lex_default = 'lex_default';
+    var lex_trans = 'lex_trans';
+    var lex_check = 'lex_check';
+    if (!tbl.preprocessed) {
         tbl.lex_base = caml_lex_array(tbl[lex_base]);
         tbl.lex_backtrk = caml_lex_array(tbl[lex_backtrk]);
         tbl.lex_check = caml_lex_array(tbl[lex_check]);
         tbl.lex_trans = caml_lex_array(tbl[lex_trans]);
         tbl.lex_default = caml_lex_array(tbl[lex_default]);
+        tbl.preprocessed = true;
     }
     var c;
     var state = start_state;
@@ -237,43 +238,38 @@ function caml_lex_run_tag(s, i, mem) {
  */
 function $$caml_new_lex_engine(tbl, start_state, lexbuf) {
     // Lexing.lexbuf
-    var lex_buffer = 1;
-    var lex_buffer_len = 2;
-    var lex_start_pos = 4;
-    var lex_curr_pos = 5;
-    var lex_last_pos = 6;
-    var lex_last_action = 7;
-    var lex_eof_reached = 8;
-    var lex_mem = 9;
+    var lex_buffer = 'lex_buffer';
+    var lex_buffer_len = 'lex_buffer_len';
+    var lex_start_pos = 'lex_start_pos';
+    var lex_curr_pos = 'lex_curr_pos';
+    var lex_last_pos = 'lex_last_pos';
+    var lex_last_action = 'lex_last_action';
+    var lex_eof_reached = 'lex_eof_reached';
+    var lex_mem = 'lex_mem';
     // Lexing.lex_tables
-    var lex_base = 0;
-    var lex_backtrk = 1;
-    var lex_default = 2;
-    var lex_trans = 3;
-    var lex_check = 4;
-    var lex_base_code = 5;
-    var lex_backtrk_code = 6;
-    var lex_default_code = 7;
-    var lex_trans_code = 8;
-    var lex_check_code = 9;
-    var lex_code = 10;
-    if (!tbl.lex_default) {
+    var lex_base = 'lex_base';
+    var lex_backtrk = 'lex_backtrk';
+    var lex_default = 'lex_default';
+    var lex_trans = 'lex_trans';
+    var lex_check = 'lex_check';
+    var lex_base_code = 'lex_base_code';
+    var lex_backtrk_code = 'lex_backtrk_code';
+    var lex_default_code = 'lex_default_code';
+    var lex_trans_code = 'lex_trans_code';
+    var lex_check_code = 'lex_check_code';
+    var lex_code = 'lex_code';
+    if (!tbl.preprocessed) {
         tbl.lex_base = caml_lex_array(tbl[lex_base]);
         tbl.lex_backtrk = caml_lex_array(tbl[lex_backtrk]);
         tbl.lex_check = caml_lex_array(tbl[lex_check]);
         tbl.lex_trans = caml_lex_array(tbl[lex_trans]);
         tbl.lex_default = caml_lex_array(tbl[lex_default]);
-    }
-    if (!tbl.lex_default_code) {
         tbl.lex_base_code = caml_lex_array(tbl[lex_base_code]);
         tbl.lex_backtrk_code = caml_lex_array(tbl[lex_backtrk_code]);
         tbl.lex_check_code = caml_lex_array(tbl[lex_check_code]);
         tbl.lex_trans_code = caml_lex_array(tbl[lex_trans_code]);
         tbl.lex_default_code = caml_lex_array(tbl[lex_default_code]);
-    }
-    if (tbl.lex_code == null) {
-        //tbl.lex_code = caml_bytes_of_string(tbl[lex_code]);
-        tbl.lex_code = (tbl[lex_code]);
+        tbl.preprocessed = true;
     }
     var c, state = start_state;
     //var buffer = caml_bytes_of_string(lexbuf[lex_buffer]);