From 7fa9bf2f1bf8a6319d6ff63c30ac5c26a215380a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 16 Mar 2018 18:01:46 +0100 Subject: [PATCH 1/5] [Experiment] Represent ocaml records as js objects at runtime. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Experiment with representing ocaml records as js objects at runtime, to assess the number of changes involved to support a debug mode whether the field names are visible. For example `let r = {x=12; y=34}` becomes ``` var a = /* record */{ x: 12, y: 34 }; ``` Field access and update are also supported. This PR changes the core functions plus a few cases that rely on the assumption that arrays are used at runtime. A few known missing thigs are: - generic compare always returns 0, as it expects blocks with tag and length - accessing the content of refs with .contents does not work - the lexer assumes an array representation - surely more But for self-contained code, it’s possible to run some experiments already. --- jscomp/core/j.ml | 1 + jscomp/core/js_analyzer.ml | 6 ++++-- jscomp/core/js_dump.ml | 18 +++++++++++++++++- jscomp/core/js_exp_make.ml | 18 ++++++++++++++++++ jscomp/core/js_exp_make.mli | 1 + jscomp/core/js_fold.ml | 3 +++ jscomp/core/js_long.ml | 2 ++ jscomp/core/js_map.ml | 3 +++ jscomp/core/js_of_lam_block.ml | 10 ++++++++-- jscomp/core/js_of_lam_record.ml | 2 +- jscomp/core/lam_compile.ml | 12 +++++++++--- jscomp/core/lam_compile_util.ml | 2 +- jscomp/stdlib/hashtbl.ml | 2 +- jscomp/stdlib/stream.ml | 12 ++++++++++++ 14 files changed, 81 insertions(+), 11 deletions(-) diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index 2b55ca0f19..9cf12f2aa5 100644 --- a/jscomp/core/j.ml +++ b/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 diff --git a/jscomp/core/js_analyzer.ml b/jscomp/core/js_analyzer.ml index f3c279bdc9..aa69efc228 100644 --- a/jscomp/core/js_analyzer.ml +++ b/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 _ diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index e794e072ee..e820de4bd9 100644 --- a/jscomp/core/js_dump.ml +++ b/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 _ diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index d53b80d606..46b3bb6ba9 100644 --- a/jscomp/core/js_exp_make.ml +++ b/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 diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 7f99e7fd5a..1b85771fe1 100644 --- a/jscomp/core/js_exp_make.mli +++ b/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, diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml index e7c7100282..f682b1ec40 100644 --- a/jscomp/core/js_fold.ml +++ b/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) -> diff --git a/jscomp/core/js_long.ml b/jscomp/core/js_long.ml index e31dca65be..b8235095c7 100644 --- a/jscomp/core/js_long.ml +++ b/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 *) diff --git a/jscomp/core/js_map.ml b/jscomp/core/js_map.ml index e5e5bb0e23..90e0725a28 100644 --- a/jscomp/core/js_map.ml +++ b/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) diff --git a/jscomp/core/js_of_lam_block.ml b/jscomp/core/js_of_lam_block.ml index 92c1a673f2..55a08d66d8 100644 --- a/jscomp/core/js_of_lam_block.ml +++ b/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 *) @@ -53,6 +53,7 @@ let field field_info e i = | Lambda.Fld_na -> E.index e i | Lambda.Fld_record s + -> E.dot e s | Lambda.Fld_module s -> E.index ~comment:s e i @@ -69,7 +70,12 @@ 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 -> + E.assign (E.dot e s) e0 diff --git a/jscomp/core/js_of_lam_record.ml b/jscomp/core/js_of_lam_record.ml index bd9ae9b09d..38536a1dea 100644 --- a/jscomp/core/js_of_lam_record.ml +++ b/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 diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 905e3ab89c..b5e4517e8a 100644 --- a/jscomp/core/lam_compile.ml +++ b/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 diff --git a/jscomp/core/lam_compile_util.ml b/jscomp/core/lam_compile_util.ml index 14a8d5567a..6e12285bc0 100644 --- a/jscomp/core/lam_compile_util.ml +++ b/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 _ -> diff --git a/jscomp/stdlib/hashtbl.ml b/jscomp/stdlib/hashtbl.ml index 22c3380c2d..5b97c8a2f0 100644 --- a/jscomp/stdlib/hashtbl.ml +++ b/jscomp/stdlib/hashtbl.ml @@ -114,7 +114,7 @@ let resize indexfun h = let key_index h key = (* compatibility with old hash tables *) - if Obj.size (Obj.repr h) >= 3 + if (* XXX *) true || Obj.size (Obj.repr h) >= 3 then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1) else (old_hash_param 10 100 key) mod (Array.length h.data) diff --git a/jscomp/stdlib/stream.ml b/jscomp/stdlib/stream.ml index 751c741a85..a5a66e4add 100644 --- a/jscomp/stdlib/stream.ml +++ b/jscomp/stdlib/stream.ml @@ -32,10 +32,22 @@ exception Error of string;; external count : 'a t -> int = "%field0";; external set_count : 'a t -> int -> unit = "%setfield0";; + let set_data (s : 'a t) (d : 'a data) = Obj.set_field (Obj.repr s) 1 (Obj.repr d) ;; +let count {count} = count +module Mutable = struct + type 'a t = { mutable count : int; mutable data : 'a data } +end +let set_count (s : 'a t) n = + (Obj.magic s).Mutable.count <- n +let set_data (s : 'a t) (d : 'a data) = + (Obj.magic s).Mutable.data <- d + + + let fill_buff b = b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0 ;; From 0c8f1409aef4c86f36580222b256a871e187a756 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 22 Mar 2018 19:13:20 +0100 Subject: [PATCH 2/5] Adapt parser and lexer. --- jscomp/runtime/caml_lexer.ml | 74 +++++++++++++++++------------------ jscomp/runtime/caml_parser.ml | 59 ++++++++++++++-------------- lib/js/caml_lexer.js | 74 +++++++++++++++++------------------ lib/js/caml_parser.js | 59 ++++++++++++++-------------- 4 files changed, 130 insertions(+), 136 deletions(-) diff --git a/jscomp/runtime/caml_lexer.ml b/jscomp/runtime/caml_lexer.ml index aa9194dde5..501c73d708 100644 --- a/jscomp/runtime/caml_lexer.ml +++ b/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]); diff --git a/jscomp/runtime/caml_parser.ml b/jscomp/runtime/caml_parser.ml index fcf0e167b2..c0476451b6 100644 --- a/jscomp/runtime/caml_parser.ml +++ b/jscomp/runtime/caml_parser.ml @@ -163,40 +163,40 @@ function $$caml_parse_engine(tables /* parser_table */, env /* parser_env */, cm //var shift_recover = 9; //var reduce = 10; // Parsing.parser_env - var env_s_stack = 0; // array - var env_v_stack = 1; // array - var env_symb_start_stack = 2; // array - var env_symb_end_stack = 3; // array - var env_stacksize = 4; - var env_stackbase = 5; - var env_curr_char = 6; - var env_lval = 7; // Obj.t - var env_symb_start = 8; // position - var env_symb_end = 9; // position - var env_asp = 10; - var env_rule_len = 11; - var env_rule_number = 12; - var env_sp = 13; - var env_state = 14; - var env_errflag = 15; + var env_s_stack = 's_stack'; // array + var env_v_stack = 'v_stack'; // array + var env_symb_start_stack = 'symb_start_stack'; // array + var env_symb_end_stack = 'symb_end_stack'; // array + var env_stacksize = 'stacksize'; + var env_stackbase = 'stackbase'; + var env_curr_char = 'curr_char'; + var env_lval = 'lval'; // Obj.t + var env_symb_start = 'symb_start'; // position + var env_symb_end = 'symb_end'; // position + var env_asp = 'asp'; + var env_rule_len = 'rule_len'; + var env_rule_number = 'rule_number'; + var env_sp = 'sp'; + var env_state = 'state'; + var env_errflag = 'errflag'; // Parsing.parse_tables // var _tbl_actions = 1; - var tbl_transl_const = 1; // array - var tbl_transl_block = 2; // array - var tbl_lhs = 3; - var tbl_len = 4; - var tbl_defred = 5; - var tbl_dgoto = 6; - var tbl_sindex = 7; - var tbl_rindex = 8; - var tbl_gindex = 9; - var tbl_tablesize = 10; - var tbl_table = 11; - var tbl_check = 12; + var tbl_transl_const = 'transl_const'; // array + var tbl_transl_block = 'transl_block'; // array + var tbl_lhs = 'lhs'; + var tbl_len = 'len'; + var tbl_defred = 'defred'; + var tbl_dgoto = 'dgoto'; + var tbl_sindex = 'sindex'; + var tbl_rindex = 'rindex'; + var tbl_gindex = 'gindex'; + var tbl_tablesize = 'tablesize'; + var tbl_table = 'table'; + var tbl_check = 'check'; // var _tbl_error_function = 14; // var _tbl_names_const = 15; // var _tbl_names_block = 16; - if (!tables.dgoto) { + if (!tables.preprocessed) { tables.defred = caml_lex_array(tables[tbl_defred]); tables.sindex = caml_lex_array(tables[tbl_sindex]); tables.check = caml_lex_array(tables[tbl_check]); @@ -206,6 +206,7 @@ function $$caml_parse_engine(tables /* parser_table */, env /* parser_env */, cm tables.lhs = caml_lex_array(tables[tbl_lhs]); tables.gindex = caml_lex_array(tables[tbl_gindex]); tables.dgoto = caml_lex_array(tables[tbl_dgoto]); + tables.preprocessed = true; } var res; var n, n1, n2, state1; diff --git a/lib/js/caml_lexer.js b/lib/js/caml_lexer.js index 5422ce4551..d9b9e0fb74 100644 --- a/lib/js/caml_lexer.js +++ b/lib/js/caml_lexer.js @@ -77,25 +77,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; @@ -211,43 +212,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]); diff --git a/lib/js/caml_parser.js b/lib/js/caml_parser.js index 26f1abbdeb..c1677aef3f 100644 --- a/lib/js/caml_parser.js +++ b/lib/js/caml_parser.js @@ -134,40 +134,40 @@ function $$caml_parse_engine(tables /* parser_table */, env /* parser_env */, cm //var shift_recover = 9; //var reduce = 10; // Parsing.parser_env - var env_s_stack = 0; // array - var env_v_stack = 1; // array - var env_symb_start_stack = 2; // array - var env_symb_end_stack = 3; // array - var env_stacksize = 4; - var env_stackbase = 5; - var env_curr_char = 6; - var env_lval = 7; // Obj.t - var env_symb_start = 8; // position - var env_symb_end = 9; // position - var env_asp = 10; - var env_rule_len = 11; - var env_rule_number = 12; - var env_sp = 13; - var env_state = 14; - var env_errflag = 15; + var env_s_stack = 's_stack'; // array + var env_v_stack = 'v_stack'; // array + var env_symb_start_stack = 'symb_start_stack'; // array + var env_symb_end_stack = 'symb_end_stack'; // array + var env_stacksize = 'stacksize'; + var env_stackbase = 'stackbase'; + var env_curr_char = 'curr_char'; + var env_lval = 'lval'; // Obj.t + var env_symb_start = 'symb_start'; // position + var env_symb_end = 'symb_end'; // position + var env_asp = 'asp'; + var env_rule_len = 'rule_len'; + var env_rule_number = 'rule_number'; + var env_sp = 'sp'; + var env_state = 'state'; + var env_errflag = 'errflag'; // Parsing.parse_tables // var _tbl_actions = 1; - var tbl_transl_const = 1; // array - var tbl_transl_block = 2; // array - var tbl_lhs = 3; - var tbl_len = 4; - var tbl_defred = 5; - var tbl_dgoto = 6; - var tbl_sindex = 7; - var tbl_rindex = 8; - var tbl_gindex = 9; - var tbl_tablesize = 10; - var tbl_table = 11; - var tbl_check = 12; + var tbl_transl_const = 'transl_const'; // array + var tbl_transl_block = 'transl_block'; // array + var tbl_lhs = 'lhs'; + var tbl_len = 'len'; + var tbl_defred = 'defred'; + var tbl_dgoto = 'dgoto'; + var tbl_sindex = 'sindex'; + var tbl_rindex = 'rindex'; + var tbl_gindex = 'gindex'; + var tbl_tablesize = 'tablesize'; + var tbl_table = 'table'; + var tbl_check = 'check'; // var _tbl_error_function = 14; // var _tbl_names_const = 15; // var _tbl_names_block = 16; - if (!tables.dgoto) { + if (!tables.preprocessed) { tables.defred = caml_lex_array(tables[tbl_defred]); tables.sindex = caml_lex_array(tables[tbl_sindex]); tables.check = caml_lex_array(tables[tbl_check]); @@ -177,6 +177,7 @@ function $$caml_parse_engine(tables /* parser_table */, env /* parser_env */, cm tables.lhs = caml_lex_array(tables[tbl_lhs]); tables.gindex = caml_lex_array(tables[tbl_gindex]); tables.dgoto = caml_lex_array(tables[tbl_dgoto]); + tables.preprocessed = true; } var res; var n, n1, n2, state1; From d7e3e376a469227ee5a702e8c82ff4c91b07916c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 23 Mar 2018 15:33:03 +0100 Subject: [PATCH 3/5] Import polymorphic compare from https://github.com/BuckleScript/bucklescript/pull/2657 --- jscomp/runtime/caml_obj.ml | 56 +++++++++++++++- lib/js/caml_obj.js | 131 ++++++++++++++++++++++++++++--------- 2 files changed, 156 insertions(+), 31 deletions(-) diff --git a/jscomp/runtime/caml_obj.ml b/jscomp/runtime/caml_obj.ml index 8586d3a4a2..66ea1c682d 100644 --- a/jscomp/runtime/caml_obj.ml +++ b/jscomp/runtime/caml_obj.ml @@ -131,6 +131,18 @@ let caml_update_dummy x y = type 'a selector = 'a -> 'a -> 'a +module O = struct + external object_ : Obj.t = "Object" [@@bs.val] + let is_object : Obj.t -> bool = fun x -> (Obj.magic x)##constructor == object_ + type keys + type key = Obj.t + external keys : Obj.t -> keys = "Object.keys" [@@bs.val] + external length : keys -> int = "%array_length" + external sort : unit -> unit [@bs.meth] = "" [@@bs.val] + let sort (keys:keys) : unit = (Obj.magic keys)##sort () + external get_key : keys -> int -> key = "%array_unsafe_get" + external get_value : Obj.t -> key -> Obj.t = "%array_unsafe_get" +end let unsafe_js_compare x y = if x == y then 0 else @@ -198,6 +210,19 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int = else let len_a = Bs_obj.length a in let len_b = Bs_obj.length b in + if len_a = 0 && len_b = 0 && O.is_object a && O.is_object b then + begin + let keys_a = O.keys a in + let keys_b = O.keys b in + O.sort(keys_a); + O.sort(keys_b); + let len_a = O.length keys_a in + let len_b = O.length keys_b in + let min_len = min len_a len_b in + let default_res = len_a - len_b in + aux_obj_compare a keys_a b keys_b 0 min_len default_res + end + else if len_a = len_b then aux_same_length a b 0 len_a else if len_a < len_b then @@ -223,6 +248,16 @@ and aux_length_b_short (a : Obj.t) (b : Obj.t) i short_length = 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: Obj.t) keys_a (b: Obj.t) keys_b i min_len default_res = + if i = min_len then default_res + else + let key_a = O.get_key keys_a i in + let key_b = O.get_key keys_b i in + let res = caml_compare key_a key_b in + if res <> 0 then res else + let res = caml_compare (O.get_value a key_a) (O.get_value b key_b) in + if res <> 0 then res + else aux_obj_compare a keys_a b keys_b (i+1) min_len default_res type eq = Obj.t -> Obj.t -> bool @@ -267,6 +302,18 @@ let rec caml_equal (a : Obj.t) (b : Obj.t) : bool = else let len_a = Bs_obj.length a in let len_b = Bs_obj.length b in + if len_a = 0 && len_b = 0 && O.is_object a && O.is_object b then + begin + let keys_a = O.keys a in + let keys_b = O.keys b in + let len_a = O.length keys_a in + let len_b = O.length keys_b in + len_a = len_b && + let () = O.sort(keys_a) in + let () = O.sort(keys_b) in + aux_obj_equal a keys_a b keys_b 0 len_a + end + else if len_a = len_b then aux_equal_length a b 0 len_a else false @@ -276,7 +323,14 @@ and aux_equal_length (a : Obj.t) (b : Obj.t) i same_length = else caml_equal (Obj.field a i) (Obj.field b i) && aux_equal_length a b (i + 1) same_length - +and aux_obj_equal (a: Obj.t) keys_a (b: Obj.t) keys_b i length = + if i = length then true + else + let key_a = O.get_key keys_a i in + let key_b = O.get_key keys_b i in + caml_equal key_a key_b && + caml_equal (O.get_value a key_a) (O.get_value b key_b) && + aux_obj_equal a keys_a b keys_b (i+1) length let caml_equal_null (x : Obj.t) (y : Obj.t Js.null) = match Js.nullToOption y with diff --git a/lib/js/caml_obj.js b/lib/js/caml_obj.js index 4335bdcda9..fa6349c49d 100644 --- a/lib/js/caml_obj.js +++ b/lib/js/caml_obj.js @@ -120,39 +120,57 @@ function caml_compare(_a, _b) { } else { var len_a = a.length | 0; var len_b = b.length | 0; - if (len_a === len_b) { + if (len_a === 0 && len_b === 0 && a.constructor === Object && b.constructor === Object) { + var keys_a = Object.keys(a); + var keys_b = Object.keys(b); + keys_a.sort(); + keys_b.sort(); + var len_a$1 = keys_a.length; + var len_b$1 = keys_b.length; + var min_len = len_a$1 < len_b$1 ? len_a$1 : len_b$1; + var default_res = len_a$1 - len_b$1 | 0; var a$1 = a; + var keys_a$1 = keys_a; var b$1 = b; + var keys_b$1 = keys_b; var _i = 0; - var same_length = len_a; + var min_len$1 = min_len; + var default_res$1 = default_res; while(true) { var i = _i; - if (i === same_length) { - return 0; + if (i === min_len$1) { + return default_res$1; } else { - var res = caml_compare(a$1[i], b$1[i]); + var key_a = keys_a$1[i]; + var key_b = keys_b$1[i]; + var res = caml_compare(key_a, key_b); if (res !== 0) { return res; } else { - _i = i + 1 | 0; - continue ; - + var res$1 = caml_compare(a$1[key_a], b$1[key_b]); + if (res$1 !== 0) { + return res$1; + } else { + _i = i + 1 | 0; + continue ; + + } } } }; - } else if (len_a < len_b) { + } else if (len_a === len_b) { var a$2 = a; var b$2 = b; var _i$1 = 0; - var short_length = len_a; + var same_length = len_a; while(true) { var i$1 = _i$1; - if (i$1 === short_length) { - return -1; + if (i$1 === same_length) { + return 0; } else { - var res$1 = caml_compare(a$2[i$1], b$2[i$1]); - if (res$1 !== 0) { - return res$1; + var res$2 = caml_compare(a$2[i$1], b$2[i$1]); + if (res$2 !== 0) { + return res$2; } else { _i$1 = i$1 + 1 | 0; continue ; @@ -160,23 +178,43 @@ function caml_compare(_a, _b) { } } }; - } else { + } else if (len_a < len_b) { var a$3 = a; var b$3 = b; var _i$2 = 0; - var short_length$1 = len_b; + var short_length = len_a; while(true) { var i$2 = _i$2; - if (i$2 === short_length$1) { - return 1; + if (i$2 === short_length) { + return -1; } else { - var res$2 = caml_compare(a$3[i$2], b$3[i$2]); - if (res$2 !== 0) { - return res$2; + var res$3 = caml_compare(a$3[i$2], b$3[i$2]); + if (res$3 !== 0) { + return res$3; } else { _i$2 = i$2 + 1 | 0; continue ; + } + } + }; + } else { + var a$4 = a; + var b$4 = b; + var _i$3 = 0; + var short_length$1 = len_b; + while(true) { + var i$3 = _i$3; + if (i$3 === short_length$1) { + return 1; + } else { + var res$4 = caml_compare(a$4[i$3], b$4[i$3]); + if (res$4 !== 0) { + return res$4; + } else { + _i$3 = i$3 + 1 | 0; + continue ; + } } }; @@ -230,17 +268,50 @@ function caml_equal(_a, _b) { } else { var len_a = a.length | 0; var len_b = b.length | 0; - if (len_a === len_b) { - var a$1 = a; - var b$1 = b; - var _i = 0; + if (len_a === 0 && len_b === 0 && a.constructor === Object && b.constructor === Object) { + var keys_a = Object.keys(a); + var keys_b = Object.keys(b); + var len_a$1 = keys_a.length; + var len_b$1 = keys_b.length; + if (len_a$1 === len_b$1) { + keys_a.sort(); + keys_b.sort(); + var a$1 = a; + var keys_a$1 = keys_a; + var b$1 = b; + var keys_b$1 = keys_b; + var _i = 0; + var length = len_a$1; + while(true) { + var i = _i; + if (i === length) { + return /* true */1; + } else { + var key_a = keys_a$1[i]; + var key_b = keys_b$1[i]; + if (caml_equal(key_a, key_b) && caml_equal(a$1[key_a], b$1[key_b])) { + _i = i + 1 | 0; + continue ; + + } else { + return /* false */0; + } + } + }; + } else { + return /* false */0; + } + } else if (len_a === len_b) { + var a$2 = a; + var b$2 = b; + var _i$1 = 0; var same_length = len_a; while(true) { - var i = _i; - if (i === same_length) { + var i$1 = _i$1; + if (i$1 === same_length) { return /* true */1; - } else if (caml_equal(a$1[i], b$1[i])) { - _i = i + 1 | 0; + } else if (caml_equal(a$2[i$1], b$2[i$1])) { + _i$1 = i$1 + 1 | 0; continue ; } else { From 68a6b61ee7472804ebc4e403de34cd2e7169b763 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 23 Mar 2018 16:29:19 +0100 Subject: [PATCH 4/5] =?UTF-8?q?Special-case=20=E2=80=9Ccontents=E2=80=9D?= =?UTF-8?q?=20field=20as=20it=E2=80=99s=20used=20for=20references.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit References are hardcoded early on to use arrays. Special-case access to the “contents” field to use array access. --- jscomp/core/js_of_lam_block.ml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/jscomp/core/js_of_lam_block.ml b/jscomp/core/js_of_lam_block.ml index 55a08d66d8..adb639fd44 100644 --- a/jscomp/core/js_of_lam_block.ml +++ b/jscomp/core/js_of_lam_block.ml @@ -52,8 +52,10 @@ let field field_info e i = match field_info with | Lambda.Fld_na -> E.index e i - | Lambda.Fld_record s - -> E.dot e 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 @@ -75,7 +77,9 @@ let set_field field_info e i e0 = | Lambda.Fld_set_na -> set_field field_info e i e0 | Fld_record_set s -> - E.assign (E.dot e s) e0 + if s = "contents" + then set_field field_info e i e0 + else E.assign (E.dot e s) e0 From efe40701a5c6157d4401d001db77f20e0eedb376 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 23 Mar 2018 19:50:19 +0100 Subject: [PATCH 5/5] Fix switch optimization incompatible with record access. The 3 cases in this function are collapsed into one: ``` let getval = let f x = x+1 in function | A {a} -> f a | B {b} -> f b | C {c} -> f c ``` This is because the index access in the 3 cases is the same: the first index. When switching to the object representation, this optimization is unsound. Enriched comparison of lambda primitives to distinguish access to fields with different names, even though they might have the same index. With this, all tests pass. --- jscomp/core/lam_analysis.ml | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml index e25a0400b5..92b9c30ba8 100644 --- a/jscomp/core/lam_analysis.ml +++ b/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 )