From 77bb5d2a26b243863a9f2853561a3de8bf365cc7 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Wed, 20 Jan 2021 10:17:14 +0800 Subject: [PATCH 1/5] Finish the optimization around visitor pattern using objects --- jscomp/core/js_fold.ml | 37 +++---- jscomp/core/js_iter.ml | 43 +++++---- jscomp/core/js_map.ml | 38 +++----- lib/4.06.1/unstable/js_compiler.ml | 118 +++++++++++------------ lib/4.06.1/unstable/js_refmt_compiler.ml | 118 +++++++++++------------ lib/4.06.1/whole_compiler.ml | 118 +++++++++++------------ ocaml-tree/fold_maker.js | 32 ++++-- ocaml-tree/iter_maker.js | 33 +++++-- ocaml-tree/map_maker.js | 36 ++++--- 9 files changed, 286 insertions(+), 287 deletions(-) diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml index a23c023d8b..5403dd2edd 100644 --- a/jscomp/core/js_fold.ml +++ b/jscomp/core/js_fold.ml @@ -1,11 +1,12 @@ open J let [@inline] unknown _self _ = _self + let [@inline] option sub self = fun v -> + match v with + | None -> self + | Some x -> sub x class fold = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type = - fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = fun _f_a -> @@ -22,7 +23,6 @@ let _self = _self#ident _x0 in _self |Qualified ( _x0,_x1) -> let _self = _self#module_id _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident @@ -85,11 +85,10 @@ let _self = _self#expression _x1 in _self |Static_index ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in @@ -138,12 +137,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = _self#option (fun _self -> _self#label) _x0 in +let _self = option (_self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _self = option (_self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -159,36 +158,32 @@ let _self = _self#expression _x0 in |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (_self#block) _self _x2 in _self |Debugger -> _self -method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self -method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self +method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self +method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = _self#option (fun _self -> _self#expression) _x1 in _self +let _self = option (_self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self -method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self method block : block -> 'self_type = _self#list (fun _self -> _self#statement) method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in -let _self = _self#required_modules _x1 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +let _self = _self#required_modules _x1 in _self end \ No newline at end of file diff --git a/jscomp/core/js_iter.ml b/jscomp/core/js_iter.ml index 5d5d4048f5..25ee7f1bc5 100644 --- a/jscomp/core/js_iter.ml +++ b/jscomp/core/js_iter.ml @@ -1,31 +1,32 @@ open J - let unknown _self _ = () + + let option sub = fun v -> + match v with + | None -> () + | Some v -> sub v class iter = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> unit) -> 'a option -> unit = - fun _f_a -> function | None -> () | Some _x -> _f_a _self _x method list : 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 - method label : label -> unit = unknown _self + method label : label -> unit = ignore method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) -method ident : ident -> unit = unknown _self +method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function | Id ( _x0) -> begin _self#ident _x0 end |Qualified ( _x0,_x1) -> - begin _self#module_id _x0;_self#option (fun _self -> unknown _self) _x1 end + begin _self#module_id _x0 end method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = unknown _self +method for_direction : for_direction -> unit = ignore method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) -method length_object : length_object -> unit = unknown _self +method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> begin _self#expression _x0;_self#length_object _x1 end @@ -57,9 +58,9 @@ method expression_desc : expression_desc -> unit = function |Array_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#option (fun _self -> unknown _self) _x2 end + begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;_self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> @@ -92,31 +93,31 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin _self#option (fun _self -> _self#label) _x0;_self#expression _x1;_self#block _x2 end + begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin _self#option (fun _self -> _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;_self#option (fun _self -> fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end |Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;_self#option (fun _self -> _self#expression) _x1 end +method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end +method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0;_self#option (fun _self -> unknown _self) _x2 end +method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end method block : block -> unit = _self#list (fun _self -> _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1;_self#option (fun _self -> unknown _self) _x2 end +method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end \ No newline at end of file diff --git a/jscomp/core/js_map.ml b/jscomp/core/js_map.ml index 502c83e411..4b4bda839a 100644 --- a/jscomp/core/js_map.ml +++ b/jscomp/core/js_map.ml @@ -1,12 +1,12 @@ open J let unknown : 'a. 'a -> 'a = fun x -> x +let option sub = fun v -> + match v with + | None -> None + | Some v -> Some (sub v) class map = object ((_self : 'self_type)) -method option : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option = - fun _f_a -> - function | None -> None | Some _x -> let _x = _f_a _self _x in Some _x method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = fun _f_a -> @@ -25,7 +25,6 @@ let _x0 = _self#ident _x0 in Id ( _x0) |Qualified ( _x0,_x1) -> let _x0 = _self#module_id _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident @@ -88,11 +87,10 @@ let _x1 = _self#expression _x1 in Array_index ( _x0,_x1) |Static_index ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in @@ -141,12 +139,12 @@ let _x1 = _self#block _x1 in let _x2 = _self#block _x2 in If ( _x0,_x1,_x2) |While ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#option (fun _self -> _self#label) _x0 in +let _x0 = option (_self#label) _x0 in let _x1 = _self#expression _x1 in let _x2 = _self#block _x2 in While ( _x0,_x1,_x2,_x3) |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _x0 = option (_self#for_ident_expression) _x0 in let _x1 = _self#finish_ident_expression _x1 in let _x2 = _self#for_ident _x2 in let _x3 = _self#for_direction _x3 in @@ -162,35 +160,31 @@ Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> let _x0 = _self#expression _x0 in Throw ( _x0) |Try ( _x0,_x1,_x2) -> let _x0 = _self#block _x0 in -let _x1 = _self#option (fun _self -> fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in +let _x2 = option (_self#block) _x2 in Try ( _x0,_x1,_x2) |Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {statement_desc = _x0;comment = _x1} +method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} +method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = _self#option (fun _self -> _self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} +let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {switch_body = _x0;should_break = _x1;comment = _x2} +method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} method block : block -> block = _self#list (fun _self -> _self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {program = _x0;modules = _x1;side_effect = _x2} +let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} end diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index e524f0ab9a..ab8cbd6b62 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -86506,32 +86506,33 @@ module Js_iter #1 "js_iter.ml" open J - let unknown _self _ = () + + let option sub = fun v -> + match v with + | None -> () + | Some v -> sub v class iter = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> unit) -> 'a option -> unit = - fun _f_a -> function | None -> () | Some _x -> _f_a _self _x method list : 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 - method label : label -> unit = unknown _self + method label : label -> unit = ignore method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) -method ident : ident -> unit = unknown _self +method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function | Id ( _x0) -> begin _self#ident _x0 end |Qualified ( _x0,_x1) -> - begin _self#module_id _x0;_self#option (fun _self -> unknown _self) _x1 end + begin _self#module_id _x0 end method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = unknown _self +method for_direction : for_direction -> unit = ignore method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) -method length_object : length_object -> unit = unknown _self +method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> begin _self#expression _x0;_self#length_object _x1 end @@ -86563,9 +86564,9 @@ method expression_desc : expression_desc -> unit = function |Array_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#option (fun _self -> unknown _self) _x2 end + begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;_self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> @@ -86598,32 +86599,32 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin _self#option (fun _self -> _self#label) _x0;_self#expression _x1;_self#block _x2 end + begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin _self#option (fun _self -> _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;_self#option (fun _self -> fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end |Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;_self#option (fun _self -> _self#expression) _x1 end +method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end +method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0;_self#option (fun _self -> unknown _self) _x2 end +method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end method block : block -> unit = _self#list (fun _self -> _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1;_self#option (fun _self -> unknown _self) _x2 end +method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end end @@ -101364,12 +101365,12 @@ module Js_map open J let unknown : 'a. 'a -> 'a = fun x -> x +let option sub = fun v -> + match v with + | None -> None + | Some v -> Some (sub v) class map = object ((_self : 'self_type)) -method option : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option = - fun _f_a -> - function | None -> None | Some _x -> let _x = _f_a _self _x in Some _x method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = fun _f_a -> @@ -101388,7 +101389,6 @@ let _x0 = _self#ident _x0 in Id ( _x0) |Qualified ( _x0,_x1) -> let _x0 = _self#module_id _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident @@ -101451,11 +101451,10 @@ let _x1 = _self#expression _x1 in Array_index ( _x0,_x1) |Static_index ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in @@ -101504,12 +101503,12 @@ let _x1 = _self#block _x1 in let _x2 = _self#block _x2 in If ( _x0,_x1,_x2) |While ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#option (fun _self -> _self#label) _x0 in +let _x0 = option (_self#label) _x0 in let _x1 = _self#expression _x1 in let _x2 = _self#block _x2 in While ( _x0,_x1,_x2,_x3) |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _x0 = option (_self#for_ident_expression) _x0 in let _x1 = _self#finish_ident_expression _x1 in let _x2 = _self#for_ident _x2 in let _x3 = _self#for_direction _x3 in @@ -101525,37 +101524,33 @@ Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> let _x0 = _self#expression _x0 in Throw ( _x0) |Try ( _x0,_x1,_x2) -> let _x0 = _self#block _x0 in -let _x1 = _self#option (fun _self -> fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in +let _x2 = option (_self#block) _x2 in Try ( _x0,_x1,_x2) |Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {statement_desc = _x0;comment = _x1} +method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} +method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = _self#option (fun _self -> _self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} +let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {switch_body = _x0;should_break = _x1;comment = _x2} +method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} method block : block -> block = _self#list (fun _self -> _self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {program = _x0;modules = _x1;side_effect = _x2} +let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} end end @@ -102028,11 +102023,12 @@ module Js_fold open J let [@inline] unknown _self _ = _self + let [@inline] option sub self = fun v -> + match v with + | None -> self + | Some x -> sub x class fold = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type = - fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = fun _f_a -> @@ -102049,7 +102045,6 @@ let _self = _self#ident _x0 in _self |Qualified ( _x0,_x1) -> let _self = _self#module_id _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident @@ -102112,11 +102107,10 @@ let _self = _self#expression _x1 in _self |Static_index ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in @@ -102165,12 +102159,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = _self#option (fun _self -> _self#label) _x0 in +let _self = option (_self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _self = option (_self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -102186,37 +102180,33 @@ let _self = _self#expression _x0 in |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (_self#block) _self _x2 in _self |Debugger -> _self -method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self -method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self +method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self +method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = _self#option (fun _self -> _self#expression) _x1 in _self +let _self = option (_self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self -method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self method block : block -> 'self_type = _self#list (fun _self -> _self#statement) method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in -let _self = _self#required_modules _x1 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +let _self = _self#required_modules _x1 in _self end end diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 31fb2a2ef8..5cb0cbf1f7 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -86506,32 +86506,33 @@ module Js_iter #1 "js_iter.ml" open J - let unknown _self _ = () + + let option sub = fun v -> + match v with + | None -> () + | Some v -> sub v class iter = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> unit) -> 'a option -> unit = - fun _f_a -> function | None -> () | Some _x -> _f_a _self _x method list : 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 - method label : label -> unit = unknown _self + method label : label -> unit = ignore method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) -method ident : ident -> unit = unknown _self +method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function | Id ( _x0) -> begin _self#ident _x0 end |Qualified ( _x0,_x1) -> - begin _self#module_id _x0;_self#option (fun _self -> unknown _self) _x1 end + begin _self#module_id _x0 end method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = unknown _self +method for_direction : for_direction -> unit = ignore method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) -method length_object : length_object -> unit = unknown _self +method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> begin _self#expression _x0;_self#length_object _x1 end @@ -86563,9 +86564,9 @@ method expression_desc : expression_desc -> unit = function |Array_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#option (fun _self -> unknown _self) _x2 end + begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;_self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> @@ -86598,32 +86599,32 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin _self#option (fun _self -> _self#label) _x0;_self#expression _x1;_self#block _x2 end + begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin _self#option (fun _self -> _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;_self#option (fun _self -> fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end |Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;_self#option (fun _self -> _self#expression) _x1 end +method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end +method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0;_self#option (fun _self -> unknown _self) _x2 end +method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end method block : block -> unit = _self#list (fun _self -> _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1;_self#option (fun _self -> unknown _self) _x2 end +method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end end @@ -101364,12 +101365,12 @@ module Js_map open J let unknown : 'a. 'a -> 'a = fun x -> x +let option sub = fun v -> + match v with + | None -> None + | Some v -> Some (sub v) class map = object ((_self : 'self_type)) -method option : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option = - fun _f_a -> - function | None -> None | Some _x -> let _x = _f_a _self _x in Some _x method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = fun _f_a -> @@ -101388,7 +101389,6 @@ let _x0 = _self#ident _x0 in Id ( _x0) |Qualified ( _x0,_x1) -> let _x0 = _self#module_id _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident @@ -101451,11 +101451,10 @@ let _x1 = _self#expression _x1 in Array_index ( _x0,_x1) |Static_index ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in @@ -101504,12 +101503,12 @@ let _x1 = _self#block _x1 in let _x2 = _self#block _x2 in If ( _x0,_x1,_x2) |While ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#option (fun _self -> _self#label) _x0 in +let _x0 = option (_self#label) _x0 in let _x1 = _self#expression _x1 in let _x2 = _self#block _x2 in While ( _x0,_x1,_x2,_x3) |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _x0 = option (_self#for_ident_expression) _x0 in let _x1 = _self#finish_ident_expression _x1 in let _x2 = _self#for_ident _x2 in let _x3 = _self#for_direction _x3 in @@ -101525,37 +101524,33 @@ Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> let _x0 = _self#expression _x0 in Throw ( _x0) |Try ( _x0,_x1,_x2) -> let _x0 = _self#block _x0 in -let _x1 = _self#option (fun _self -> fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in +let _x2 = option (_self#block) _x2 in Try ( _x0,_x1,_x2) |Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {statement_desc = _x0;comment = _x1} +method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} +method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = _self#option (fun _self -> _self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} +let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {switch_body = _x0;should_break = _x1;comment = _x2} +method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} method block : block -> block = _self#list (fun _self -> _self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {program = _x0;modules = _x1;side_effect = _x2} +let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} end end @@ -102028,11 +102023,12 @@ module Js_fold open J let [@inline] unknown _self _ = _self + let [@inline] option sub self = fun v -> + match v with + | None -> self + | Some x -> sub x class fold = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type = - fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = fun _f_a -> @@ -102049,7 +102045,6 @@ let _self = _self#ident _x0 in _self |Qualified ( _x0,_x1) -> let _self = _self#module_id _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident @@ -102112,11 +102107,10 @@ let _self = _self#expression _x1 in _self |Static_index ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in @@ -102165,12 +102159,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = _self#option (fun _self -> _self#label) _x0 in +let _self = option (_self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _self = option (_self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -102186,37 +102180,33 @@ let _self = _self#expression _x0 in |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (_self#block) _self _x2 in _self |Debugger -> _self -method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self -method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self +method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self +method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = _self#option (fun _self -> _self#expression) _x1 in _self +let _self = option (_self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self -method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self method block : block -> 'self_type = _self#list (fun _self -> _self#statement) method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in -let _self = _self#required_modules _x1 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +let _self = _self#required_modules _x1 in _self end end diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 7fdeaed92d..193a1681a6 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -376385,32 +376385,33 @@ module Js_iter #1 "js_iter.ml" open J - let unknown _self _ = () + + let option sub = fun v -> + match v with + | None -> () + | Some v -> sub v class iter = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> unit) -> 'a option -> unit = - fun _f_a -> function | None -> () | Some _x -> _f_a _self _x method list : 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 - method label : label -> unit = unknown _self + method label : label -> unit = ignore method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) -method ident : ident -> unit = unknown _self +method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function | Id ( _x0) -> begin _self#ident _x0 end |Qualified ( _x0,_x1) -> - begin _self#module_id _x0;_self#option (fun _self -> unknown _self) _x1 end + begin _self#module_id _x0 end method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = unknown _self +method for_direction : for_direction -> unit = ignore method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) -method length_object : length_object -> unit = unknown _self +method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> begin _self#expression _x0;_self#length_object _x1 end @@ -376442,9 +376443,9 @@ method expression_desc : expression_desc -> unit = function |Array_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#option (fun _self -> unknown _self) _x2 end + begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;_self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> @@ -376477,32 +376478,32 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin _self#option (fun _self -> _self#label) _x0;_self#expression _x1;_self#block _x2 end + begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin _self#option (fun _self -> _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;_self#option (fun _self -> fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;_self#option (fun _self -> _self#block) _x2 end + begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end |Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0;_self#option (fun _self -> unknown _self) _x1 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;_self#option (fun _self -> _self#expression) _x1 end +method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end +method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0;_self#option (fun _self -> unknown _self) _x2 end +method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end method block : block -> unit = _self#list (fun _self -> _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1;_self#option (fun _self -> unknown _self) _x2 end +method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end end @@ -383858,12 +383859,12 @@ module Js_map open J let unknown : 'a. 'a -> 'a = fun x -> x +let option sub = fun v -> + match v with + | None -> None + | Some v -> Some (sub v) class map = object ((_self : 'self_type)) -method option : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option = - fun _f_a -> - function | None -> None | Some _x -> let _x = _f_a _self _x in Some _x method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = fun _f_a -> @@ -383882,7 +383883,6 @@ let _x0 = _self#ident _x0 in Id ( _x0) |Qualified ( _x0,_x1) -> let _x0 = _self#module_id _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident @@ -383945,11 +383945,10 @@ let _x1 = _self#expression _x1 in Array_index ( _x0,_x1) |Static_index ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in @@ -383998,12 +383997,12 @@ let _x1 = _self#block _x1 in let _x2 = _self#block _x2 in If ( _x0,_x1,_x2) |While ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#option (fun _self -> _self#label) _x0 in +let _x0 = option (_self#label) _x0 in let _x1 = _self#expression _x1 in let _x2 = _self#block _x2 in While ( _x0,_x1,_x2,_x3) |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _x0 = option (_self#for_ident_expression) _x0 in let _x1 = _self#finish_ident_expression _x1 in let _x2 = _self#for_ident _x2 in let _x3 = _self#for_direction _x3 in @@ -384019,37 +384018,33 @@ Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> let _x0 = _self#expression _x0 in Throw ( _x0) |Try ( _x0,_x1,_x2) -> let _x0 = _self#block _x0 in -let _x1 = _self#option (fun _self -> fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = _self#option (fun _self -> _self#block) _x2 in +let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in +let _x2 = option (_self#block) _x2 in Try ( _x0,_x1,_x2) |Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in -let _x1 = _self#option (fun _self -> unknown) _x1 in {statement_desc = _x0;comment = _x1} +method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} +method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = _self#option (fun _self -> _self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} +let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {switch_body = _x0;should_break = _x1;comment = _x2} +method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} method block : block -> block = _self#list (fun _self -> _self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in -let _x2 = _self#option (fun _self -> unknown) _x2 in {program = _x0;modules = _x1;side_effect = _x2} +let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} end end @@ -384522,11 +384517,12 @@ module Js_fold open J let [@inline] unknown _self _ = _self + let [@inline] option sub self = fun v -> + match v with + | None -> self + | Some x -> sub x class fold = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type = - fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = fun _f_a -> @@ -384543,7 +384539,6 @@ let _self = _self#ident _x0 in _self |Qualified ( _x0,_x1) -> let _self = _self#module_id _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident @@ -384606,11 +384601,10 @@ let _self = _self#expression _x1 in _self |Static_index ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in +let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in @@ -384659,12 +384653,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = _self#option (fun _self -> _self#label) _x0 in +let _self = option (_self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = _self#option (fun _self -> _self#for_ident_expression) _x0 in +let _self = option (_self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -384680,37 +384674,33 @@ let _self = _self#expression _x0 in |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (_self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _x1 in -let _self = _self#option (fun _self -> _self#block) _x2 in +let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (_self#block) _self _x2 in _self |Debugger -> _self -method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self -method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in -let _self = _self#option (fun _self -> unknown _self) _x1 in _self +method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self +method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = _self#option (fun _self -> _self#expression) _x1 in _self +let _self = option (_self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self -method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self method block : block -> 'self_type = _self#list (fun _self -> _self#statement) method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in -let _self = _self#required_modules _x1 in -let _self = _self#option (fun _self -> unknown _self) _x2 in _self +let _self = _self#required_modules _x1 in _self end end diff --git a/ocaml-tree/fold_maker.js b/ocaml-tree/fold_maker.js index cf63f19962..bd6adce1b0 100644 --- a/ocaml-tree/fold_maker.js +++ b/ocaml-tree/fold_maker.js @@ -34,10 +34,21 @@ function mkBody(def, allNames) { case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + switch (list.text) { + case "option": + var inner = mkBody(base, allNames); + if (inner === skip) { + return inner; + } + return `option (${inner}) _self`; + case "list": + return `${mkBody(list, allNames)} (fun _self -> ${mkBody( + base, + allNames + )})`; + default: + throw new Error(`not supported high order types ${list.text}`); + } case "record_declaration": var len = def.children.length; var args = init(len, (i) => `_x${i}`); @@ -110,9 +121,9 @@ function mkBranch(branch, allNames) { return mkBodyApply(ty, allNames, x); }) .filter(Boolean); - if(body.length === 0){ - return `${text} _ -> _self` - } + if (body.length === 0) { + return `${text} _ -> _self`; + } return `${pat_exp} -> \n${body.join("\n")}\n _self`; } @@ -127,11 +138,12 @@ function make(typedefs) { var o = ` open J let [@inline] unknown _self _ = _self + let [@inline] option sub self = fun v -> + match v with + | None -> self + | Some x -> sub x class fold = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type = - fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = fun _f_a -> diff --git a/ocaml-tree/iter_maker.js b/ocaml-tree/iter_maker.js index 75853ce657..d59793a53b 100644 --- a/ocaml-tree/iter_maker.js +++ b/ocaml-tree/iter_maker.js @@ -17,7 +17,7 @@ function mkMethod({ name, def }, allNames) { return `method ${name} : ${name} -> unit = ${mkBody(def, allNames)} `; } -var skip = `unknown _self`; +var skip = `ignore`; /** * @param {Node} def @@ -36,10 +36,24 @@ function mkBody(def, allNames) { case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + + switch (list.text) { + case "option": + var inner = mkBody(base, allNames); + if (inner === skip) { + return inner; + } + return `option (${inner})`; + case "list": + // there are list and other + return `${mkBody(list, allNames)} (fun _self -> ${mkBody( + base, + allNames + )})`; + default: + throw new Error(`not supported high order types ${list.text}`); + } + case "record_declaration": var len = def.children.length; var args = init(len, (i) => `_x${i}`); @@ -127,12 +141,13 @@ function make(typedefs) { var output = typedefs.map((x) => mkMethod(x, allNames)); var o = ` open J - let unknown _self _ = () + + let option sub = fun v -> + match v with + | None -> () + | Some v -> sub v class iter = object ((_self : 'self_type)) - method option : - 'a. ('self_type -> 'a -> unit) -> 'a option -> unit = - fun _f_a -> function | None -> () | Some _x -> _f_a _self _x method list : 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = fun _f_a -> diff --git a/ocaml-tree/map_maker.js b/ocaml-tree/map_maker.js index 9f0ba11e34..7597a205a3 100644 --- a/ocaml-tree/map_maker.js +++ b/ocaml-tree/map_maker.js @@ -33,10 +33,22 @@ function mkBody(def, allNames) { case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + switch (list.text) { + case "option": + var inner = mkBody(base, allNames); + if (inner === skip) { + return inner; + } + return `option (${inner})`; + case "list": + return `${mkBody(list, allNames)} (fun _self -> ${mkBody( + base, + allNames + )})`; + default: + throw new Error(`not supported high order types ${list.text}`); + } + case "record_declaration": var len = def.children.length; var args = init(len, (i) => `_x${i}`); @@ -98,7 +110,7 @@ function mkBranch(branch, allNames) { if (len === 0) { return `${text} as v -> v`; } - + var args = init(len, (i) => `_x${i}`); var pat_exp = `${text} ( ${args.join(",")}) `; var body = args @@ -107,9 +119,9 @@ function mkBranch(branch, allNames) { return mkBodyApply(ty, allNames, x); }) .filter(Boolean); - if(body.length === 0) { - return `${text} _ as v -> v ` - } + if (body.length === 0) { + return `${text} _ as v -> v `; + } return `${pat_exp} -> \n${body.join("\n")}\n${pat_exp}`; } /** @@ -122,12 +134,12 @@ function make(typedefs) { var output = ` open J let unknown : 'a. 'a -> 'a = fun x -> x +let option sub = fun v -> + match v with + | None -> None + | Some v -> Some (sub v) class map = object ((_self : 'self_type)) -method option : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a option -> 'a_out option = - fun _f_a -> - function | None -> None | Some _x -> let _x = _f_a _self _x in Some _x method list : 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = fun _f_a -> From 07992428739c734548371258d95e3b07eb85eb3f Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Wed, 20 Jan 2021 16:50:13 +0800 Subject: [PATCH 2/5] avoid late bindings in callback the object already had a late binding for methods TODO: we may do eta-expansion here to avoid the cost of currying --- jscomp/core/js_iter.ml | 30 +++++++++++++++--------------- ocaml-tree/iter_maker.js | 11 ++++------- 2 files changed, 19 insertions(+), 22 deletions(-) diff --git a/jscomp/core/js_iter.ml b/jscomp/core/js_iter.ml index 25ee7f1bc5..2230bbd5dc 100644 --- a/jscomp/core/js_iter.ml +++ b/jscomp/core/js_iter.ml @@ -8,13 +8,13 @@ class iter = object ((_self : 'self_type)) method list : - 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = + 'a. ('a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () - | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 + | _x :: _x_i1 -> _f_a _x ; _self#list _f_a _x_i1 method label : label -> unit = ignore -method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> unit = _self#list _self#module_id method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function @@ -25,7 +25,7 @@ method vident : vident -> unit = function method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) +method property_map : property_map -> unit = _self#list (fun ( _x0,_x1) -> begin _self#expression _x1 end) method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> @@ -52,7 +52,7 @@ method expression_desc : expression_desc -> unit = function |FlatCall ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#expression) _x1 end + begin _self#expression _x0;_self#list _self#expression _x1 end |String_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Array_index ( _x0,_x1) -> @@ -60,20 +60,20 @@ method expression_desc : expression_desc -> unit = function |Static_index ( _x0,_x1,_x2) -> begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;option (_self#list _self#expression) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#ident) _x1;_self#block _x2 end + begin _self#list _self#ident _x1;_self#block _x2 end |Str _ -> () |Unicode _ -> () |Raw_js_code _ -> () |Array ( _x0,_x1) -> - begin _self#list (fun _self -> _self#expression) _x0 end + begin _self#list _self#expression _x0 end |Optional_block ( _x0,_x1) -> begin _self#expression _x0 end |Caml_block ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#expression) _x0;_self#expression _x2 end + begin _self#list _self#expression _x0;_self#expression _x2 end |Caml_block_tag ( _x0) -> begin _self#expression _x0 end |Number _ -> () @@ -102,21 +102,21 @@ method statement_desc : statement_desc -> unit = function |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;_self#list _self#int_clause _x1;option (_self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;_self#list _self#string_clause _x1;option (_self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end + begin _self#block _x0;option ((fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;option (_self#block) _x2 end |Debugger -> () method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end -method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end +method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) +method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = _self#list (fun _self -> _self#statement) +method block : block -> unit = _self#list _self#statement method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end diff --git a/ocaml-tree/iter_maker.js b/ocaml-tree/iter_maker.js index d59793a53b..6f8c7a277d 100644 --- a/ocaml-tree/iter_maker.js +++ b/ocaml-tree/iter_maker.js @@ -46,10 +46,7 @@ function mkBody(def, allNames) { return `option (${inner})`; case "list": // there are list and other - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + return `${mkBody(list, allNames)} ${mkBody(base, allNames)}`; default: throw new Error(`not supported high order types ${list.text}`); } @@ -81,7 +78,7 @@ function mkBody(def, allNames) { var body = args .map((x, i) => mkBodyApply(def.children[i], allNames, x)) .filter(Boolean); - return `fun ( ${args.join(",")}) -> begin ${body.join(";")} end`; + return `(fun ( ${args.join(",")}) -> begin ${body.join(";")} end)`; default: throw new Error(`unkonwn ${def.type}`); } @@ -149,11 +146,11 @@ function make(typedefs) { class iter = object ((_self : 'self_type)) method list : - 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = + 'a. ('a -> unit) -> 'a list -> unit = fun _f_a -> function | [] -> () - | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 + | _x :: _x_i1 -> _f_a _x ; _self#list _f_a _x_i1 ${output.join("\n")} end `; From b7aa4036fb0e18846401470edd2cabf950c2a2a8 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Wed, 20 Jan 2021 17:43:30 +0800 Subject: [PATCH 3/5] avoid high order semantics for open recursion the semantics for open recursion with high order function is tricky let's not use it at all code like this `(fun self -> self#hi)` is very hard to reason about --- jscomp/core/js_analyzer.ml | 18 +++---- jscomp/core/js_iter.ml | 43 ++++++++-------- lib/4.06.1/unstable/js_compiler.ml | 65 +++++++++++------------- lib/4.06.1/unstable/js_refmt_compiler.ml | 65 +++++++++++------------- lib/4.06.1/whole_compiler.ml | 65 +++++++++++------------- ocaml-tree/iter_maker.js | 24 ++++----- 6 files changed, 125 insertions(+), 155 deletions(-) diff --git a/jscomp/core/js_analyzer.ml b/jscomp/core/js_analyzer.ml index 1f15e28084..b424cf5e5c 100644 --- a/jscomp/core/js_analyzer.ml +++ b/jscomp/core/js_analyzer.ml @@ -139,32 +139,28 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect clean : Js_iter.iter = +let no_side_effect_obj : Js_iter.iter = object (self) inherit Js_iter.iter as super method! statement s = - if !clean then match s.statement_desc with | Throw _ | Debugger | Break | Variable _ | Continue _ -> - clean := false + raise_notrace Not_found | Exp e -> self#expression e | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! list f x = - if !clean then super#list f x method! expression s = - if !clean then - clean := no_side_effect_expression s - (** only expression would cause side effec *) + if not (no_side_effect_expression s) then raise_notrace Not_found end let no_side_effect_statement st = - let clean = ref true in - (no_side_effect clean)#statement st; - !clean + try + no_side_effect_obj#statement st; true + with _ -> false + (* TODO: generate [fold2] This make sense, for example: diff --git a/jscomp/core/js_iter.ml b/jscomp/core/js_iter.ml index 2230bbd5dc..c07e912b9b 100644 --- a/jscomp/core/js_iter.ml +++ b/jscomp/core/js_iter.ml @@ -1,20 +1,17 @@ open J - let option sub = fun v -> + let option sub v = match v with | None -> () | Some v -> sub v - class iter = - object ((_self : 'self_type)) - method list : - 'a. ('a -> unit) -> 'a list -> unit = - fun _f_a -> - function - | [] -> () - | _x :: _x_i1 -> _f_a _x ; _self#list _f_a _x_i1 + let rec list sub v = + match v with + | [] -> () + | x::xs -> sub x ; list sub xs + class iter = object (_self : 'self_type) method label : label -> unit = ignore -method required_modules : required_modules -> unit = _self#list _self#module_id +method required_modules : required_modules -> unit = (list _self#module_id) method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function @@ -25,7 +22,7 @@ method vident : vident -> unit = function method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = _self#list (fun ( _x0,_x1) -> begin _self#expression _x1 end) +method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> @@ -52,7 +49,7 @@ method expression_desc : expression_desc -> unit = function |FlatCall ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list _self#expression _x1 end + begin _self#expression _x0;(list _self#expression) _x1 end |String_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Array_index ( _x0,_x1) -> @@ -60,20 +57,20 @@ method expression_desc : expression_desc -> unit = function |Static_index ( _x0,_x1,_x2) -> begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;option (_self#list _self#expression) _x1 end + begin _self#expression _x0;(option (list _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> - begin _self#list _self#ident _x1;_self#block _x2 end + begin (list _self#ident) _x1;_self#block _x2 end |Str _ -> () |Unicode _ -> () |Raw_js_code _ -> () |Array ( _x0,_x1) -> - begin _self#list _self#expression _x0 end + begin (list _self#expression) _x0 end |Optional_block ( _x0,_x1) -> begin _self#expression _x0 end |Caml_block ( _x0,_x1,_x2,_x3) -> - begin _self#list _self#expression _x0;_self#expression _x2 end + begin (list _self#expression) _x0;_self#expression _x2 end |Caml_block_tag ( _x0) -> begin _self#expression _x0 end |Number _ -> () @@ -93,30 +90,30 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end + begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list _self#int_clause _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list _self#string_clause _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;option ((fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;option (_self#block) _x2 end + begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end |Debugger -> () method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = _self#list _self#statement +method block : block -> unit = (list _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index ab8cbd6b62..ff00454a92 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -86507,20 +86507,17 @@ module Js_iter open J - let option sub = fun v -> + let option sub v = match v with | None -> () | Some v -> sub v - class iter = - object ((_self : 'self_type)) - method list : - 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = - fun _f_a -> - function - | [] -> () - | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 + let rec list sub v = + match v with + | [] -> () + | x::xs -> sub x ; list sub xs + class iter = object (_self : 'self_type) method label : label -> unit = ignore -method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> unit = (list _self#module_id) method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function @@ -86531,7 +86528,7 @@ method vident : vident -> unit = function method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) +method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> @@ -86558,7 +86555,7 @@ method expression_desc : expression_desc -> unit = function |FlatCall ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#expression) _x1 end + begin _self#expression _x0;(list _self#expression) _x1 end |String_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Array_index ( _x0,_x1) -> @@ -86566,20 +86563,20 @@ method expression_desc : expression_desc -> unit = function |Static_index ( _x0,_x1,_x2) -> begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;(option (list _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#ident) _x1;_self#block _x2 end + begin (list _self#ident) _x1;_self#block _x2 end |Str _ -> () |Unicode _ -> () |Raw_js_code _ -> () |Array ( _x0,_x1) -> - begin _self#list (fun _self -> _self#expression) _x0 end + begin (list _self#expression) _x0 end |Optional_block ( _x0,_x1) -> begin _self#expression _x0 end |Caml_block ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#expression) _x0;_self#expression _x2 end + begin (list _self#expression) _x0;_self#expression _x2 end |Caml_block_tag ( _x0) -> begin _self#expression _x0 end |Number _ -> () @@ -86599,30 +86596,30 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end + begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end + begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end |Debugger -> () method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end -method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end +method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) +method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = _self#list (fun _self -> _self#statement) +method block : block -> unit = (list _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end @@ -87065,32 +87062,28 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect clean : Js_iter.iter = +let no_side_effect_obj : Js_iter.iter = object (self) inherit Js_iter.iter as super method! statement s = - if !clean then match s.statement_desc with | Throw _ | Debugger | Break | Variable _ | Continue _ -> - clean := false + raise_notrace Not_found | Exp e -> self#expression e | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! list f x = - if !clean then super#list f x method! expression s = - if !clean then - clean := no_side_effect_expression s - (** only expression would cause side effec *) + if not (no_side_effect_expression s) then raise_notrace Not_found end let no_side_effect_statement st = - let clean = ref true in - (no_side_effect clean)#statement st; - !clean + try + no_side_effect_obj#statement st; true + with _ -> false + (* TODO: generate [fold2] This make sense, for example: diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 5cb0cbf1f7..8ab06385fc 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -86507,20 +86507,17 @@ module Js_iter open J - let option sub = fun v -> + let option sub v = match v with | None -> () | Some v -> sub v - class iter = - object ((_self : 'self_type)) - method list : - 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = - fun _f_a -> - function - | [] -> () - | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 + let rec list sub v = + match v with + | [] -> () + | x::xs -> sub x ; list sub xs + class iter = object (_self : 'self_type) method label : label -> unit = ignore -method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> unit = (list _self#module_id) method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function @@ -86531,7 +86528,7 @@ method vident : vident -> unit = function method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) +method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> @@ -86558,7 +86555,7 @@ method expression_desc : expression_desc -> unit = function |FlatCall ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#expression) _x1 end + begin _self#expression _x0;(list _self#expression) _x1 end |String_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Array_index ( _x0,_x1) -> @@ -86566,20 +86563,20 @@ method expression_desc : expression_desc -> unit = function |Static_index ( _x0,_x1,_x2) -> begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;(option (list _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#ident) _x1;_self#block _x2 end + begin (list _self#ident) _x1;_self#block _x2 end |Str _ -> () |Unicode _ -> () |Raw_js_code _ -> () |Array ( _x0,_x1) -> - begin _self#list (fun _self -> _self#expression) _x0 end + begin (list _self#expression) _x0 end |Optional_block ( _x0,_x1) -> begin _self#expression _x0 end |Caml_block ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#expression) _x0;_self#expression _x2 end + begin (list _self#expression) _x0;_self#expression _x2 end |Caml_block_tag ( _x0) -> begin _self#expression _x0 end |Number _ -> () @@ -86599,30 +86596,30 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end + begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end + begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end |Debugger -> () method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end -method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end +method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) +method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = _self#list (fun _self -> _self#statement) +method block : block -> unit = (list _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end @@ -87065,32 +87062,28 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect clean : Js_iter.iter = +let no_side_effect_obj : Js_iter.iter = object (self) inherit Js_iter.iter as super method! statement s = - if !clean then match s.statement_desc with | Throw _ | Debugger | Break | Variable _ | Continue _ -> - clean := false + raise_notrace Not_found | Exp e -> self#expression e | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! list f x = - if !clean then super#list f x method! expression s = - if !clean then - clean := no_side_effect_expression s - (** only expression would cause side effec *) + if not (no_side_effect_expression s) then raise_notrace Not_found end let no_side_effect_statement st = - let clean = ref true in - (no_side_effect clean)#statement st; - !clean + try + no_side_effect_obj#statement st; true + with _ -> false + (* TODO: generate [fold2] This make sense, for example: diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 193a1681a6..fa121dd9a0 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -376386,20 +376386,17 @@ module Js_iter open J - let option sub = fun v -> + let option sub v = match v with | None -> () | Some v -> sub v - class iter = - object ((_self : 'self_type)) - method list : - 'a. ('self_type -> 'a -> unit) -> 'a list -> unit = - fun _f_a -> - function - | [] -> () - | _x :: _x_i1 -> _f_a _self _x ; _self#list _f_a _x_i1 + let rec list sub v = + match v with + | [] -> () + | x::xs -> sub x ; list sub xs + class iter = object (_self : 'self_type) method label : label -> unit = ignore -method required_modules : required_modules -> unit = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> unit = (list _self#module_id) method ident : ident -> unit = ignore method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end method vident : vident -> unit = function @@ -376410,7 +376407,7 @@ method vident : vident -> unit = function method exception_ident : exception_ident -> unit = _self#ident method for_ident : for_ident -> unit = _self#ident method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = _self#list (fun _self -> fun ( _x0,_x1) -> begin _self#expression _x1 end) +method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) method length_object : length_object -> unit = ignore method expression_desc : expression_desc -> unit = function | Length ( _x0,_x1) -> @@ -376437,7 +376434,7 @@ method expression_desc : expression_desc -> unit = function |FlatCall ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#expression) _x1 end + begin _self#expression _x0;(list _self#expression) _x1 end |String_index ( _x0,_x1) -> begin _self#expression _x0;_self#expression _x1 end |Array_index ( _x0,_x1) -> @@ -376445,20 +376442,20 @@ method expression_desc : expression_desc -> unit = function |Static_index ( _x0,_x1,_x2) -> begin _self#expression _x0 end |New ( _x0,_x1) -> - begin _self#expression _x0;option (_self#list (fun _self -> _self#expression)) _x1 end + begin _self#expression _x0;(option (list _self#expression)) _x1 end |Var ( _x0) -> begin _self#vident _x0 end |Fun ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#ident) _x1;_self#block _x2 end + begin (list _self#ident) _x1;_self#block _x2 end |Str _ -> () |Unicode _ -> () |Raw_js_code _ -> () |Array ( _x0,_x1) -> - begin _self#list (fun _self -> _self#expression) _x0 end + begin (list _self#expression) _x0 end |Optional_block ( _x0,_x1) -> begin _self#expression _x0 end |Caml_block ( _x0,_x1,_x2,_x3) -> - begin _self#list (fun _self -> _self#expression) _x0;_self#expression _x2 end + begin (list _self#expression) _x0;_self#expression _x2 end |Caml_block_tag ( _x0) -> begin _self#expression _x0 end |Number _ -> () @@ -376478,30 +376475,30 @@ method statement_desc : statement_desc -> unit = function |If ( _x0,_x1,_x2) -> begin _self#expression _x0;_self#block _x1;_self#block _x2 end |While ( _x0,_x1,_x2,_x3) -> - begin option (_self#label) _x0;_self#expression _x1;_self#block _x2 end + begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option (_self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end + begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end |Continue ( _x0) -> begin _self#label _x0 end |Break -> () |Return ( _x0) -> begin _self#expression _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#int_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#list (fun _self -> _self#string_clause) _x1;option (_self#block) _x2 end + begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end |Throw ( _x0) -> begin _self#expression _x0 end |Try ( _x0,_x1,_x2) -> - begin _self#block _x0;option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end) _x1;option (_self#block) _x2 end + begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end |Debugger -> () method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;option (_self#expression) _x1 end -method string_clause : string_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end -method int_clause : int_clause -> unit = fun ( _x0,_x1) -> begin _self#case_clause _x1 end +method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end +method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) +method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = _self#list (fun _self -> _self#statement) +method block : block -> unit = (list _self#statement) method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end end @@ -376944,32 +376941,28 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect clean : Js_iter.iter = +let no_side_effect_obj : Js_iter.iter = object (self) inherit Js_iter.iter as super method! statement s = - if !clean then match s.statement_desc with | Throw _ | Debugger | Break | Variable _ | Continue _ -> - clean := false + raise_notrace Not_found | Exp e -> self#expression e | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! list f x = - if !clean then super#list f x method! expression s = - if !clean then - clean := no_side_effect_expression s - (** only expression would cause side effec *) + if not (no_side_effect_expression s) then raise_notrace Not_found end let no_side_effect_statement st = - let clean = ref true in - (no_side_effect clean)#statement st; - !clean + try + no_side_effect_obj#statement st; true + with _ -> false + (* TODO: generate [fold2] This make sense, for example: diff --git a/ocaml-tree/iter_maker.js b/ocaml-tree/iter_maker.js index 6f8c7a277d..e80a904dfd 100644 --- a/ocaml-tree/iter_maker.js +++ b/ocaml-tree/iter_maker.js @@ -39,14 +39,15 @@ function mkBody(def, allNames) { switch (list.text) { case "option": + case "list": var inner = mkBody(base, allNames); if (inner === skip) { return inner; } - return `option (${inner})`; - case "list": - // there are list and other - return `${mkBody(list, allNames)} ${mkBody(base, allNames)}`; + return `(${list.text} ${inner})`; + // case "list": + // // there are list and other + // return `(${mkBody(list, allNames)} ${mkBody(base, allNames)})`; default: throw new Error(`not supported high order types ${list.text}`); } @@ -139,18 +140,15 @@ function make(typedefs) { var o = ` open J - let option sub = fun v -> + let option sub v = match v with | None -> () | Some v -> sub v - class iter = - object ((_self : 'self_type)) - method list : - 'a. ('a -> unit) -> 'a list -> unit = - fun _f_a -> - function - | [] -> () - | _x :: _x_i1 -> _f_a _x ; _self#list _f_a _x_i1 + let rec list sub v = + match v with + | [] -> () + | x::xs -> sub x ; list sub xs + class iter = object (_self : 'self_type) ${output.join("\n")} end `; From 55dfb16e211805e3c729d62f1bc6ba1bc24d253c Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Thu, 21 Jan 2021 10:55:09 +0800 Subject: [PATCH 4/5] remove high order types in visitor, ensure the evaluation order --- jscomp/core/js_fold.ml | 42 +++++++----- jscomp/core/js_map.ml | 41 ++++++------ lib/4.06.1/unstable/js_compiler.ml | 83 +++++++++++++----------- lib/4.06.1/unstable/js_refmt_compiler.ml | 83 +++++++++++++----------- lib/4.06.1/whole_compiler.ml | 83 +++++++++++++----------- ocaml-tree/fold_maker.js | 16 +++-- ocaml-tree/map_maker.js | 29 ++++----- 7 files changed, 202 insertions(+), 175 deletions(-) diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml index 5403dd2edd..ba7fe419b6 100644 --- a/jscomp/core/js_fold.ml +++ b/jscomp/core/js_fold.ml @@ -4,7 +4,13 @@ let [@inline] option sub self = fun v -> match v with | None -> self - | Some x -> sub x + | Some x -> sub self x + let rec list (sub : 'self_type -> 'a -> 'self_type) self = fun v -> + match v with + | [] -> self + | x::xs -> + let self = sub self x in + list sub self xs class fold = object ((_self : 'self_type)) method list : @@ -14,7 +20,7 @@ | [] -> _self | _x :: _x_i1 -> let _self = _f_a _self _x in let _self = _self#list _f_a _x_i1 in _self method label : label -> 'self_type = unknown _self -method required_modules : required_modules -> 'self_type = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self method ident : ident -> 'self_type = unknown _self method module_id : module_id -> 'self_type = fun { id = _x0;kind = _x1} -> let _self = _self#ident _x0 in _self method vident : vident -> 'self_type = function @@ -27,7 +33,7 @@ let _self = _self#module_id _x0 in method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident method for_direction : for_direction -> 'self_type = unknown _self -method property_map : property_map -> 'self_type = _self#list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) +method property_map : property_map -> 'self_type = list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) _self method length_object : length_object -> 'self_type = unknown _self method expression_desc : expression_desc -> 'self_type = function | Length ( _x0,_x1) -> @@ -73,7 +79,7 @@ let _self = _self#expression _x1 in _self |Call ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#expression) _x1 in +let _self = list (fun _self -> _self#expression) _self _x1 in _self |String_index ( _x0,_x1) -> let _self = _self#expression _x0 in @@ -88,26 +94,26 @@ let _self = _self#expression _x0 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in +let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in _self |Fun ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#ident) _x1 in +let _self = list (fun _self -> _self#ident) _self _x1 in let _self = _self#block _x2 in _self |Str _ -> _self |Unicode _ -> _self |Raw_js_code _ -> _self |Array ( _x0,_x1) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in _self |Optional_block ( _x0,_x1) -> let _self = _self#expression _x0 in _self |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in let _self = _self#expression _x2 in _self |Caml_block_tag ( _x0) -> @@ -137,12 +143,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = option (_self#label) _self _x0 in +let _self = option (fun _self -> _self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = option (_self#for_ident_expression) _self _x0 in +let _self = option (fun _self -> _self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -157,31 +163,31 @@ let _self = _self#expression _x0 in _self |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#int_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#string_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in -let _self = option (_self#block) _self _x2 in +let _self = option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Debugger -> _self method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = option (_self#expression) _self _x1 in _self +let _self = option (fun _self -> _self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self -method block : block -> 'self_type = _self#list (fun _self -> _self#statement) +method block : block -> 'self_type = list (fun _self -> _self#statement) _self method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in let _self = _self#required_modules _x1 in _self diff --git a/jscomp/core/js_map.ml b/jscomp/core/js_map.ml index 4b4bda839a..d938c36377 100644 --- a/jscomp/core/js_map.ml +++ b/jscomp/core/js_map.ml @@ -1,22 +1,23 @@ open J -let unknown : 'a. 'a -> 'a = fun x -> x -let option sub = fun v -> +let [@inline] unknown : 'a. 'a -> 'a = fun x -> x +let [@inline] option sub = fun v -> match v with | None -> None | Some v -> Some (sub v) +let rec list sub = fun v -> + match v with + | [] -> [] + | x::xs -> + let v = sub x in + v :: list sub xs + (* Note we need add [v] to enforce the evaluation order + it indeed cause different semantis here + *) class map = object ((_self : 'self_type)) -method list : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = - fun _f_a -> - function - | [] -> [] - | _x :: _x_i1 -> - let _x = _f_a _self _x in - let _x_i1 = _self#list _f_a _x_i1 in _x :: _x_i1 method label : label -> label = unknown -method required_modules : required_modules -> required_modules = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> required_modules = list (_self#module_id) method ident : ident -> ident = unknown method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} method vident : vident -> vident = function @@ -29,7 +30,7 @@ Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = _self#list (fun _self -> fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) +method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) method length_object : length_object -> length_object = unknown method expression_desc : expression_desc -> expression_desc = function | Length ( _x0,_x1) -> @@ -75,7 +76,7 @@ let _x1 = _self#expression _x1 in FlatCall ( _x0,_x1) |Call ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#expression) _x1 in +let _x1 = list (_self#expression) _x1 in Call ( _x0,_x1,_x2) |String_index ( _x0,_x1) -> let _x0 = _self#expression _x0 in @@ -90,26 +91,26 @@ let _x0 = _self#expression _x0 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (list (_self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in Var ( _x0) |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = _self#list (fun _self -> _self#ident) _x1 in +let _x1 = list (_self#ident) _x1 in let _x2 = _self#block _x2 in Fun ( _x0,_x1,_x2,_x3) |Str _ as v -> v |Unicode _ as v -> v |Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in Array ( _x0,_x1) |Optional_block ( _x0,_x1) -> let _x0 = _self#expression _x0 in Optional_block ( _x0,_x1) |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in let _x2 = _self#expression _x2 in Caml_block ( _x0,_x1,_x2,_x3) |Caml_block_tag ( _x0) -> @@ -159,12 +160,12 @@ let _x0 = _self#expression _x0 in Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in +let _x1 = list (_self#int_clause) _x1 in let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in +let _x1 = list (_self#string_clause) _x1 in let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> @@ -183,7 +184,7 @@ let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = _self#list (fun _self -> _self#statement) +method block : block -> block = list (_self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index ff00454a92..8f140a8b6f 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -101357,23 +101357,24 @@ module Js_map #1 "js_map.ml" open J -let unknown : 'a. 'a -> 'a = fun x -> x -let option sub = fun v -> +let [@inline] unknown : 'a. 'a -> 'a = fun x -> x +let [@inline] option sub = fun v -> match v with | None -> None | Some v -> Some (sub v) +let rec list sub = fun v -> + match v with + | [] -> [] + | x::xs -> + let v = sub x in + v :: list sub xs + (* Note we need add [v] to enforce the evaluation order + it indeed cause different semantis here + *) class map = object ((_self : 'self_type)) -method list : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = - fun _f_a -> - function - | [] -> [] - | _x :: _x_i1 -> - let _x = _f_a _self _x in - let _x_i1 = _self#list _f_a _x_i1 in _x :: _x_i1 method label : label -> label = unknown -method required_modules : required_modules -> required_modules = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> required_modules = list (_self#module_id) method ident : ident -> ident = unknown method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} method vident : vident -> vident = function @@ -101386,7 +101387,7 @@ Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = _self#list (fun _self -> fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) +method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) method length_object : length_object -> length_object = unknown method expression_desc : expression_desc -> expression_desc = function | Length ( _x0,_x1) -> @@ -101432,7 +101433,7 @@ let _x1 = _self#expression _x1 in FlatCall ( _x0,_x1) |Call ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#expression) _x1 in +let _x1 = list (_self#expression) _x1 in Call ( _x0,_x1,_x2) |String_index ( _x0,_x1) -> let _x0 = _self#expression _x0 in @@ -101447,26 +101448,26 @@ let _x0 = _self#expression _x0 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (list (_self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in Var ( _x0) |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = _self#list (fun _self -> _self#ident) _x1 in +let _x1 = list (_self#ident) _x1 in let _x2 = _self#block _x2 in Fun ( _x0,_x1,_x2,_x3) |Str _ as v -> v |Unicode _ as v -> v |Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in Array ( _x0,_x1) |Optional_block ( _x0,_x1) -> let _x0 = _self#expression _x0 in Optional_block ( _x0,_x1) |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in let _x2 = _self#expression _x2 in Caml_block ( _x0,_x1,_x2,_x3) |Caml_block_tag ( _x0) -> @@ -101516,12 +101517,12 @@ let _x0 = _self#expression _x0 in Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in +let _x1 = list (_self#int_clause) _x1 in let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in +let _x1 = list (_self#string_clause) _x1 in let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> @@ -101540,7 +101541,7 @@ let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = _self#list (fun _self -> _self#statement) +method block : block -> block = list (_self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} @@ -102019,7 +102020,13 @@ module Js_fold let [@inline] option sub self = fun v -> match v with | None -> self - | Some x -> sub x + | Some x -> sub self x + let rec list (sub : 'self_type -> 'a -> 'self_type) self = fun v -> + match v with + | [] -> self + | x::xs -> + let self = sub self x in + list sub self xs class fold = object ((_self : 'self_type)) method list : @@ -102029,7 +102036,7 @@ module Js_fold | [] -> _self | _x :: _x_i1 -> let _self = _f_a _self _x in let _self = _self#list _f_a _x_i1 in _self method label : label -> 'self_type = unknown _self -method required_modules : required_modules -> 'self_type = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self method ident : ident -> 'self_type = unknown _self method module_id : module_id -> 'self_type = fun { id = _x0;kind = _x1} -> let _self = _self#ident _x0 in _self method vident : vident -> 'self_type = function @@ -102042,7 +102049,7 @@ let _self = _self#module_id _x0 in method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident method for_direction : for_direction -> 'self_type = unknown _self -method property_map : property_map -> 'self_type = _self#list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) +method property_map : property_map -> 'self_type = list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) _self method length_object : length_object -> 'self_type = unknown _self method expression_desc : expression_desc -> 'self_type = function | Length ( _x0,_x1) -> @@ -102088,7 +102095,7 @@ let _self = _self#expression _x1 in _self |Call ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#expression) _x1 in +let _self = list (fun _self -> _self#expression) _self _x1 in _self |String_index ( _x0,_x1) -> let _self = _self#expression _x0 in @@ -102103,26 +102110,26 @@ let _self = _self#expression _x0 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in +let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in _self |Fun ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#ident) _x1 in +let _self = list (fun _self -> _self#ident) _self _x1 in let _self = _self#block _x2 in _self |Str _ -> _self |Unicode _ -> _self |Raw_js_code _ -> _self |Array ( _x0,_x1) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in _self |Optional_block ( _x0,_x1) -> let _self = _self#expression _x0 in _self |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in let _self = _self#expression _x2 in _self |Caml_block_tag ( _x0) -> @@ -102152,12 +102159,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = option (_self#label) _self _x0 in +let _self = option (fun _self -> _self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = option (_self#for_ident_expression) _self _x0 in +let _self = option (fun _self -> _self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -102172,31 +102179,31 @@ let _self = _self#expression _x0 in _self |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#int_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#string_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in -let _self = option (_self#block) _self _x2 in +let _self = option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Debugger -> _self method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = option (_self#expression) _self _x1 in _self +let _self = option (fun _self -> _self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self -method block : block -> 'self_type = _self#list (fun _self -> _self#statement) +method block : block -> 'self_type = list (fun _self -> _self#statement) _self method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in let _self = _self#required_modules _x1 in _self diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 8ab06385fc..bea4598eb6 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -101357,23 +101357,24 @@ module Js_map #1 "js_map.ml" open J -let unknown : 'a. 'a -> 'a = fun x -> x -let option sub = fun v -> +let [@inline] unknown : 'a. 'a -> 'a = fun x -> x +let [@inline] option sub = fun v -> match v with | None -> None | Some v -> Some (sub v) +let rec list sub = fun v -> + match v with + | [] -> [] + | x::xs -> + let v = sub x in + v :: list sub xs + (* Note we need add [v] to enforce the evaluation order + it indeed cause different semantis here + *) class map = object ((_self : 'self_type)) -method list : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = - fun _f_a -> - function - | [] -> [] - | _x :: _x_i1 -> - let _x = _f_a _self _x in - let _x_i1 = _self#list _f_a _x_i1 in _x :: _x_i1 method label : label -> label = unknown -method required_modules : required_modules -> required_modules = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> required_modules = list (_self#module_id) method ident : ident -> ident = unknown method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} method vident : vident -> vident = function @@ -101386,7 +101387,7 @@ Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = _self#list (fun _self -> fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) +method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) method length_object : length_object -> length_object = unknown method expression_desc : expression_desc -> expression_desc = function | Length ( _x0,_x1) -> @@ -101432,7 +101433,7 @@ let _x1 = _self#expression _x1 in FlatCall ( _x0,_x1) |Call ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#expression) _x1 in +let _x1 = list (_self#expression) _x1 in Call ( _x0,_x1,_x2) |String_index ( _x0,_x1) -> let _x0 = _self#expression _x0 in @@ -101447,26 +101448,26 @@ let _x0 = _self#expression _x0 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (list (_self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in Var ( _x0) |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = _self#list (fun _self -> _self#ident) _x1 in +let _x1 = list (_self#ident) _x1 in let _x2 = _self#block _x2 in Fun ( _x0,_x1,_x2,_x3) |Str _ as v -> v |Unicode _ as v -> v |Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in Array ( _x0,_x1) |Optional_block ( _x0,_x1) -> let _x0 = _self#expression _x0 in Optional_block ( _x0,_x1) |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in let _x2 = _self#expression _x2 in Caml_block ( _x0,_x1,_x2,_x3) |Caml_block_tag ( _x0) -> @@ -101516,12 +101517,12 @@ let _x0 = _self#expression _x0 in Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in +let _x1 = list (_self#int_clause) _x1 in let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in +let _x1 = list (_self#string_clause) _x1 in let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> @@ -101540,7 +101541,7 @@ let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = _self#list (fun _self -> _self#statement) +method block : block -> block = list (_self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} @@ -102019,7 +102020,13 @@ module Js_fold let [@inline] option sub self = fun v -> match v with | None -> self - | Some x -> sub x + | Some x -> sub self x + let rec list (sub : 'self_type -> 'a -> 'self_type) self = fun v -> + match v with + | [] -> self + | x::xs -> + let self = sub self x in + list sub self xs class fold = object ((_self : 'self_type)) method list : @@ -102029,7 +102036,7 @@ module Js_fold | [] -> _self | _x :: _x_i1 -> let _self = _f_a _self _x in let _self = _self#list _f_a _x_i1 in _self method label : label -> 'self_type = unknown _self -method required_modules : required_modules -> 'self_type = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self method ident : ident -> 'self_type = unknown _self method module_id : module_id -> 'self_type = fun { id = _x0;kind = _x1} -> let _self = _self#ident _x0 in _self method vident : vident -> 'self_type = function @@ -102042,7 +102049,7 @@ let _self = _self#module_id _x0 in method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident method for_direction : for_direction -> 'self_type = unknown _self -method property_map : property_map -> 'self_type = _self#list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) +method property_map : property_map -> 'self_type = list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) _self method length_object : length_object -> 'self_type = unknown _self method expression_desc : expression_desc -> 'self_type = function | Length ( _x0,_x1) -> @@ -102088,7 +102095,7 @@ let _self = _self#expression _x1 in _self |Call ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#expression) _x1 in +let _self = list (fun _self -> _self#expression) _self _x1 in _self |String_index ( _x0,_x1) -> let _self = _self#expression _x0 in @@ -102103,26 +102110,26 @@ let _self = _self#expression _x0 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in +let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in _self |Fun ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#ident) _x1 in +let _self = list (fun _self -> _self#ident) _self _x1 in let _self = _self#block _x2 in _self |Str _ -> _self |Unicode _ -> _self |Raw_js_code _ -> _self |Array ( _x0,_x1) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in _self |Optional_block ( _x0,_x1) -> let _self = _self#expression _x0 in _self |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in let _self = _self#expression _x2 in _self |Caml_block_tag ( _x0) -> @@ -102152,12 +102159,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = option (_self#label) _self _x0 in +let _self = option (fun _self -> _self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = option (_self#for_ident_expression) _self _x0 in +let _self = option (fun _self -> _self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -102172,31 +102179,31 @@ let _self = _self#expression _x0 in _self |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#int_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#string_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in -let _self = option (_self#block) _self _x2 in +let _self = option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Debugger -> _self method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = option (_self#expression) _self _x1 in _self +let _self = option (fun _self -> _self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self -method block : block -> 'self_type = _self#list (fun _self -> _self#statement) +method block : block -> 'self_type = list (fun _self -> _self#statement) _self method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in let _self = _self#required_modules _x1 in _self diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index fa121dd9a0..42c01bce44 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -383851,23 +383851,24 @@ module Js_map #1 "js_map.ml" open J -let unknown : 'a. 'a -> 'a = fun x -> x -let option sub = fun v -> +let [@inline] unknown : 'a. 'a -> 'a = fun x -> x +let [@inline] option sub = fun v -> match v with | None -> None | Some v -> Some (sub v) +let rec list sub = fun v -> + match v with + | [] -> [] + | x::xs -> + let v = sub x in + v :: list sub xs + (* Note we need add [v] to enforce the evaluation order + it indeed cause different semantis here + *) class map = object ((_self : 'self_type)) -method list : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = - fun _f_a -> - function - | [] -> [] - | _x :: _x_i1 -> - let _x = _f_a _self _x in - let _x_i1 = _self#list _f_a _x_i1 in _x :: _x_i1 method label : label -> label = unknown -method required_modules : required_modules -> required_modules = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> required_modules = list (_self#module_id) method ident : ident -> ident = unknown method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} method vident : vident -> vident = function @@ -383880,7 +383881,7 @@ Qualified ( _x0,_x1) method exception_ident : exception_ident -> exception_ident = _self#ident method for_ident : for_ident -> for_ident = _self#ident method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = _self#list (fun _self -> fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) +method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) method length_object : length_object -> length_object = unknown method expression_desc : expression_desc -> expression_desc = function | Length ( _x0,_x1) -> @@ -383926,7 +383927,7 @@ let _x1 = _self#expression _x1 in FlatCall ( _x0,_x1) |Call ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#expression) _x1 in +let _x1 = list (_self#expression) _x1 in Call ( _x0,_x1,_x2) |String_index ( _x0,_x1) -> let _x0 = _self#expression _x0 in @@ -383941,26 +383942,26 @@ let _x0 = _self#expression _x0 in Static_index ( _x0,_x1,_x2) |New ( _x0,_x1) -> let _x0 = _self#expression _x0 in -let _x1 = option (_self#list (fun _self -> _self#expression)) _x1 in +let _x1 = option (list (_self#expression)) _x1 in New ( _x0,_x1) |Var ( _x0) -> let _x0 = _self#vident _x0 in Var ( _x0) |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = _self#list (fun _self -> _self#ident) _x1 in +let _x1 = list (_self#ident) _x1 in let _x2 = _self#block _x2 in Fun ( _x0,_x1,_x2,_x3) |Str _ as v -> v |Unicode _ as v -> v |Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in Array ( _x0,_x1) |Optional_block ( _x0,_x1) -> let _x0 = _self#expression _x0 in Optional_block ( _x0,_x1) |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = _self#list (fun _self -> _self#expression) _x0 in +let _x0 = list (_self#expression) _x0 in let _x2 = _self#expression _x2 in Caml_block ( _x0,_x1,_x2,_x3) |Caml_block_tag ( _x0) -> @@ -384010,12 +384011,12 @@ let _x0 = _self#expression _x0 in Return ( _x0) |Int_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#int_clause) _x1 in +let _x1 = list (_self#int_clause) _x1 in let _x2 = option (_self#block) _x2 in Int_switch ( _x0,_x1,_x2) |String_switch ( _x0,_x1,_x2) -> let _x0 = _self#expression _x0 in -let _x1 = _self#list (fun _self -> _self#string_clause) _x1 in +let _x1 = list (_self#string_clause) _x1 in let _x2 = option (_self#block) _x2 in String_switch ( _x0,_x1,_x2) |Throw ( _x0) -> @@ -384034,7 +384035,7 @@ let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = _self#list (fun _self -> _self#statement) +method block : block -> block = list (_self#statement) method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} @@ -384513,7 +384514,13 @@ module Js_fold let [@inline] option sub self = fun v -> match v with | None -> self - | Some x -> sub x + | Some x -> sub self x + let rec list (sub : 'self_type -> 'a -> 'self_type) self = fun v -> + match v with + | [] -> self + | x::xs -> + let self = sub self x in + list sub self xs class fold = object ((_self : 'self_type)) method list : @@ -384523,7 +384530,7 @@ module Js_fold | [] -> _self | _x :: _x_i1 -> let _self = _f_a _self _x in let _self = _self#list _f_a _x_i1 in _self method label : label -> 'self_type = unknown _self -method required_modules : required_modules -> 'self_type = _self#list (fun _self -> _self#module_id) +method required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self method ident : ident -> 'self_type = unknown _self method module_id : module_id -> 'self_type = fun { id = _x0;kind = _x1} -> let _self = _self#ident _x0 in _self method vident : vident -> 'self_type = function @@ -384536,7 +384543,7 @@ let _self = _self#module_id _x0 in method exception_ident : exception_ident -> 'self_type = _self#ident method for_ident : for_ident -> 'self_type = _self#ident method for_direction : for_direction -> 'self_type = unknown _self -method property_map : property_map -> 'self_type = _self#list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) +method property_map : property_map -> 'self_type = list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) _self method length_object : length_object -> 'self_type = unknown _self method expression_desc : expression_desc -> 'self_type = function | Length ( _x0,_x1) -> @@ -384582,7 +384589,7 @@ let _self = _self#expression _x1 in _self |Call ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#expression) _x1 in +let _self = list (fun _self -> _self#expression) _self _x1 in _self |String_index ( _x0,_x1) -> let _self = _self#expression _x0 in @@ -384597,26 +384604,26 @@ let _self = _self#expression _x0 in _self |New ( _x0,_x1) -> let _self = _self#expression _x0 in -let _self = option (_self#list (fun _self -> _self#expression)) _self _x1 in +let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in _self |Var ( _x0) -> let _self = _self#vident _x0 in _self |Fun ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#ident) _x1 in +let _self = list (fun _self -> _self#ident) _self _x1 in let _self = _self#block _x2 in _self |Str _ -> _self |Unicode _ -> _self |Raw_js_code _ -> _self |Array ( _x0,_x1) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in _self |Optional_block ( _x0,_x1) -> let _self = _self#expression _x0 in _self |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = _self#list (fun _self -> _self#expression) _x0 in +let _self = list (fun _self -> _self#expression) _self _x0 in let _self = _self#expression _x2 in _self |Caml_block_tag ( _x0) -> @@ -384646,12 +384653,12 @@ let _self = _self#block _x1 in let _self = _self#block _x2 in _self |While ( _x0,_x1,_x2,_x3) -> -let _self = option (_self#label) _self _x0 in +let _self = option (fun _self -> _self#label) _self _x0 in let _self = _self#expression _x1 in let _self = _self#block _x2 in _self |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _self = option (_self#for_ident_expression) _self _x0 in +let _self = option (fun _self -> _self#for_ident_expression) _self _x0 in let _self = _self#finish_ident_expression _x1 in let _self = _self#for_ident _x2 in let _self = _self#for_direction _x3 in @@ -384666,31 +384673,31 @@ let _self = _self#expression _x0 in _self |Int_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#int_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#int_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |String_switch ( _x0,_x1,_x2) -> let _self = _self#expression _x0 in -let _self = _self#list (fun _self -> _self#string_clause) _x1 in -let _self = option (_self#block) _self _x2 in +let _self = list (fun _self -> _self#string_clause) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Throw ( _x0) -> let _self = _self#expression _x0 in _self |Try ( _x0,_x1,_x2) -> let _self = _self#block _x0 in -let _self = option (fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in -let _self = option (_self#block) _self _x2 in +let _self = option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _self _x1 in +let _self = option (fun _self -> _self#block) _self _x2 in _self |Debugger -> _self method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in -let _self = option (_self#expression) _self _x1 in _self +let _self = option (fun _self -> _self#expression) _self _x1 in _self method string_clause : string_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method int_clause : int_clause -> 'self_type = fun ( _x0,_x1) -> let _self = _self#case_clause _x1 in _self method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 in _self -method block : block -> 'self_type = _self#list (fun _self -> _self#statement) +method block : block -> 'self_type = list (fun _self -> _self#statement) _self method program : program -> 'self_type = fun { block = _x0;exports = _x1;export_set = _x2} -> let _self = _self#block _x0 in _self method deps_program : deps_program -> 'self_type = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _self = _self#program _x0 in let _self = _self#required_modules _x1 in _self diff --git a/ocaml-tree/fold_maker.js b/ocaml-tree/fold_maker.js index bd6adce1b0..a38723ceee 100644 --- a/ocaml-tree/fold_maker.js +++ b/ocaml-tree/fold_maker.js @@ -36,16 +36,12 @@ function mkBody(def, allNames) { var [list, base] = [...def.children].reverse(); switch (list.text) { case "option": + case "list": var inner = mkBody(base, allNames); if (inner === skip) { return inner; } - return `option (${inner}) _self`; - case "list": - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + return `${list.text} (fun _self -> ${inner}) _self`; default: throw new Error(`not supported high order types ${list.text}`); } @@ -141,7 +137,13 @@ function make(typedefs) { let [@inline] option sub self = fun v -> match v with | None -> self - | Some x -> sub x + | Some x -> sub self x + let rec list (sub : 'self_type -> 'a -> 'self_type) self = fun v -> + match v with + | [] -> self + | x::xs -> + let self = sub self x in + list sub self xs class fold = object ((_self : 'self_type)) method list : diff --git a/ocaml-tree/map_maker.js b/ocaml-tree/map_maker.js index 7597a205a3..6807f5ba5e 100644 --- a/ocaml-tree/map_maker.js +++ b/ocaml-tree/map_maker.js @@ -35,16 +35,12 @@ function mkBody(def, allNames) { var [list, base] = [...def.children].reverse(); switch (list.text) { case "option": + case "list": var inner = mkBody(base, allNames); if (inner === skip) { return inner; } - return `option (${inner})`; - case "list": - return `${mkBody(list, allNames)} (fun _self -> ${mkBody( - base, - allNames - )})`; + return `${list.text} (${inner})`; default: throw new Error(`not supported high order types ${list.text}`); } @@ -133,21 +129,22 @@ function make(typedefs) { var o = typedefs.map((x) => mkMethod(x, allNames)); var output = ` open J -let unknown : 'a. 'a -> 'a = fun x -> x -let option sub = fun v -> +let [@inline] unknown : 'a. 'a -> 'a = fun x -> x +let [@inline] option sub = fun v -> match v with | None -> None | Some v -> Some (sub v) +let rec list sub = fun v -> + match v with + | [] -> [] + | x::xs -> + let v = sub x in + v :: list sub xs + (* Note we need add [v] to enforce the evaluation order + it indeed cause different semantis here + *) class map = object ((_self : 'self_type)) -method list : - 'a 'a_out. ('self_type -> 'a -> 'a_out) -> 'a list -> 'a_out list = - fun _f_a -> - function - | [] -> [] - | _x :: _x_i1 -> - let _x = _f_a _self _x in - let _x_i1 = _self#list _f_a _x_i1 in _x :: _x_i1 ${o.join("\n")} end `; From 1fb566d13eb2d21fcea67f5b04ff7c92a9e12241 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Thu, 21 Jan 2021 15:30:00 +0800 Subject: [PATCH 5/5] Done! no object used --- jscomp/core/js_analyzer.ml | 84 +- jscomp/core/js_fold_basic.ml | 25 +- jscomp/core/js_pass_flatten.ml | 47 +- jscomp/core/js_pass_flatten_and_mark_dead.ml | 55 +- jscomp/core/js_pass_get_used.ml | 23 +- jscomp/core/js_pass_tailcall_inline.ml | 59 +- jscomp/core/js_record_iter.ml | 149 ++++ jscomp/core/js_record_map.ml | 178 ++++ jscomp/tools/objvsrecord.ml | 72 ++ lib/4.06.1/unstable/js_compiler.ml | 864 ++++++++++--------- lib/4.06.1/unstable/js_compiler.ml.d | 4 +- lib/4.06.1/unstable/js_refmt_compiler.ml | 864 ++++++++++--------- lib/4.06.1/unstable/js_refmt_compiler.ml.d | 4 +- lib/4.06.1/whole_compiler.ml | 864 ++++++++++--------- lib/4.06.1/whole_compiler.ml.d | 4 +- ocaml-tree/record_iter.js | 210 +++++ ocaml-tree/record_map.js | 212 +++++ ocaml-tree/test.js | 6 +- 18 files changed, 2306 insertions(+), 1418 deletions(-) create mode 100644 jscomp/core/js_record_iter.ml create mode 100644 jscomp/core/js_record_map.ml create mode 100644 jscomp/tools/objvsrecord.ml create mode 100644 ocaml-tree/record_iter.js create mode 100644 ocaml-tree/record_map.js diff --git a/jscomp/core/js_analyzer.ml b/jscomp/core/js_analyzer.ml index b424cf5e5c..62ed998a1e 100644 --- a/jscomp/core/js_analyzer.ml +++ b/jscomp/core/js_analyzer.ml @@ -44,47 +44,51 @@ let add_defined_idents (x : idents_stats) ident = Note such shaking is done in the toplevel, so that it requires us to flatten the statement first *) -let free_variables (stats : idents_stats) : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! variable_declaration st = - add_defined_idents stats st.ident; - match st.value with - | None - -> () - | Some v - -> - self # expression v - method! ident id = - (if not (Set_ident.mem stats.defined_idents id )then - stats.used_idents <- Set_ident.add stats.used_idents id) - - method! expression exp = - match exp.expression_desc with - | Fun(_, _,_, env) - (** a optimization to avoid walking into funciton again - if it's already comuted - *) - -> - stats.used_idents <- - Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents +let super = Js_record_iter.iter +let free_variables (stats : idents_stats) = { + super with + variable_declaration = begin fun self st -> + add_defined_idents stats st.ident; + match st.value with + | None + -> () + | Some v + -> + self.expression self v + end; + ident = begin fun _ id -> + if not (Set_ident.mem stats.defined_idents id )then + stats.used_idents <- Set_ident.add stats.used_idents id + end; + expression = begin fun self exp -> + match exp.expression_desc with + | Fun(_, _,_, env) + (** a optimization to avoid walking into funciton again + if it's already comuted + *) + -> + stats.used_idents <- + Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents + | _ + -> + super.expression self exp + end +} - | _ - -> - super#expression exp - end let free_variables_of_statement st = let init = {used_idents = Set_ident.empty; - defined_idents = Set_ident.empty} in - let _ = (free_variables init)#statement st in + defined_idents = Set_ident.empty} in + let obj = free_variables init in + obj.statement obj st ; Set_ident.diff init.used_idents init.defined_idents let free_variables_of_expression st = let init = {used_idents = Set_ident.empty; defined_idents = Set_ident.empty} in - let _ = (free_variables init)#expression st in + let obj = free_variables init in + obj.expression obj st ; Set_ident.diff init.used_idents init.defined_idents let rec no_side_effect_expression_desc (x : J.expression_desc) = @@ -139,10 +143,10 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect_obj : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! statement s = +let super = Js_record_iter.iter +let no_side_effect_obj = + {super with + statement = (fun self s -> match s.statement_desc with | Throw _ | Debugger @@ -150,15 +154,15 @@ let no_side_effect_obj : Js_iter.iter = | Variable _ | Continue _ -> raise_notrace Not_found - | Exp e -> self#expression e + | Exp e -> self.expression self e | Int_switch _ | String_switch _ | ForRange _ - | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! expression s = + | If _ | While _ | Block _ | Return _ | Try _ -> super.statement self s ); + expression = begin fun _ s -> if not (no_side_effect_expression s) then raise_notrace Not_found - end + end} let no_side_effect_statement st = try - no_side_effect_obj#statement st; true + no_side_effect_obj.statement no_side_effect_obj st; true with _ -> false diff --git a/jscomp/core/js_fold_basic.ml b/jscomp/core/js_fold_basic.ml index c3da2e7f3c..0309482b31 100644 --- a/jscomp/core/js_fold_basic.ml +++ b/jscomp/core/js_fold_basic.ml @@ -27,25 +27,30 @@ let add_lam_module_ident = Lam_module_ident.Hash_set.add let create = Lam_module_ident.Hash_set.create -let count_hard_dependencies hard_dependencies = - object - inherit Js_iter.iter as super - method! module_id vid = - add_lam_module_ident hard_dependencies vid - method! expression x = - (* check {!Js_pass_scope} when making changes *) + +let super = Js_record_iter.iter +let count_hard_dependencies hard_dependencies = { + super with + module_id = begin + fun _ vid -> + add_lam_module_ident hard_dependencies vid + end; + expression = begin + fun self x -> (match Js_block_runtime.check_additional_id x with | Some id -> add_lam_module_ident hard_dependencies (Lam_module_ident.of_runtime id) | _ -> ()); - super#expression x - end + super.expression self x + end +} let calculate_hard_dependencies block = let hard_dependencies = create 17 in - (count_hard_dependencies hard_dependencies)#block block ; + let obj = (count_hard_dependencies hard_dependencies) in + obj.block obj block ; hard_dependencies (* diff --git a/jscomp/core/js_pass_flatten.ml b/jscomp/core/js_pass_flatten.ml index a93ceb44ab..1a2e57ce87 100644 --- a/jscomp/core/js_pass_flatten.ml +++ b/jscomp/core/js_pass_flatten.ml @@ -36,20 +36,19 @@ *) module E = Js_exp_make module S = Js_stmt_make - -let flatten_map = - object(self) - inherit Js_map.map as super - method! statement x = +let super = Js_record_map.super +let flatten_map = { super with + + statement = (fun self x -> match x.statement_desc with | Exp ({expression_desc = Seq _; _} as v) -> - S.block ( List.rev_map self#statement (Js_analyzer.rev_flatten_seq v )) + S.block ( List.rev_map (fun x -> self.statement self x) (Js_analyzer.rev_flatten_seq v )) | Exp {expression_desc = Caml_block (args, _mutable_flag, _tag, _tag_info )} -> - S.block (Ext_list.map args (fun arg -> self#statement (S.exp arg))) + S.block (Ext_list.map args (fun arg -> self.statement self (S.exp arg))) | Exp ({expression_desc = Cond(a,b,c); comment} ) -> - { statement_desc = If (a, [ self#statement (S.exp b)], - [ self#statement (S.exp c)]); comment} + { statement_desc = If (a, [ self.statement self (S.exp b)], + [ self.statement self (S.exp c)]); comment} | Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} ) -> @@ -58,8 +57,8 @@ let flatten_map = | {statement_desc = Exp last_one ; _} :: rest_rev -> S.block (Ext_list.rev_map_append rest_rev - [self#statement @@ S.exp (E.assign a last_one)] - self#statement + [self.statement self (S.exp (E.assign a last_one))] + (fun x -> self.statement self x) ) (* TODO: here we introduce a block, should avoid it *) (* super#statement *) @@ -69,36 +68,36 @@ let flatten_map = end | Return {expression_desc = Cond (a,b,c); comment} -> - { statement_desc = If (a, [self#statement (S.return_stmt b)], - [ self#statement (S.return_stmt c)]); comment} + { statement_desc = If (a, [self.statement self (S.return_stmt b)], + [ self.statement self (S.return_stmt c)]); comment} | Return ({expression_desc = Seq _; _} as v) -> let block = Js_analyzer.rev_flatten_seq v in begin match block with | {statement_desc = Exp last_one ; _} :: rest_rev -> - super#statement - (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (self#statement))) + super.statement self + (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (fun x -> self.statement self x))) | _ -> assert false end | Block [x] -> - self#statement x - | _ -> super#statement x - - method! block b = + self.statement self x + | _ -> super.statement self x + ); + block = fun self b -> match b with | {statement_desc = Block bs } :: rest -> - self#block ( bs @ rest) + self.block self ( bs @ rest) | x::rest -> - let st = self#statement x in - let block = self#block rest in + let st = self.statement self x in + let block = self.block self rest in begin match st.statement_desc with | Block bs -> bs @ block | _ -> st :: block end | [] -> [] - end +} -let program ( x : J.program) = flatten_map # program x +let program ( x : J.program) = flatten_map.program flatten_map x diff --git a/jscomp/core/js_pass_flatten_and_mark_dead.ml b/jscomp/core/js_pass_flatten_and_mark_dead.ml index f4da271384..9e42be6c58 100644 --- a/jscomp/core/js_pass_flatten_and_mark_dead.ml +++ b/jscomp/core/js_pass_flatten_and_mark_dead.ml @@ -39,35 +39,35 @@ type meta_info = | Recursive +let super = Js_record_iter.iter let mark_dead_code (js : J.program) : J.program = let ident_use_stats : meta_info Hash_ident.t = Hash_ident.create 17 in - let mark_dead : Js_iter.iter = object (self) - inherit Js_iter.iter - method! ident ident = + let mark_dead = { super with + ident = (fun _ ident -> (match Hash_ident.find_opt ident_use_stats ident with | None -> (* First time *) Hash_ident.add ident_use_stats ident Recursive (* recursive identifiers *) | Some Recursive -> () - | Some (Info x) -> Js_op_util.update_used_stats x Used ) - method! variable_declaration vd = + | Some (Info x) -> Js_op_util.update_used_stats x Used )); + variable_declaration = fun self vd -> match vd.ident_info.used_stats with | Dead_pure -> () | Dead_non_pure -> begin match vd.value with | None -> () - | Some x -> self#expression x + | Some x -> self.expression self x end | _ -> let ({ident; ident_info ; value ; _} : J.variable_declaration) = vd in let pure = match value with | None -> true - | Some x -> (self#expression x); Js_analyzer.no_side_effect_expression x in + | Some x -> self.expression self x; Js_analyzer.no_side_effect_expression x in ( let () = if Set_ident.mem js.export_set ident then @@ -87,8 +87,8 @@ let mark_dead_code (js : J.program) : J.program = Hash_ident.add ident_use_stats ident (Info ident_info); Js_op_util.update_used_stats ident_info (if pure then Scanning_pure else Scanning_non_pure)) - end in - let () = (mark_dead#program js) in + } in + mark_dead.program mark_dead js; Hash_ident.iter ident_use_stats (fun _id (info : meta_info) -> match info with | Info ({used_stats = Scanning_pure} as info) -> @@ -152,17 +152,12 @@ let mark_dead_code (js : J.program) : J.program = ]} *) -let subst_map (substitution : J.expression Hash_ident.t) = object (self) - inherit Js_map.map as super - - - - - method add_substitue (ident : Ident.t) (e:J.expression) = +let super = Js_record_map.super +let add_substitue substitution (ident : Ident.t) (e:J.expression) = Hash_ident.replace substitution ident e - - method! statement v = +let subst_map (substitution : J.expression Hash_ident.t) = { super + with statement = (fun self v -> match v.statement_desc with | Variable ({ident = _; ident_info = {used_stats = Dead_pure } ; _}) -> {v with statement_desc = Block []} @@ -193,7 +188,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) bottomline, when the block size is one, no need to do this *) - let v' = self#expression x in + let v' = self.expression self x in let match_id = Ext_ident.create (ident.name ^ "_" ^ @@ -212,7 +207,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) expression_desc = Caml_block(List.rev e, Immutable, tag, tag_info) } in - let () = self#add_substitue ident e in + let () = add_substitue substitution ident e in (* let bindings = !bindings in *) let original_statement = { v with @@ -228,9 +223,9 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) (fun (id,v) -> S.define_variable ~kind:Strict id v) ) end - | _ -> super#statement v - - method! expression x = + | _ -> super.statement self v + ); + expression = fun self x -> match x.expression_desc with | Array_index ({expression_desc = Var (Id (id))}, {expression_desc = Number (Int {i; _})}) @@ -246,11 +241,11 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) | Some ({expression_desc = J.Var _ | Number _ | Str _ | Undefined} as x) -> x | None | Some _ -> - super#expression x ) - | Some _ | None -> super#expression x ) + super.expression self x ) + | Some _ | None -> super.expression self x ) - | _ -> super#expression x -end + | _ -> super.expression self x +} (* Top down or bottom up ?*) (* A pass to support nullary argument in JS @@ -259,9 +254,9 @@ end *) let program (js : J.program) = - js - |> (subst_map (Hash_ident.create 32) )#program - |> mark_dead_code + let obj = (subst_map (Hash_ident.create 32) ) in + let js = obj.program obj js in + mark_dead_code js (* |> mark_dead_code *) (* mark dead code twice does have effect in some cases, however, we disabled it since the benefit is not obvious diff --git a/jscomp/core/js_pass_get_used.ml b/jscomp/core/js_pass_get_used.ml index bf25ed159b..424b3999fe 100644 --- a/jscomp/core/js_pass_get_used.ml +++ b/jscomp/core/js_pass_get_used.ml @@ -48,30 +48,31 @@ let post_process_stats my_export_set (defined_idents : J.variable_declaration Ha since in this case it can not be global? *) +let super = Js_record_iter.iter let count_collects (* collect used status*) (stats : int Hash_ident.t) (* collect all def sites *) - (defined_idents : J.variable_declaration Hash_ident.t) : Js_iter.iter + (defined_idents : J.variable_declaration Hash_ident.t) = - object (self) - inherit Js_iter.iter - method! variable_declaration - ({ident; value ; property = _ ; ident_info = _} as v) - = + {super with + variable_declaration = (fun self + ({ident; value ; property = _ ; ident_info = _} as v) -> + Hash_ident.add defined_idents ident v; match value with | None -> () | Some x - -> self#expression x - method! ident id = add_use stats id - end + -> self.expression self x ); + ident = fun _ id -> add_use stats id + } let get_stats (program : J.program) : J.variable_declaration Hash_ident.t = let stats : int Hash_ident.t = Hash_ident.create 83 in let defined_idents : J.variable_declaration Hash_ident.t = Hash_ident.create 83 in - let my_export_set = program.export_set in - (count_collects stats defined_idents) #program program; + let my_export_set = program.export_set in + let obj = count_collects stats defined_idents in + obj.program obj program; post_process_stats my_export_set defined_idents stats diff --git a/jscomp/core/js_pass_tailcall_inline.ml b/jscomp/core/js_pass_tailcall_inline.ml index fbcf23947e..b2d5f48f77 100644 --- a/jscomp/core/js_pass_tailcall_inline.ml +++ b/jscomp/core/js_pass_tailcall_inline.ml @@ -40,13 +40,12 @@ module S = Js_stmt_make (* module E = Js_exp_make *) +let super = Js_record_map.super +let substitue_variables (map : Ident.t Map_ident.t) = { + super with ident = fun _ id -> + Map_ident.find_default map id id -let substitue_variables (map : Ident.t Map_ident.t) = - object - inherit Js_map.map - method! ident id = - Map_ident.find_default map id id - end +} (* 1. recursive value ? let rec x = 1 :: x non-terminating @@ -88,7 +87,9 @@ let inline_call | _ -> map, S.define_variable ~kind:Variable param arg :: acc) in if Map_ident.is_empty map then block - else (substitue_variables map) # block block + else + let obj = substitue_variables map in + obj.block obj block (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -115,10 +116,10 @@ let inline_call (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, while it is still called *) -let subst (export_set : Set_ident.t) stats = - object (self) - inherit Js_map.map as super - method! statement st = +let super = Js_record_map.super +let subst (export_set : Set_ident.t) stats = {super with + + statement = (fun self st -> match st.statement_desc with | Variable {value = _ ; @@ -130,18 +131,17 @@ let subst (export_set : Set_ident.t) stats = | Variable { ident_info = {used_stats = Dead_non_pure} ; value = Some v ; _ } -> S.exp v - | _ -> super#statement st - method! variable_declaration - ({ident; value = _ ; property = _ ; ident_info = _} as v) - = + | _ -> super.statement self st ); + variable_declaration = (fun self + ({ident; value = _ ; property = _ ; ident_info = _} as v) -> (* TODO: replacement is a bit shaky, the problem is the lambda we stored is not consistent after we did some subsititution, and the dead code removal does rely on this (otherwise, when you do beta-reduction you have to regenerate names) *) - let v = super # variable_declaration v in + let v = super . variable_declaration self v in Hash_ident.add stats ident v; (* see #278 before changes *) - v - method! block bs = + v); + block = (fun self bs -> match bs with | ({statement_desc = Variable ({value = @@ -149,17 +149,17 @@ let subst (export_set : Set_ident.t) stats = } as vd) ; comment = _} as st) :: rest -> let is_export = Set_ident.mem export_set vd.ident in if is_export then - self#statement st :: self#block rest + self.statement self st :: self.block self rest else begin match Hash_ident.find_opt stats vd.ident with (* TODO: could be improved as [mem] *) | None -> if Js_analyzer.no_side_effect_expression v - then S.exp v :: self#block rest - else self#block rest + then S.exp v :: self.block self rest + else self.block self rest - | Some _ -> self#statement st :: self#block rest + | Some _ -> self.statement self st :: self.block self rest end | [{statement_desc = @@ -182,7 +182,7 @@ let subst (export_set : Set_ident.t) stats = -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -193,7 +193,7 @@ let subst (export_set : Set_ident.t) stats = *) | (None | Some _) -> - [self#statement st ] + [self.statement self st ] end | [{statement_desc = @@ -203,21 +203,22 @@ let subst (export_set : Set_ident.t) stats = when Ext_list.same_length params args -> let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks | x :: xs -> - self#statement x :: self#block xs + self.statement self x :: self.block self xs | [] -> [] - - end + ) +} let tailcall_inline (program : J.program) = let stats = Js_pass_get_used.get_stats program in let export_set = program.export_set in - (subst export_set stats )#program program + let obj = (subst export_set stats ) in + obj.program obj program diff --git a/jscomp/core/js_record_iter.ml b/jscomp/core/js_record_iter.ml new file mode 100644 index 0000000000..016bf63361 --- /dev/null +++ b/jscomp/core/js_record_iter.ml @@ -0,0 +1,149 @@ + + open J + let unknown _ _ = () + let option sub self = fun v -> + match v with + | None -> () + | Some v -> sub self v + let rec list sub self = fun x -> + match x with + | [] -> () + | x::xs -> + sub self x ; + list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> unit + let iter : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end ) ; + vident : vident fn = ( fun _self -> function +| Id ( _x0) -> + begin _self.ident _self _x0 end +|Qualified ( _x0,_x1) -> + begin _self.module_id _self _x0 end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function +| Length ( _x0,_x1) -> + begin _self.expression _self _x0;_self.length_object _self _x1 end +|Char_of_int ( _x0) -> + begin _self.expression _self _x0 end +|Char_to_int ( _x0) -> + begin _self.expression _self _x0 end +|Is_null_or_undefined ( _x0) -> + begin _self.expression _self _x0 end +|String_append ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Bool _ -> () +|Typeof ( _x0) -> + begin _self.expression _self _x0 end +|Js_not ( _x0) -> + begin _self.expression _self _x0 end +|Seq ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Cond ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.expression _self _x1;_self.expression _self _x2 end +|Bin ( _x0,_x1,_x2) -> + begin _self.expression _self _x1;_self.expression _self _x2 end +|FlatCall ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Call ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.expression _self arg)) _self _x1 end +|String_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Array_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Static_index ( _x0,_x1,_x2) -> + begin _self.expression _self _x0 end +|New ( _x0,_x1) -> + begin _self.expression _self _x0;option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 end +|Var ( _x0) -> + begin _self.vident _self _x0 end +|Fun ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.ident _self arg)) _self _x1;_self.block _self _x2 end +|Str _ -> () +|Unicode _ -> () +|Raw_js_code _ -> () +|Array ( _x0,_x1) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0 end +|Optional_block ( _x0,_x1) -> + begin _self.expression _self _x0 end +|Caml_block ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0;_self.expression _self _x2 end +|Caml_block_tag ( _x0) -> + begin _self.expression _self _x0 end +|Number _ -> () +|Object ( _x0) -> + begin _self.property_map _self _x0 end +|Undefined -> () +|Null -> () ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function +| Block ( _x0) -> + begin _self.block _self _x0 end +|Variable ( _x0) -> + begin _self.variable_declaration _self _x0 end +|Exp ( _x0) -> + begin _self.expression _self _x0 end +|If ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.block _self _x1;_self.block _self _x2 end +|While ( _x0,_x1,_x2,_x3) -> + begin option ((fun _self arg -> _self.label _self arg)) _self _x0;_self.expression _self _x1;_self.block _self _x2 end +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + begin option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end +|Continue ( _x0) -> + begin _self.label _self _x0 end +|Break -> () +|Return ( _x0) -> + begin _self.expression _self _x0 end +|Int_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.int_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|String_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.string_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Throw ( _x0) -> + begin _self.expression _self _x0 end +|Try ( _x0,_x1,_x2) -> + begin _self.block _self _x0;option ((fun _self (_x0,_x1) -> begin _self.exception_ident _self _x0;_self.block _self _x1 end)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Debugger -> () ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin _self.expression_desc _self _x0 end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin _self.statement_desc _self _x0 end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option ((fun _self arg -> _self.expression _self arg)) _self _x1 end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;_self.required_modules _self _x1 end ) + } + \ No newline at end of file diff --git a/jscomp/core/js_record_map.ml b/jscomp/core/js_record_map.ml new file mode 100644 index 0000000000..c58402dd64 --- /dev/null +++ b/jscomp/core/js_record_map.ml @@ -0,0 +1,178 @@ + + open J + let [@inline] unknown _ x = x + let option sub self = fun v -> + match v with + | None -> None + | Some v -> Some (sub self v) + let rec list sub self = fun x -> + match x with + | [] -> [] + | x::xs -> + let v = sub self x in + v ::list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> 'a + let super : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end ) ; + vident : vident fn = ( fun _self -> function +| Id ( _x0) -> + begin let _x0 = _self.ident _self _x0 in Id ( _x0) end +|Qualified ( _x0,_x1) -> + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin let _x1 = _self.expression _self _x1 in (_x0,_x1) end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function +| Length ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.length_object _self _x1 in Length ( _x0,_x1) end +|Char_of_int ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Char_of_int ( _x0) end +|Char_to_int ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Char_to_int ( _x0) end +|Is_null_or_undefined ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Is_null_or_undefined ( _x0) end +|String_append ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_append ( _x0,_x1) end +|Bool _ as v -> v +|Typeof ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Typeof ( _x0) end +|Js_not ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Js_not ( _x0) end +|Seq ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Seq ( _x0,_x1) end +|Cond ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Cond ( _x0,_x1,_x2) end +|Bin ( _x0,_x1,_x2) -> + begin let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Bin ( _x0,_x1,_x2) end +|FlatCall ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in FlatCall ( _x0,_x1) end +|Call ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.expression _self arg)) _self _x1 in Call ( _x0,_x1,_x2) end +|String_index ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_index ( _x0,_x1) end +|Array_index ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Array_index ( _x0,_x1) end +|Static_index ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in Static_index ( _x0,_x1,_x2) end +|New ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 in New ( _x0,_x1) end +|Var ( _x0) -> + begin let _x0 = _self.vident _self _x0 in Var ( _x0) end +|Fun ( _x0,_x1,_x2,_x3) -> + begin let _x1 = list ((fun _self arg -> _self.ident _self arg)) _self _x1 in +let _x2 = _self.block _self _x2 in Fun ( _x0,_x1,_x2,_x3) end +|Str _ as v -> v +|Unicode _ as v -> v +|Raw_js_code _ as v -> v +|Array ( _x0,_x1) -> + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in Array ( _x0,_x1) end +|Optional_block ( _x0,_x1) -> + begin let _x0 = _self.expression _self _x0 in Optional_block ( _x0,_x1) end +|Caml_block ( _x0,_x1,_x2,_x3) -> + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in +let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end +|Caml_block_tag ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Caml_block_tag ( _x0) end +|Number _ as v -> v +|Object ( _x0) -> + begin let _x0 = _self.property_map _self _x0 in Object ( _x0) end +|Undefined as v -> v +|Null as v -> v ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function +| Block ( _x0) -> + begin let _x0 = _self.block _self _x0 in Block ( _x0) end +|Variable ( _x0) -> + begin let _x0 = _self.variable_declaration _self _x0 in Variable ( _x0) end +|Exp ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Exp ( _x0) end +|If ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.block _self _x1 in +let _x2 = _self.block _self _x2 in If ( _x0,_x1,_x2) end +|While ( _x0,_x1,_x2,_x3) -> + begin let _x0 = option ((fun _self arg -> _self.label _self arg)) _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.block _self _x2 in While ( _x0,_x1,_x2,_x3) end +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + begin let _x0 = option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0 in +let _x1 = _self.finish_ident_expression _self _x1 in +let _x2 = _self.for_ident _self _x2 in +let _x3 = _self.for_direction _self _x3 in +let _x4 = _self.block _self _x4 in ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) end +|Continue ( _x0) -> + begin let _x0 = _self.label _self _x0 in Continue ( _x0) end +|Break as v -> v +|Return ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Return ( _x0) end +|Int_switch ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.int_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Int_switch ( _x0,_x1,_x2) end +|String_switch ( _x0,_x1,_x2) -> + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.string_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in String_switch ( _x0,_x1,_x2) end +|Throw ( _x0) -> + begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end +|Try ( _x0,_x1,_x2) -> + begin let _x0 = _self.block _self _x0 in +let _x1 = option ((fun _self (_x0,_x1) -> begin let _x0 = _self.exception_ident _self _x0 in let _x1 = _self.block _self _x1 in (_x0,_x1) end)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Try ( _x0,_x1,_x2) end +|Debugger as v -> v ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = _self.expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = _self.statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin let _x0 = _self.ident _self _x0 in +let _x1 = option ((fun _self arg -> _self.expression _self arg)) _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin let _x0 = _self.block _self _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin let _x0 = _self.block _self _x0 in {block = _x0;exports = _x1;export_set = _x2} end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = _self.required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end ) + } + \ No newline at end of file diff --git a/jscomp/tools/objvsrecord.ml b/jscomp/tools/objvsrecord.ml new file mode 100644 index 0000000000..d99b9d2dab --- /dev/null +++ b/jscomp/tools/objvsrecord.ml @@ -0,0 +1,72 @@ +let show l = List.map (fun x -> x#show) l + +class integer x = + object + method show = () + method to_string = string_of_int x + + end +type h = < show : unit; to_string : string> +class floating x = + object + method show = () + method to_string = string_of_float x + end + +(* records *) + +type element = { show : unit -> unit ; to_string : unit -> string } + +let wrap_int x = { + show = (fun () -> ()) ; + to_string = (fun () -> string_of_int x) +} + +let wrap_float x = { + show = (fun () -> ()) ; + to_string = (fun () -> string_of_float x) +} + +(* bench *) + +let test_classes () = + let rec build_classes n acc = + if n <= 0 then + acc + else + build_classes + (pred n) + ((new floating (float_of_int n) :> h ) + :: (new integer n :> h) + :: acc) + in + let t1 = Sys.time () in + let list = build_classes 1000000 [] in + let t2 = Sys.time () in + List.iter (fun x -> x#show; x#show; x#show; x#show; x#show; x#show;x#show; x#show; x#show; x#show; x#show; x#show;) list ; + t2 -. t1, Sys.time () -. t2 + +let test_records () = + let rec build_records n acc = + if n <= 0 then + acc + else + build_records + (pred n) + ((wrap_float (float_of_int n)) + :: (wrap_int n) + :: acc) + in + let t1 = Sys.time () in + let list = build_records 1000000 [] in + let t2 = Sys.time () in + List.iter (fun x -> x.show(); x.show(); x.show();x.show(); x.show(); x.show();x.show(); x.show(); x.show();x.show(); x.show(); x.show();) list ; + t2 -. t1, Sys.time () -. t2 + +let _ = + let tci, tca = test_classes () + and tri, tra = test_records () in + Printf.printf + "Classes: build = %f, apply = %f\nRecords: build = %f, apply = %f +\n" + tci tca tri tra diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 8f140a8b6f..52fd7f47a1 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -86501,130 +86501,6 @@ let property_key (s : J.property_name) : string = | Symbol_name -> {|[Symbol.for("name")]|} end -module Js_iter -= struct -#1 "js_iter.ml" - - open J - - let option sub v = - match v with - | None -> () - | Some v -> sub v - let rec list sub v = - match v with - | [] -> () - | x::xs -> sub x ; list sub xs - class iter = object (_self : 'self_type) - method label : label -> unit = ignore -method required_modules : required_modules -> unit = (list _self#module_id) -method ident : ident -> unit = ignore -method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end -method vident : vident -> unit = function -| Id ( _x0) -> - begin _self#ident _x0 end -|Qualified ( _x0,_x1) -> - begin _self#module_id _x0 end -method exception_ident : exception_ident -> unit = _self#ident -method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) -method length_object : length_object -> unit = ignore -method expression_desc : expression_desc -> unit = function -| Length ( _x0,_x1) -> - begin _self#expression _x0;_self#length_object _x1 end -|Char_of_int ( _x0) -> - begin _self#expression _x0 end -|Char_to_int ( _x0) -> - begin _self#expression _x0 end -|Is_null_or_undefined ( _x0) -> - begin _self#expression _x0 end -|String_append ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Bool _ -> () -|Typeof ( _x0) -> - begin _self#expression _x0 end -|Js_not ( _x0) -> - begin _self#expression _x0 end -|Seq ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Cond ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#expression _x1;_self#expression _x2 end -|Bin ( _x0,_x1,_x2) -> - begin _self#expression _x1;_self#expression _x2 end -|FlatCall ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#expression) _x1 end -|String_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Array_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0 end -|New ( _x0,_x1) -> - begin _self#expression _x0;(option (list _self#expression)) _x1 end -|Var ( _x0) -> - begin _self#vident _x0 end -|Fun ( _x0,_x1,_x2,_x3) -> - begin (list _self#ident) _x1;_self#block _x2 end -|Str _ -> () -|Unicode _ -> () -|Raw_js_code _ -> () -|Array ( _x0,_x1) -> - begin (list _self#expression) _x0 end -|Optional_block ( _x0,_x1) -> - begin _self#expression _x0 end -|Caml_block ( _x0,_x1,_x2,_x3) -> - begin (list _self#expression) _x0;_self#expression _x2 end -|Caml_block_tag ( _x0) -> - begin _self#expression _x0 end -|Number _ -> () -|Object ( _x0) -> - begin _self#property_map _x0 end -|Undefined -> () -|Null -> () -method for_ident_expression : for_ident_expression -> unit = _self#expression -method finish_ident_expression : finish_ident_expression -> unit = _self#expression -method statement_desc : statement_desc -> unit = function -| Block ( _x0) -> - begin _self#block _x0 end -|Variable ( _x0) -> - begin _self#variable_declaration _x0 end -|Exp ( _x0) -> - begin _self#expression _x0 end -|If ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#block _x1;_self#block _x2 end -|While ( _x0,_x1,_x2,_x3) -> - begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end -|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end -|Continue ( _x0) -> - begin _self#label _x0 end -|Break -> () -|Return ( _x0) -> - begin _self#expression _x0 end -|Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end -|String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end -|Throw ( _x0) -> - begin _self#expression _x0 end -|Try ( _x0,_x1,_x2) -> - begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end -|Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end -method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = (list _self#statement) -method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end - end - -end module Js_op_util : sig #1 "js_op_util.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -86827,6 +86703,159 @@ let of_lam_mutable_flag (x : Asttypes.mutable_flag) : Js_op.mutable_flag = | Immutable -> Immutable | Mutable -> Mutable +end +module Js_record_iter += struct +#1 "js_record_iter.ml" + + open J + let unknown _ _ = () + let option sub self = fun v -> + match v with + | None -> () + | Some v -> sub self v + let rec list sub self = fun x -> + match x with + | [] -> () + | x::xs -> + sub self x ; + list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> unit + let iter : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end ) ; + vident : vident fn = ( fun _self -> function +| Id ( _x0) -> + begin _self.ident _self _x0 end +|Qualified ( _x0,_x1) -> + begin _self.module_id _self _x0 end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function +| Length ( _x0,_x1) -> + begin _self.expression _self _x0;_self.length_object _self _x1 end +|Char_of_int ( _x0) -> + begin _self.expression _self _x0 end +|Char_to_int ( _x0) -> + begin _self.expression _self _x0 end +|Is_null_or_undefined ( _x0) -> + begin _self.expression _self _x0 end +|String_append ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Bool _ -> () +|Typeof ( _x0) -> + begin _self.expression _self _x0 end +|Js_not ( _x0) -> + begin _self.expression _self _x0 end +|Seq ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Cond ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.expression _self _x1;_self.expression _self _x2 end +|Bin ( _x0,_x1,_x2) -> + begin _self.expression _self _x1;_self.expression _self _x2 end +|FlatCall ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Call ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.expression _self arg)) _self _x1 end +|String_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Array_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Static_index ( _x0,_x1,_x2) -> + begin _self.expression _self _x0 end +|New ( _x0,_x1) -> + begin _self.expression _self _x0;option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 end +|Var ( _x0) -> + begin _self.vident _self _x0 end +|Fun ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.ident _self arg)) _self _x1;_self.block _self _x2 end +|Str _ -> () +|Unicode _ -> () +|Raw_js_code _ -> () +|Array ( _x0,_x1) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0 end +|Optional_block ( _x0,_x1) -> + begin _self.expression _self _x0 end +|Caml_block ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0;_self.expression _self _x2 end +|Caml_block_tag ( _x0) -> + begin _self.expression _self _x0 end +|Number _ -> () +|Object ( _x0) -> + begin _self.property_map _self _x0 end +|Undefined -> () +|Null -> () ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function +| Block ( _x0) -> + begin _self.block _self _x0 end +|Variable ( _x0) -> + begin _self.variable_declaration _self _x0 end +|Exp ( _x0) -> + begin _self.expression _self _x0 end +|If ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.block _self _x1;_self.block _self _x2 end +|While ( _x0,_x1,_x2,_x3) -> + begin option ((fun _self arg -> _self.label _self arg)) _self _x0;_self.expression _self _x1;_self.block _self _x2 end +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + begin option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end +|Continue ( _x0) -> + begin _self.label _self _x0 end +|Break -> () +|Return ( _x0) -> + begin _self.expression _self _x0 end +|Int_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.int_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|String_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.string_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Throw ( _x0) -> + begin _self.expression _self _x0 end +|Try ( _x0,_x1,_x2) -> + begin _self.block _self _x0;option ((fun _self (_x0,_x1) -> begin _self.exception_ident _self _x0;_self.block _self _x1 end)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Debugger -> () ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin _self.expression_desc _self _x0 end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin _self.statement_desc _self _x0 end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option ((fun _self arg -> _self.expression _self arg)) _self _x1 end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;_self.required_modules _self _x1 end ) + } + end module Js_analyzer : sig #1 "js_analyzer.mli" @@ -86967,47 +86996,51 @@ let add_defined_idents (x : idents_stats) ident = Note such shaking is done in the toplevel, so that it requires us to flatten the statement first *) -let free_variables (stats : idents_stats) : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! variable_declaration st = - add_defined_idents stats st.ident; - match st.value with - | None - -> () - | Some v - -> - self # expression v - method! ident id = - (if not (Set_ident.mem stats.defined_idents id )then - stats.used_idents <- Set_ident.add stats.used_idents id) - - method! expression exp = - match exp.expression_desc with - | Fun(_, _,_, env) - (** a optimization to avoid walking into funciton again - if it's already comuted - *) - -> - stats.used_idents <- - Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents +let super = Js_record_iter.iter +let free_variables (stats : idents_stats) = { + super with + variable_declaration = begin fun self st -> + add_defined_idents stats st.ident; + match st.value with + | None + -> () + | Some v + -> + self.expression self v + end; + ident = begin fun _ id -> + if not (Set_ident.mem stats.defined_idents id )then + stats.used_idents <- Set_ident.add stats.used_idents id + end; + expression = begin fun self exp -> + match exp.expression_desc with + | Fun(_, _,_, env) + (** a optimization to avoid walking into funciton again + if it's already comuted + *) + -> + stats.used_idents <- + Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents + | _ + -> + super.expression self exp + end +} - | _ - -> - super#expression exp - end let free_variables_of_statement st = let init = {used_idents = Set_ident.empty; - defined_idents = Set_ident.empty} in - let _ = (free_variables init)#statement st in + defined_idents = Set_ident.empty} in + let obj = free_variables init in + obj.statement obj st ; Set_ident.diff init.used_idents init.defined_idents let free_variables_of_expression st = let init = {used_idents = Set_ident.empty; defined_idents = Set_ident.empty} in - let _ = (free_variables init)#expression st in + let obj = free_variables init in + obj.expression obj st ; Set_ident.diff init.used_idents init.defined_idents let rec no_side_effect_expression_desc (x : J.expression_desc) = @@ -87062,10 +87095,10 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect_obj : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! statement s = +let super = Js_record_iter.iter +let no_side_effect_obj = + {super with + statement = (fun self s -> match s.statement_desc with | Throw _ | Debugger @@ -87073,15 +87106,15 @@ let no_side_effect_obj : Js_iter.iter = | Variable _ | Continue _ -> raise_notrace Not_found - | Exp e -> self#expression e + | Exp e -> self.expression self e | Int_switch _ | String_switch _ | ForRange _ - | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! expression s = + | If _ | While _ | Block _ | Return _ | Try _ -> super.statement self s ); + expression = begin fun _ s -> if not (no_side_effect_expression s) then raise_notrace Not_found - end + end} let no_side_effect_statement st = try - no_side_effect_obj#statement st; true + no_side_effect_obj.statement no_side_effect_obj st; true with _ -> false @@ -99133,25 +99166,30 @@ end = struct let add_lam_module_ident = Lam_module_ident.Hash_set.add let create = Lam_module_ident.Hash_set.create -let count_hard_dependencies hard_dependencies = - object - inherit Js_iter.iter as super - method! module_id vid = - add_lam_module_ident hard_dependencies vid - method! expression x = - (* check {!Js_pass_scope} when making changes *) + +let super = Js_record_iter.iter +let count_hard_dependencies hard_dependencies = { + super with + module_id = begin + fun _ vid -> + add_lam_module_ident hard_dependencies vid + end; + expression = begin + fun self x -> (match Js_block_runtime.check_additional_id x with | Some id -> add_lam_module_ident hard_dependencies (Lam_module_ident.of_runtime id) | _ -> ()); - super#expression x - end + super.expression self x + end +} let calculate_hard_dependencies block = let hard_dependencies = create 17 in - (count_hard_dependencies hard_dependencies)#block block ; + let obj = (count_hard_dependencies hard_dependencies) in + obj.block obj block ; hard_dependencies (* @@ -101352,201 +101390,187 @@ end = struct end -module Js_map +module Js_record_map = struct -#1 "js_map.ml" +#1 "js_record_map.ml" -open J -let [@inline] unknown : 'a. 'a -> 'a = fun x -> x -let [@inline] option sub = fun v -> - match v with - | None -> None - | Some v -> Some (sub v) -let rec list sub = fun v -> - match v with - | [] -> [] - | x::xs -> - let v = sub x in - v :: list sub xs - (* Note we need add [v] to enforce the evaluation order - it indeed cause different semantis here - *) -class map = object -((_self : 'self_type)) -method label : label -> label = unknown -method required_modules : required_modules -> required_modules = list (_self#module_id) -method ident : ident -> ident = unknown -method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} -method vident : vident -> vident = function + open J + let [@inline] unknown _ x = x + let option sub self = fun v -> + match v with + | None -> None + | Some v -> Some (sub self v) + let rec list sub self = fun x -> + match x with + | [] -> [] + | x::xs -> + let v = sub self x in + v ::list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> 'a + let super : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end ) ; + vident : vident fn = ( fun _self -> function | Id ( _x0) -> -let _x0 = _self#ident _x0 in -Id ( _x0) + begin let _x0 = _self.ident _self _x0 in Id ( _x0) end |Qualified ( _x0,_x1) -> -let _x0 = _self#module_id _x0 in -Qualified ( _x0,_x1) -method exception_ident : exception_ident -> exception_ident = _self#ident -method for_ident : for_ident -> for_ident = _self#ident -method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) -method length_object : length_object -> length_object = unknown -method expression_desc : expression_desc -> expression_desc = function + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin let _x1 = _self.expression _self _x1 in (_x0,_x1) end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function | Length ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#length_object _x1 in -Length ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.length_object _self _x1 in Length ( _x0,_x1) end |Char_of_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_of_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_of_int ( _x0) end |Char_to_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_to_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_to_int ( _x0) end |Is_null_or_undefined ( _x0) -> -let _x0 = _self#expression _x0 in -Is_null_or_undefined ( _x0) + begin let _x0 = _self.expression _self _x0 in Is_null_or_undefined ( _x0) end |String_append ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_append ( _x0,_x1) -|Bool _ as v -> v + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_append ( _x0,_x1) end +|Bool _ as v -> v |Typeof ( _x0) -> -let _x0 = _self#expression _x0 in -Typeof ( _x0) + begin let _x0 = _self.expression _self _x0 in Typeof ( _x0) end |Js_not ( _x0) -> -let _x0 = _self#expression _x0 in -Js_not ( _x0) + begin let _x0 = _self.expression _self _x0 in Js_not ( _x0) end |Seq ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Seq ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Seq ( _x0,_x1) end |Cond ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Cond ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Cond ( _x0,_x1,_x2) end |Bin ( _x0,_x1,_x2) -> -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Bin ( _x0,_x1,_x2) + begin let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Bin ( _x0,_x1,_x2) end |FlatCall ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -FlatCall ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in FlatCall ( _x0,_x1) end |Call ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#expression) _x1 in -Call ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.expression _self arg)) _self _x1 in Call ( _x0,_x1,_x2) end |String_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_index ( _x0,_x1) end |Array_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Array_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Array_index ( _x0,_x1) end |Static_index ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -Static_index ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in Static_index ( _x0,_x1,_x2) end |New ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = option (list (_self#expression)) _x1 in -New ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 in New ( _x0,_x1) end |Var ( _x0) -> -let _x0 = _self#vident _x0 in -Var ( _x0) + begin let _x0 = _self.vident _self _x0 in Var ( _x0) end |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = list (_self#ident) _x1 in -let _x2 = _self#block _x2 in -Fun ( _x0,_x1,_x2,_x3) -|Str _ as v -> v -|Unicode _ as v -> v -|Raw_js_code _ as v -> v + begin let _x1 = list ((fun _self arg -> _self.ident _self arg)) _self _x1 in +let _x2 = _self.block _self _x2 in Fun ( _x0,_x1,_x2,_x3) end +|Str _ as v -> v +|Unicode _ as v -> v +|Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = list (_self#expression) _x0 in -Array ( _x0,_x1) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in Array ( _x0,_x1) end |Optional_block ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -Optional_block ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in Optional_block ( _x0,_x1) end |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = list (_self#expression) _x0 in -let _x2 = _self#expression _x2 in -Caml_block ( _x0,_x1,_x2,_x3) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in +let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end |Caml_block_tag ( _x0) -> -let _x0 = _self#expression _x0 in -Caml_block_tag ( _x0) -|Number _ as v -> v + begin let _x0 = _self.expression _self _x0 in Caml_block_tag ( _x0) end +|Number _ as v -> v |Object ( _x0) -> -let _x0 = _self#property_map _x0 in -Object ( _x0) + begin let _x0 = _self.property_map _self _x0 in Object ( _x0) end |Undefined as v -> v -|Null as v -> v -method for_ident_expression : for_ident_expression -> for_ident_expression = _self#expression -method finish_ident_expression : finish_ident_expression -> finish_ident_expression = _self#expression -method statement_desc : statement_desc -> statement_desc = function +|Null as v -> v ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function | Block ( _x0) -> -let _x0 = _self#block _x0 in -Block ( _x0) + begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> -let _x0 = _self#variable_declaration _x0 in -Variable ( _x0) + begin let _x0 = _self.variable_declaration _self _x0 in Variable ( _x0) end |Exp ( _x0) -> -let _x0 = _self#expression _x0 in -Exp ( _x0) + begin let _x0 = _self.expression _self _x0 in Exp ( _x0) end |If ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#block _x1 in -let _x2 = _self#block _x2 in -If ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.block _self _x1 in +let _x2 = _self.block _self _x2 in If ( _x0,_x1,_x2) end |While ( _x0,_x1,_x2,_x3) -> -let _x0 = option (_self#label) _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#block _x2 in -While ( _x0,_x1,_x2,_x3) + begin let _x0 = option ((fun _self arg -> _self.label _self arg)) _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.block _self _x2 in While ( _x0,_x1,_x2,_x3) end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = option (_self#for_ident_expression) _x0 in -let _x1 = _self#finish_ident_expression _x1 in -let _x2 = _self#for_ident _x2 in -let _x3 = _self#for_direction _x3 in -let _x4 = _self#block _x4 in -ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) + begin let _x0 = option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0 in +let _x1 = _self.finish_ident_expression _self _x1 in +let _x2 = _self.for_ident _self _x2 in +let _x3 = _self.for_direction _self _x3 in +let _x4 = _self.block _self _x4 in ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) end |Continue ( _x0) -> -let _x0 = _self#label _x0 in -Continue ( _x0) + begin let _x0 = _self.label _self _x0 in Continue ( _x0) end |Break as v -> v |Return ( _x0) -> -let _x0 = _self#expression _x0 in -Return ( _x0) + begin let _x0 = _self.expression _self _x0 in Return ( _x0) end |Int_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#int_clause) _x1 in -let _x2 = option (_self#block) _x2 in -Int_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.int_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Int_switch ( _x0,_x1,_x2) end |String_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#string_clause) _x1 in -let _x2 = option (_self#block) _x2 in -String_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.string_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> -let _x0 = _self#expression _x0 in -Throw ( _x0) + begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end |Try ( _x0,_x1,_x2) -> -let _x0 = _self#block _x0 in -let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = option (_self#block) _x2 in -Try ( _x0,_x1,_x2) -|Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} -method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} -method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = list (_self#statement) -method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} -method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} -end - + begin let _x0 = _self.block _self _x0 in +let _x1 = option ((fun _self (_x0,_x1) -> begin let _x0 = _self.exception_ident _self _x0 in let _x1 = _self.block _self _x1 in (_x0,_x1) end)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Try ( _x0,_x1,_x2) end +|Debugger as v -> v ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = _self.expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = _self.statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin let _x0 = _self.ident _self _x0 in +let _x1 = option ((fun _self arg -> _self.expression _self arg)) _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin let _x0 = _self.block _self _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin let _x0 = _self.block _self _x0 in {block = _x0;exports = _x1;export_set = _x2} end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = _self.required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end ) + } + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -101634,20 +101658,19 @@ end = struct *) module E = Js_exp_make module S = Js_stmt_make - -let flatten_map = - object(self) - inherit Js_map.map as super - method! statement x = +let super = Js_record_map.super +let flatten_map = { super with + + statement = (fun self x -> match x.statement_desc with | Exp ({expression_desc = Seq _; _} as v) -> - S.block ( List.rev_map self#statement (Js_analyzer.rev_flatten_seq v )) + S.block ( List.rev_map (fun x -> self.statement self x) (Js_analyzer.rev_flatten_seq v )) | Exp {expression_desc = Caml_block (args, _mutable_flag, _tag, _tag_info )} -> - S.block (Ext_list.map args (fun arg -> self#statement (S.exp arg))) + S.block (Ext_list.map args (fun arg -> self.statement self (S.exp arg))) | Exp ({expression_desc = Cond(a,b,c); comment} ) -> - { statement_desc = If (a, [ self#statement (S.exp b)], - [ self#statement (S.exp c)]); comment} + { statement_desc = If (a, [ self.statement self (S.exp b)], + [ self.statement self (S.exp c)]); comment} | Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} ) -> @@ -101656,8 +101679,8 @@ let flatten_map = | {statement_desc = Exp last_one ; _} :: rest_rev -> S.block (Ext_list.rev_map_append rest_rev - [self#statement @@ S.exp (E.assign a last_one)] - self#statement + [self.statement self (S.exp (E.assign a last_one))] + (fun x -> self.statement self x) ) (* TODO: here we introduce a block, should avoid it *) (* super#statement *) @@ -101667,39 +101690,39 @@ let flatten_map = end | Return {expression_desc = Cond (a,b,c); comment} -> - { statement_desc = If (a, [self#statement (S.return_stmt b)], - [ self#statement (S.return_stmt c)]); comment} + { statement_desc = If (a, [self.statement self (S.return_stmt b)], + [ self.statement self (S.return_stmt c)]); comment} | Return ({expression_desc = Seq _; _} as v) -> let block = Js_analyzer.rev_flatten_seq v in begin match block with | {statement_desc = Exp last_one ; _} :: rest_rev -> - super#statement - (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (self#statement))) + super.statement self + (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (fun x -> self.statement self x))) | _ -> assert false end | Block [x] -> - self#statement x - | _ -> super#statement x - - method! block b = + self.statement self x + | _ -> super.statement self x + ); + block = fun self b -> match b with | {statement_desc = Block bs } :: rest -> - self#block ( bs @ rest) + self.block self ( bs @ rest) | x::rest -> - let st = self#statement x in - let block = self#block rest in + let st = self.statement self x in + let block = self.block self rest in begin match st.statement_desc with | Block bs -> bs @ block | _ -> st :: block end | [] -> [] - end +} -let program ( x : J.program) = flatten_map # program x +let program ( x : J.program) = flatten_map.program flatten_map x end module Js_pass_flatten_and_mark_dead : sig @@ -101782,35 +101805,35 @@ type meta_info = | Recursive +let super = Js_record_iter.iter let mark_dead_code (js : J.program) : J.program = let ident_use_stats : meta_info Hash_ident.t = Hash_ident.create 17 in - let mark_dead : Js_iter.iter = object (self) - inherit Js_iter.iter - method! ident ident = + let mark_dead = { super with + ident = (fun _ ident -> (match Hash_ident.find_opt ident_use_stats ident with | None -> (* First time *) Hash_ident.add ident_use_stats ident Recursive (* recursive identifiers *) | Some Recursive -> () - | Some (Info x) -> Js_op_util.update_used_stats x Used ) - method! variable_declaration vd = + | Some (Info x) -> Js_op_util.update_used_stats x Used )); + variable_declaration = fun self vd -> match vd.ident_info.used_stats with | Dead_pure -> () | Dead_non_pure -> begin match vd.value with | None -> () - | Some x -> self#expression x + | Some x -> self.expression self x end | _ -> let ({ident; ident_info ; value ; _} : J.variable_declaration) = vd in let pure = match value with | None -> true - | Some x -> (self#expression x); Js_analyzer.no_side_effect_expression x in + | Some x -> self.expression self x; Js_analyzer.no_side_effect_expression x in ( let () = if Set_ident.mem js.export_set ident then @@ -101830,8 +101853,8 @@ let mark_dead_code (js : J.program) : J.program = Hash_ident.add ident_use_stats ident (Info ident_info); Js_op_util.update_used_stats ident_info (if pure then Scanning_pure else Scanning_non_pure)) - end in - let () = (mark_dead#program js) in + } in + mark_dead.program mark_dead js; Hash_ident.iter ident_use_stats (fun _id (info : meta_info) -> match info with | Info ({used_stats = Scanning_pure} as info) -> @@ -101895,17 +101918,12 @@ let mark_dead_code (js : J.program) : J.program = ]} *) -let subst_map (substitution : J.expression Hash_ident.t) = object (self) - inherit Js_map.map as super - - - - - method add_substitue (ident : Ident.t) (e:J.expression) = +let super = Js_record_map.super +let add_substitue substitution (ident : Ident.t) (e:J.expression) = Hash_ident.replace substitution ident e - - method! statement v = +let subst_map (substitution : J.expression Hash_ident.t) = { super + with statement = (fun self v -> match v.statement_desc with | Variable ({ident = _; ident_info = {used_stats = Dead_pure } ; _}) -> {v with statement_desc = Block []} @@ -101936,7 +101954,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) bottomline, when the block size is one, no need to do this *) - let v' = self#expression x in + let v' = self.expression self x in let match_id = Ext_ident.create (ident.name ^ "_" ^ @@ -101955,7 +101973,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) expression_desc = Caml_block(List.rev e, Immutable, tag, tag_info) } in - let () = self#add_substitue ident e in + let () = add_substitue substitution ident e in (* let bindings = !bindings in *) let original_statement = { v with @@ -101971,9 +101989,9 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) (fun (id,v) -> S.define_variable ~kind:Strict id v) ) end - | _ -> super#statement v - - method! expression x = + | _ -> super.statement self v + ); + expression = fun self x -> match x.expression_desc with | Array_index ({expression_desc = Var (Id (id))}, {expression_desc = Number (Int {i; _})}) @@ -101989,11 +102007,11 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) | Some ({expression_desc = J.Var _ | Number _ | Str _ | Undefined} as x) -> x | None | Some _ -> - super#expression x ) - | Some _ | None -> super#expression x ) + super.expression self x ) + | Some _ | None -> super.expression self x ) - | _ -> super#expression x -end + | _ -> super.expression self x +} (* Top down or bottom up ?*) (* A pass to support nullary argument in JS @@ -102002,9 +102020,9 @@ end *) let program (js : J.program) = - js - |> (subst_map (Hash_ident.create 32) )#program - |> mark_dead_code + let obj = (subst_map (Hash_ident.create 32) ) in + let js = obj.program obj js in + mark_dead_code js (* |> mark_dead_code *) (* mark dead code twice does have effect in some cases, however, we disabled it since the benefit is not obvious @@ -102657,32 +102675,33 @@ let post_process_stats my_export_set (defined_idents : J.variable_declaration Ha since in this case it can not be global? *) +let super = Js_record_iter.iter let count_collects (* collect used status*) (stats : int Hash_ident.t) (* collect all def sites *) - (defined_idents : J.variable_declaration Hash_ident.t) : Js_iter.iter + (defined_idents : J.variable_declaration Hash_ident.t) = - object (self) - inherit Js_iter.iter - method! variable_declaration - ({ident; value ; property = _ ; ident_info = _} as v) - = + {super with + variable_declaration = (fun self + ({ident; value ; property = _ ; ident_info = _} as v) -> + Hash_ident.add defined_idents ident v; match value with | None -> () | Some x - -> self#expression x - method! ident id = add_use stats id - end + -> self.expression self x ); + ident = fun _ id -> add_use stats id + } let get_stats (program : J.program) : J.variable_declaration Hash_ident.t = let stats : int Hash_ident.t = Hash_ident.create 83 in let defined_idents : J.variable_declaration Hash_ident.t = Hash_ident.create 83 in - let my_export_set = program.export_set in - (count_collects stats defined_idents) #program program; + let my_export_set = program.export_set in + let obj = count_collects stats defined_idents in + obj.program obj program; post_process_stats my_export_set defined_idents stats end @@ -102778,13 +102797,12 @@ end = struct module S = Js_stmt_make (* module E = Js_exp_make *) +let super = Js_record_map.super +let substitue_variables (map : Ident.t Map_ident.t) = { + super with ident = fun _ id -> + Map_ident.find_default map id id -let substitue_variables (map : Ident.t Map_ident.t) = - object - inherit Js_map.map - method! ident id = - Map_ident.find_default map id id - end +} (* 1. recursive value ? let rec x = 1 :: x non-terminating @@ -102826,7 +102844,9 @@ let inline_call | _ -> map, S.define_variable ~kind:Variable param arg :: acc) in if Map_ident.is_empty map then block - else (substitue_variables map) # block block + else + let obj = substitue_variables map in + obj.block obj block (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -102853,10 +102873,10 @@ let inline_call (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, while it is still called *) -let subst (export_set : Set_ident.t) stats = - object (self) - inherit Js_map.map as super - method! statement st = +let super = Js_record_map.super +let subst (export_set : Set_ident.t) stats = {super with + + statement = (fun self st -> match st.statement_desc with | Variable {value = _ ; @@ -102868,18 +102888,17 @@ let subst (export_set : Set_ident.t) stats = | Variable { ident_info = {used_stats = Dead_non_pure} ; value = Some v ; _ } -> S.exp v - | _ -> super#statement st - method! variable_declaration - ({ident; value = _ ; property = _ ; ident_info = _} as v) - = + | _ -> super.statement self st ); + variable_declaration = (fun self + ({ident; value = _ ; property = _ ; ident_info = _} as v) -> (* TODO: replacement is a bit shaky, the problem is the lambda we stored is not consistent after we did some subsititution, and the dead code removal does rely on this (otherwise, when you do beta-reduction you have to regenerate names) *) - let v = super # variable_declaration v in + let v = super . variable_declaration self v in Hash_ident.add stats ident v; (* see #278 before changes *) - v - method! block bs = + v); + block = (fun self bs -> match bs with | ({statement_desc = Variable ({value = @@ -102887,17 +102906,17 @@ let subst (export_set : Set_ident.t) stats = } as vd) ; comment = _} as st) :: rest -> let is_export = Set_ident.mem export_set vd.ident in if is_export then - self#statement st :: self#block rest + self.statement self st :: self.block self rest else begin match Hash_ident.find_opt stats vd.ident with (* TODO: could be improved as [mem] *) | None -> if Js_analyzer.no_side_effect_expression v - then S.exp v :: self#block rest - else self#block rest + then S.exp v :: self.block self rest + else self.block self rest - | Some _ -> self#statement st :: self#block rest + | Some _ -> self.statement self st :: self.block self rest end | [{statement_desc = @@ -102920,7 +102939,7 @@ let subst (export_set : Set_ident.t) stats = -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -102931,7 +102950,7 @@ let subst (export_set : Set_ident.t) stats = *) | (None | Some _) -> - [self#statement st ] + [self.statement self st ] end | [{statement_desc = @@ -102941,22 +102960,23 @@ let subst (export_set : Set_ident.t) stats = when Ext_list.same_length params args -> let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks | x :: xs -> - self#statement x :: self#block xs + self.statement self x :: self.block self xs | [] -> [] - - end + ) +} let tailcall_inline (program : J.program) = let stats = Js_pass_get_used.get_stats program in let export_set = program.export_set in - (subst export_set stats )#program program + let obj = (subst export_set stats ) in + obj.program obj program diff --git a/lib/4.06.1/unstable/js_compiler.ml.d b/lib/4.06.1/unstable/js_compiler.ml.d index c7520cec5a..c64dd6f420 100644 --- a/lib/4.06.1/unstable/js_compiler.ml.d +++ b/lib/4.06.1/unstable/js_compiler.ml.d @@ -180,10 +180,8 @@ ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_fold_basic.mli ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_fun_env.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_fun_env.mli -../lib/4.06.1/unstable/js_compiler.ml: ./core/js_iter.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_long.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_long.mli -../lib/4.06.1/unstable/js_compiler.ml: ./core/js_map.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_name_of_module_id.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_name_of_module_id.mli ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_number.ml @@ -222,6 +220,8 @@ ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_pass_tailcall_inline.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_pass_tailcall_inline.mli ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_raw_info.ml +../lib/4.06.1/unstable/js_compiler.ml: ./core/js_record_iter.ml +../lib/4.06.1/unstable/js_compiler.ml: ./core/js_record_map.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_shake.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_shake.mli ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_stmt_make.ml diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index bea4598eb6..68c6912f6e 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -86501,130 +86501,6 @@ let property_key (s : J.property_name) : string = | Symbol_name -> {|[Symbol.for("name")]|} end -module Js_iter -= struct -#1 "js_iter.ml" - - open J - - let option sub v = - match v with - | None -> () - | Some v -> sub v - let rec list sub v = - match v with - | [] -> () - | x::xs -> sub x ; list sub xs - class iter = object (_self : 'self_type) - method label : label -> unit = ignore -method required_modules : required_modules -> unit = (list _self#module_id) -method ident : ident -> unit = ignore -method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end -method vident : vident -> unit = function -| Id ( _x0) -> - begin _self#ident _x0 end -|Qualified ( _x0,_x1) -> - begin _self#module_id _x0 end -method exception_ident : exception_ident -> unit = _self#ident -method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) -method length_object : length_object -> unit = ignore -method expression_desc : expression_desc -> unit = function -| Length ( _x0,_x1) -> - begin _self#expression _x0;_self#length_object _x1 end -|Char_of_int ( _x0) -> - begin _self#expression _x0 end -|Char_to_int ( _x0) -> - begin _self#expression _x0 end -|Is_null_or_undefined ( _x0) -> - begin _self#expression _x0 end -|String_append ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Bool _ -> () -|Typeof ( _x0) -> - begin _self#expression _x0 end -|Js_not ( _x0) -> - begin _self#expression _x0 end -|Seq ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Cond ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#expression _x1;_self#expression _x2 end -|Bin ( _x0,_x1,_x2) -> - begin _self#expression _x1;_self#expression _x2 end -|FlatCall ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#expression) _x1 end -|String_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Array_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0 end -|New ( _x0,_x1) -> - begin _self#expression _x0;(option (list _self#expression)) _x1 end -|Var ( _x0) -> - begin _self#vident _x0 end -|Fun ( _x0,_x1,_x2,_x3) -> - begin (list _self#ident) _x1;_self#block _x2 end -|Str _ -> () -|Unicode _ -> () -|Raw_js_code _ -> () -|Array ( _x0,_x1) -> - begin (list _self#expression) _x0 end -|Optional_block ( _x0,_x1) -> - begin _self#expression _x0 end -|Caml_block ( _x0,_x1,_x2,_x3) -> - begin (list _self#expression) _x0;_self#expression _x2 end -|Caml_block_tag ( _x0) -> - begin _self#expression _x0 end -|Number _ -> () -|Object ( _x0) -> - begin _self#property_map _x0 end -|Undefined -> () -|Null -> () -method for_ident_expression : for_ident_expression -> unit = _self#expression -method finish_ident_expression : finish_ident_expression -> unit = _self#expression -method statement_desc : statement_desc -> unit = function -| Block ( _x0) -> - begin _self#block _x0 end -|Variable ( _x0) -> - begin _self#variable_declaration _x0 end -|Exp ( _x0) -> - begin _self#expression _x0 end -|If ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#block _x1;_self#block _x2 end -|While ( _x0,_x1,_x2,_x3) -> - begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end -|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end -|Continue ( _x0) -> - begin _self#label _x0 end -|Break -> () -|Return ( _x0) -> - begin _self#expression _x0 end -|Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end -|String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end -|Throw ( _x0) -> - begin _self#expression _x0 end -|Try ( _x0,_x1,_x2) -> - begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end -|Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end -method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = (list _self#statement) -method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end - end - -end module Js_op_util : sig #1 "js_op_util.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -86827,6 +86703,159 @@ let of_lam_mutable_flag (x : Asttypes.mutable_flag) : Js_op.mutable_flag = | Immutable -> Immutable | Mutable -> Mutable +end +module Js_record_iter += struct +#1 "js_record_iter.ml" + + open J + let unknown _ _ = () + let option sub self = fun v -> + match v with + | None -> () + | Some v -> sub self v + let rec list sub self = fun x -> + match x with + | [] -> () + | x::xs -> + sub self x ; + list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> unit + let iter : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end ) ; + vident : vident fn = ( fun _self -> function +| Id ( _x0) -> + begin _self.ident _self _x0 end +|Qualified ( _x0,_x1) -> + begin _self.module_id _self _x0 end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function +| Length ( _x0,_x1) -> + begin _self.expression _self _x0;_self.length_object _self _x1 end +|Char_of_int ( _x0) -> + begin _self.expression _self _x0 end +|Char_to_int ( _x0) -> + begin _self.expression _self _x0 end +|Is_null_or_undefined ( _x0) -> + begin _self.expression _self _x0 end +|String_append ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Bool _ -> () +|Typeof ( _x0) -> + begin _self.expression _self _x0 end +|Js_not ( _x0) -> + begin _self.expression _self _x0 end +|Seq ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Cond ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.expression _self _x1;_self.expression _self _x2 end +|Bin ( _x0,_x1,_x2) -> + begin _self.expression _self _x1;_self.expression _self _x2 end +|FlatCall ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Call ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.expression _self arg)) _self _x1 end +|String_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Array_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Static_index ( _x0,_x1,_x2) -> + begin _self.expression _self _x0 end +|New ( _x0,_x1) -> + begin _self.expression _self _x0;option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 end +|Var ( _x0) -> + begin _self.vident _self _x0 end +|Fun ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.ident _self arg)) _self _x1;_self.block _self _x2 end +|Str _ -> () +|Unicode _ -> () +|Raw_js_code _ -> () +|Array ( _x0,_x1) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0 end +|Optional_block ( _x0,_x1) -> + begin _self.expression _self _x0 end +|Caml_block ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0;_self.expression _self _x2 end +|Caml_block_tag ( _x0) -> + begin _self.expression _self _x0 end +|Number _ -> () +|Object ( _x0) -> + begin _self.property_map _self _x0 end +|Undefined -> () +|Null -> () ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function +| Block ( _x0) -> + begin _self.block _self _x0 end +|Variable ( _x0) -> + begin _self.variable_declaration _self _x0 end +|Exp ( _x0) -> + begin _self.expression _self _x0 end +|If ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.block _self _x1;_self.block _self _x2 end +|While ( _x0,_x1,_x2,_x3) -> + begin option ((fun _self arg -> _self.label _self arg)) _self _x0;_self.expression _self _x1;_self.block _self _x2 end +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + begin option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end +|Continue ( _x0) -> + begin _self.label _self _x0 end +|Break -> () +|Return ( _x0) -> + begin _self.expression _self _x0 end +|Int_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.int_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|String_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.string_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Throw ( _x0) -> + begin _self.expression _self _x0 end +|Try ( _x0,_x1,_x2) -> + begin _self.block _self _x0;option ((fun _self (_x0,_x1) -> begin _self.exception_ident _self _x0;_self.block _self _x1 end)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Debugger -> () ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin _self.expression_desc _self _x0 end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin _self.statement_desc _self _x0 end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option ((fun _self arg -> _self.expression _self arg)) _self _x1 end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;_self.required_modules _self _x1 end ) + } + end module Js_analyzer : sig #1 "js_analyzer.mli" @@ -86967,47 +86996,51 @@ let add_defined_idents (x : idents_stats) ident = Note such shaking is done in the toplevel, so that it requires us to flatten the statement first *) -let free_variables (stats : idents_stats) : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! variable_declaration st = - add_defined_idents stats st.ident; - match st.value with - | None - -> () - | Some v - -> - self # expression v - method! ident id = - (if not (Set_ident.mem stats.defined_idents id )then - stats.used_idents <- Set_ident.add stats.used_idents id) - - method! expression exp = - match exp.expression_desc with - | Fun(_, _,_, env) - (** a optimization to avoid walking into funciton again - if it's already comuted - *) - -> - stats.used_idents <- - Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents +let super = Js_record_iter.iter +let free_variables (stats : idents_stats) = { + super with + variable_declaration = begin fun self st -> + add_defined_idents stats st.ident; + match st.value with + | None + -> () + | Some v + -> + self.expression self v + end; + ident = begin fun _ id -> + if not (Set_ident.mem stats.defined_idents id )then + stats.used_idents <- Set_ident.add stats.used_idents id + end; + expression = begin fun self exp -> + match exp.expression_desc with + | Fun(_, _,_, env) + (** a optimization to avoid walking into funciton again + if it's already comuted + *) + -> + stats.used_idents <- + Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents + | _ + -> + super.expression self exp + end +} - | _ - -> - super#expression exp - end let free_variables_of_statement st = let init = {used_idents = Set_ident.empty; - defined_idents = Set_ident.empty} in - let _ = (free_variables init)#statement st in + defined_idents = Set_ident.empty} in + let obj = free_variables init in + obj.statement obj st ; Set_ident.diff init.used_idents init.defined_idents let free_variables_of_expression st = let init = {used_idents = Set_ident.empty; defined_idents = Set_ident.empty} in - let _ = (free_variables init)#expression st in + let obj = free_variables init in + obj.expression obj st ; Set_ident.diff init.used_idents init.defined_idents let rec no_side_effect_expression_desc (x : J.expression_desc) = @@ -87062,10 +87095,10 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect_obj : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! statement s = +let super = Js_record_iter.iter +let no_side_effect_obj = + {super with + statement = (fun self s -> match s.statement_desc with | Throw _ | Debugger @@ -87073,15 +87106,15 @@ let no_side_effect_obj : Js_iter.iter = | Variable _ | Continue _ -> raise_notrace Not_found - | Exp e -> self#expression e + | Exp e -> self.expression self e | Int_switch _ | String_switch _ | ForRange _ - | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! expression s = + | If _ | While _ | Block _ | Return _ | Try _ -> super.statement self s ); + expression = begin fun _ s -> if not (no_side_effect_expression s) then raise_notrace Not_found - end + end} let no_side_effect_statement st = try - no_side_effect_obj#statement st; true + no_side_effect_obj.statement no_side_effect_obj st; true with _ -> false @@ -99133,25 +99166,30 @@ end = struct let add_lam_module_ident = Lam_module_ident.Hash_set.add let create = Lam_module_ident.Hash_set.create -let count_hard_dependencies hard_dependencies = - object - inherit Js_iter.iter as super - method! module_id vid = - add_lam_module_ident hard_dependencies vid - method! expression x = - (* check {!Js_pass_scope} when making changes *) + +let super = Js_record_iter.iter +let count_hard_dependencies hard_dependencies = { + super with + module_id = begin + fun _ vid -> + add_lam_module_ident hard_dependencies vid + end; + expression = begin + fun self x -> (match Js_block_runtime.check_additional_id x with | Some id -> add_lam_module_ident hard_dependencies (Lam_module_ident.of_runtime id) | _ -> ()); - super#expression x - end + super.expression self x + end +} let calculate_hard_dependencies block = let hard_dependencies = create 17 in - (count_hard_dependencies hard_dependencies)#block block ; + let obj = (count_hard_dependencies hard_dependencies) in + obj.block obj block ; hard_dependencies (* @@ -101352,201 +101390,187 @@ end = struct end -module Js_map +module Js_record_map = struct -#1 "js_map.ml" +#1 "js_record_map.ml" -open J -let [@inline] unknown : 'a. 'a -> 'a = fun x -> x -let [@inline] option sub = fun v -> - match v with - | None -> None - | Some v -> Some (sub v) -let rec list sub = fun v -> - match v with - | [] -> [] - | x::xs -> - let v = sub x in - v :: list sub xs - (* Note we need add [v] to enforce the evaluation order - it indeed cause different semantis here - *) -class map = object -((_self : 'self_type)) -method label : label -> label = unknown -method required_modules : required_modules -> required_modules = list (_self#module_id) -method ident : ident -> ident = unknown -method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} -method vident : vident -> vident = function + open J + let [@inline] unknown _ x = x + let option sub self = fun v -> + match v with + | None -> None + | Some v -> Some (sub self v) + let rec list sub self = fun x -> + match x with + | [] -> [] + | x::xs -> + let v = sub self x in + v ::list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> 'a + let super : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end ) ; + vident : vident fn = ( fun _self -> function | Id ( _x0) -> -let _x0 = _self#ident _x0 in -Id ( _x0) + begin let _x0 = _self.ident _self _x0 in Id ( _x0) end |Qualified ( _x0,_x1) -> -let _x0 = _self#module_id _x0 in -Qualified ( _x0,_x1) -method exception_ident : exception_ident -> exception_ident = _self#ident -method for_ident : for_ident -> for_ident = _self#ident -method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) -method length_object : length_object -> length_object = unknown -method expression_desc : expression_desc -> expression_desc = function + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin let _x1 = _self.expression _self _x1 in (_x0,_x1) end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function | Length ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#length_object _x1 in -Length ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.length_object _self _x1 in Length ( _x0,_x1) end |Char_of_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_of_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_of_int ( _x0) end |Char_to_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_to_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_to_int ( _x0) end |Is_null_or_undefined ( _x0) -> -let _x0 = _self#expression _x0 in -Is_null_or_undefined ( _x0) + begin let _x0 = _self.expression _self _x0 in Is_null_or_undefined ( _x0) end |String_append ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_append ( _x0,_x1) -|Bool _ as v -> v + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_append ( _x0,_x1) end +|Bool _ as v -> v |Typeof ( _x0) -> -let _x0 = _self#expression _x0 in -Typeof ( _x0) + begin let _x0 = _self.expression _self _x0 in Typeof ( _x0) end |Js_not ( _x0) -> -let _x0 = _self#expression _x0 in -Js_not ( _x0) + begin let _x0 = _self.expression _self _x0 in Js_not ( _x0) end |Seq ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Seq ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Seq ( _x0,_x1) end |Cond ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Cond ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Cond ( _x0,_x1,_x2) end |Bin ( _x0,_x1,_x2) -> -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Bin ( _x0,_x1,_x2) + begin let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Bin ( _x0,_x1,_x2) end |FlatCall ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -FlatCall ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in FlatCall ( _x0,_x1) end |Call ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#expression) _x1 in -Call ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.expression _self arg)) _self _x1 in Call ( _x0,_x1,_x2) end |String_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_index ( _x0,_x1) end |Array_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Array_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Array_index ( _x0,_x1) end |Static_index ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -Static_index ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in Static_index ( _x0,_x1,_x2) end |New ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = option (list (_self#expression)) _x1 in -New ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 in New ( _x0,_x1) end |Var ( _x0) -> -let _x0 = _self#vident _x0 in -Var ( _x0) + begin let _x0 = _self.vident _self _x0 in Var ( _x0) end |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = list (_self#ident) _x1 in -let _x2 = _self#block _x2 in -Fun ( _x0,_x1,_x2,_x3) -|Str _ as v -> v -|Unicode _ as v -> v -|Raw_js_code _ as v -> v + begin let _x1 = list ((fun _self arg -> _self.ident _self arg)) _self _x1 in +let _x2 = _self.block _self _x2 in Fun ( _x0,_x1,_x2,_x3) end +|Str _ as v -> v +|Unicode _ as v -> v +|Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = list (_self#expression) _x0 in -Array ( _x0,_x1) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in Array ( _x0,_x1) end |Optional_block ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -Optional_block ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in Optional_block ( _x0,_x1) end |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = list (_self#expression) _x0 in -let _x2 = _self#expression _x2 in -Caml_block ( _x0,_x1,_x2,_x3) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in +let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end |Caml_block_tag ( _x0) -> -let _x0 = _self#expression _x0 in -Caml_block_tag ( _x0) -|Number _ as v -> v + begin let _x0 = _self.expression _self _x0 in Caml_block_tag ( _x0) end +|Number _ as v -> v |Object ( _x0) -> -let _x0 = _self#property_map _x0 in -Object ( _x0) + begin let _x0 = _self.property_map _self _x0 in Object ( _x0) end |Undefined as v -> v -|Null as v -> v -method for_ident_expression : for_ident_expression -> for_ident_expression = _self#expression -method finish_ident_expression : finish_ident_expression -> finish_ident_expression = _self#expression -method statement_desc : statement_desc -> statement_desc = function +|Null as v -> v ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function | Block ( _x0) -> -let _x0 = _self#block _x0 in -Block ( _x0) + begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> -let _x0 = _self#variable_declaration _x0 in -Variable ( _x0) + begin let _x0 = _self.variable_declaration _self _x0 in Variable ( _x0) end |Exp ( _x0) -> -let _x0 = _self#expression _x0 in -Exp ( _x0) + begin let _x0 = _self.expression _self _x0 in Exp ( _x0) end |If ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#block _x1 in -let _x2 = _self#block _x2 in -If ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.block _self _x1 in +let _x2 = _self.block _self _x2 in If ( _x0,_x1,_x2) end |While ( _x0,_x1,_x2,_x3) -> -let _x0 = option (_self#label) _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#block _x2 in -While ( _x0,_x1,_x2,_x3) + begin let _x0 = option ((fun _self arg -> _self.label _self arg)) _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.block _self _x2 in While ( _x0,_x1,_x2,_x3) end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = option (_self#for_ident_expression) _x0 in -let _x1 = _self#finish_ident_expression _x1 in -let _x2 = _self#for_ident _x2 in -let _x3 = _self#for_direction _x3 in -let _x4 = _self#block _x4 in -ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) + begin let _x0 = option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0 in +let _x1 = _self.finish_ident_expression _self _x1 in +let _x2 = _self.for_ident _self _x2 in +let _x3 = _self.for_direction _self _x3 in +let _x4 = _self.block _self _x4 in ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) end |Continue ( _x0) -> -let _x0 = _self#label _x0 in -Continue ( _x0) + begin let _x0 = _self.label _self _x0 in Continue ( _x0) end |Break as v -> v |Return ( _x0) -> -let _x0 = _self#expression _x0 in -Return ( _x0) + begin let _x0 = _self.expression _self _x0 in Return ( _x0) end |Int_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#int_clause) _x1 in -let _x2 = option (_self#block) _x2 in -Int_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.int_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Int_switch ( _x0,_x1,_x2) end |String_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#string_clause) _x1 in -let _x2 = option (_self#block) _x2 in -String_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.string_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> -let _x0 = _self#expression _x0 in -Throw ( _x0) + begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end |Try ( _x0,_x1,_x2) -> -let _x0 = _self#block _x0 in -let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = option (_self#block) _x2 in -Try ( _x0,_x1,_x2) -|Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} -method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} -method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = list (_self#statement) -method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} -method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} -end - + begin let _x0 = _self.block _self _x0 in +let _x1 = option ((fun _self (_x0,_x1) -> begin let _x0 = _self.exception_ident _self _x0 in let _x1 = _self.block _self _x1 in (_x0,_x1) end)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Try ( _x0,_x1,_x2) end +|Debugger as v -> v ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = _self.expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = _self.statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin let _x0 = _self.ident _self _x0 in +let _x1 = option ((fun _self arg -> _self.expression _self arg)) _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin let _x0 = _self.block _self _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin let _x0 = _self.block _self _x0 in {block = _x0;exports = _x1;export_set = _x2} end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = _self.required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end ) + } + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -101634,20 +101658,19 @@ end = struct *) module E = Js_exp_make module S = Js_stmt_make - -let flatten_map = - object(self) - inherit Js_map.map as super - method! statement x = +let super = Js_record_map.super +let flatten_map = { super with + + statement = (fun self x -> match x.statement_desc with | Exp ({expression_desc = Seq _; _} as v) -> - S.block ( List.rev_map self#statement (Js_analyzer.rev_flatten_seq v )) + S.block ( List.rev_map (fun x -> self.statement self x) (Js_analyzer.rev_flatten_seq v )) | Exp {expression_desc = Caml_block (args, _mutable_flag, _tag, _tag_info )} -> - S.block (Ext_list.map args (fun arg -> self#statement (S.exp arg))) + S.block (Ext_list.map args (fun arg -> self.statement self (S.exp arg))) | Exp ({expression_desc = Cond(a,b,c); comment} ) -> - { statement_desc = If (a, [ self#statement (S.exp b)], - [ self#statement (S.exp c)]); comment} + { statement_desc = If (a, [ self.statement self (S.exp b)], + [ self.statement self (S.exp c)]); comment} | Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} ) -> @@ -101656,8 +101679,8 @@ let flatten_map = | {statement_desc = Exp last_one ; _} :: rest_rev -> S.block (Ext_list.rev_map_append rest_rev - [self#statement @@ S.exp (E.assign a last_one)] - self#statement + [self.statement self (S.exp (E.assign a last_one))] + (fun x -> self.statement self x) ) (* TODO: here we introduce a block, should avoid it *) (* super#statement *) @@ -101667,39 +101690,39 @@ let flatten_map = end | Return {expression_desc = Cond (a,b,c); comment} -> - { statement_desc = If (a, [self#statement (S.return_stmt b)], - [ self#statement (S.return_stmt c)]); comment} + { statement_desc = If (a, [self.statement self (S.return_stmt b)], + [ self.statement self (S.return_stmt c)]); comment} | Return ({expression_desc = Seq _; _} as v) -> let block = Js_analyzer.rev_flatten_seq v in begin match block with | {statement_desc = Exp last_one ; _} :: rest_rev -> - super#statement - (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (self#statement))) + super.statement self + (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (fun x -> self.statement self x))) | _ -> assert false end | Block [x] -> - self#statement x - | _ -> super#statement x - - method! block b = + self.statement self x + | _ -> super.statement self x + ); + block = fun self b -> match b with | {statement_desc = Block bs } :: rest -> - self#block ( bs @ rest) + self.block self ( bs @ rest) | x::rest -> - let st = self#statement x in - let block = self#block rest in + let st = self.statement self x in + let block = self.block self rest in begin match st.statement_desc with | Block bs -> bs @ block | _ -> st :: block end | [] -> [] - end +} -let program ( x : J.program) = flatten_map # program x +let program ( x : J.program) = flatten_map.program flatten_map x end module Js_pass_flatten_and_mark_dead : sig @@ -101782,35 +101805,35 @@ type meta_info = | Recursive +let super = Js_record_iter.iter let mark_dead_code (js : J.program) : J.program = let ident_use_stats : meta_info Hash_ident.t = Hash_ident.create 17 in - let mark_dead : Js_iter.iter = object (self) - inherit Js_iter.iter - method! ident ident = + let mark_dead = { super with + ident = (fun _ ident -> (match Hash_ident.find_opt ident_use_stats ident with | None -> (* First time *) Hash_ident.add ident_use_stats ident Recursive (* recursive identifiers *) | Some Recursive -> () - | Some (Info x) -> Js_op_util.update_used_stats x Used ) - method! variable_declaration vd = + | Some (Info x) -> Js_op_util.update_used_stats x Used )); + variable_declaration = fun self vd -> match vd.ident_info.used_stats with | Dead_pure -> () | Dead_non_pure -> begin match vd.value with | None -> () - | Some x -> self#expression x + | Some x -> self.expression self x end | _ -> let ({ident; ident_info ; value ; _} : J.variable_declaration) = vd in let pure = match value with | None -> true - | Some x -> (self#expression x); Js_analyzer.no_side_effect_expression x in + | Some x -> self.expression self x; Js_analyzer.no_side_effect_expression x in ( let () = if Set_ident.mem js.export_set ident then @@ -101830,8 +101853,8 @@ let mark_dead_code (js : J.program) : J.program = Hash_ident.add ident_use_stats ident (Info ident_info); Js_op_util.update_used_stats ident_info (if pure then Scanning_pure else Scanning_non_pure)) - end in - let () = (mark_dead#program js) in + } in + mark_dead.program mark_dead js; Hash_ident.iter ident_use_stats (fun _id (info : meta_info) -> match info with | Info ({used_stats = Scanning_pure} as info) -> @@ -101895,17 +101918,12 @@ let mark_dead_code (js : J.program) : J.program = ]} *) -let subst_map (substitution : J.expression Hash_ident.t) = object (self) - inherit Js_map.map as super - - - - - method add_substitue (ident : Ident.t) (e:J.expression) = +let super = Js_record_map.super +let add_substitue substitution (ident : Ident.t) (e:J.expression) = Hash_ident.replace substitution ident e - - method! statement v = +let subst_map (substitution : J.expression Hash_ident.t) = { super + with statement = (fun self v -> match v.statement_desc with | Variable ({ident = _; ident_info = {used_stats = Dead_pure } ; _}) -> {v with statement_desc = Block []} @@ -101936,7 +101954,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) bottomline, when the block size is one, no need to do this *) - let v' = self#expression x in + let v' = self.expression self x in let match_id = Ext_ident.create (ident.name ^ "_" ^ @@ -101955,7 +101973,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) expression_desc = Caml_block(List.rev e, Immutable, tag, tag_info) } in - let () = self#add_substitue ident e in + let () = add_substitue substitution ident e in (* let bindings = !bindings in *) let original_statement = { v with @@ -101971,9 +101989,9 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) (fun (id,v) -> S.define_variable ~kind:Strict id v) ) end - | _ -> super#statement v - - method! expression x = + | _ -> super.statement self v + ); + expression = fun self x -> match x.expression_desc with | Array_index ({expression_desc = Var (Id (id))}, {expression_desc = Number (Int {i; _})}) @@ -101989,11 +102007,11 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) | Some ({expression_desc = J.Var _ | Number _ | Str _ | Undefined} as x) -> x | None | Some _ -> - super#expression x ) - | Some _ | None -> super#expression x ) + super.expression self x ) + | Some _ | None -> super.expression self x ) - | _ -> super#expression x -end + | _ -> super.expression self x +} (* Top down or bottom up ?*) (* A pass to support nullary argument in JS @@ -102002,9 +102020,9 @@ end *) let program (js : J.program) = - js - |> (subst_map (Hash_ident.create 32) )#program - |> mark_dead_code + let obj = (subst_map (Hash_ident.create 32) ) in + let js = obj.program obj js in + mark_dead_code js (* |> mark_dead_code *) (* mark dead code twice does have effect in some cases, however, we disabled it since the benefit is not obvious @@ -102657,32 +102675,33 @@ let post_process_stats my_export_set (defined_idents : J.variable_declaration Ha since in this case it can not be global? *) +let super = Js_record_iter.iter let count_collects (* collect used status*) (stats : int Hash_ident.t) (* collect all def sites *) - (defined_idents : J.variable_declaration Hash_ident.t) : Js_iter.iter + (defined_idents : J.variable_declaration Hash_ident.t) = - object (self) - inherit Js_iter.iter - method! variable_declaration - ({ident; value ; property = _ ; ident_info = _} as v) - = + {super with + variable_declaration = (fun self + ({ident; value ; property = _ ; ident_info = _} as v) -> + Hash_ident.add defined_idents ident v; match value with | None -> () | Some x - -> self#expression x - method! ident id = add_use stats id - end + -> self.expression self x ); + ident = fun _ id -> add_use stats id + } let get_stats (program : J.program) : J.variable_declaration Hash_ident.t = let stats : int Hash_ident.t = Hash_ident.create 83 in let defined_idents : J.variable_declaration Hash_ident.t = Hash_ident.create 83 in - let my_export_set = program.export_set in - (count_collects stats defined_idents) #program program; + let my_export_set = program.export_set in + let obj = count_collects stats defined_idents in + obj.program obj program; post_process_stats my_export_set defined_idents stats end @@ -102778,13 +102797,12 @@ end = struct module S = Js_stmt_make (* module E = Js_exp_make *) +let super = Js_record_map.super +let substitue_variables (map : Ident.t Map_ident.t) = { + super with ident = fun _ id -> + Map_ident.find_default map id id -let substitue_variables (map : Ident.t Map_ident.t) = - object - inherit Js_map.map - method! ident id = - Map_ident.find_default map id id - end +} (* 1. recursive value ? let rec x = 1 :: x non-terminating @@ -102826,7 +102844,9 @@ let inline_call | _ -> map, S.define_variable ~kind:Variable param arg :: acc) in if Map_ident.is_empty map then block - else (substitue_variables map) # block block + else + let obj = substitue_variables map in + obj.block obj block (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -102853,10 +102873,10 @@ let inline_call (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, while it is still called *) -let subst (export_set : Set_ident.t) stats = - object (self) - inherit Js_map.map as super - method! statement st = +let super = Js_record_map.super +let subst (export_set : Set_ident.t) stats = {super with + + statement = (fun self st -> match st.statement_desc with | Variable {value = _ ; @@ -102868,18 +102888,17 @@ let subst (export_set : Set_ident.t) stats = | Variable { ident_info = {used_stats = Dead_non_pure} ; value = Some v ; _ } -> S.exp v - | _ -> super#statement st - method! variable_declaration - ({ident; value = _ ; property = _ ; ident_info = _} as v) - = + | _ -> super.statement self st ); + variable_declaration = (fun self + ({ident; value = _ ; property = _ ; ident_info = _} as v) -> (* TODO: replacement is a bit shaky, the problem is the lambda we stored is not consistent after we did some subsititution, and the dead code removal does rely on this (otherwise, when you do beta-reduction you have to regenerate names) *) - let v = super # variable_declaration v in + let v = super . variable_declaration self v in Hash_ident.add stats ident v; (* see #278 before changes *) - v - method! block bs = + v); + block = (fun self bs -> match bs with | ({statement_desc = Variable ({value = @@ -102887,17 +102906,17 @@ let subst (export_set : Set_ident.t) stats = } as vd) ; comment = _} as st) :: rest -> let is_export = Set_ident.mem export_set vd.ident in if is_export then - self#statement st :: self#block rest + self.statement self st :: self.block self rest else begin match Hash_ident.find_opt stats vd.ident with (* TODO: could be improved as [mem] *) | None -> if Js_analyzer.no_side_effect_expression v - then S.exp v :: self#block rest - else self#block rest + then S.exp v :: self.block self rest + else self.block self rest - | Some _ -> self#statement st :: self#block rest + | Some _ -> self.statement self st :: self.block self rest end | [{statement_desc = @@ -102920,7 +102939,7 @@ let subst (export_set : Set_ident.t) stats = -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -102931,7 +102950,7 @@ let subst (export_set : Set_ident.t) stats = *) | (None | Some _) -> - [self#statement st ] + [self.statement self st ] end | [{statement_desc = @@ -102941,22 +102960,23 @@ let subst (export_set : Set_ident.t) stats = when Ext_list.same_length params args -> let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks | x :: xs -> - self#statement x :: self#block xs + self.statement self x :: self.block self xs | [] -> [] - - end + ) +} let tailcall_inline (program : J.program) = let stats = Js_pass_get_used.get_stats program in let export_set = program.export_set in - (subst export_set stats )#program program + let obj = (subst export_set stats ) in + obj.program obj program diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml.d b/lib/4.06.1/unstable/js_refmt_compiler.ml.d index 9734cc6b03..2cf327a51d 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml.d +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml.d @@ -182,10 +182,8 @@ ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_fold_basic.mli ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_fun_env.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_fun_env.mli -../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_iter.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_long.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_long.mli -../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_map.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_name_of_module_id.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_name_of_module_id.mli ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_number.ml @@ -224,6 +222,8 @@ ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_pass_tailcall_inline.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_pass_tailcall_inline.mli ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_raw_info.ml +../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_record_iter.ml +../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_record_map.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_shake.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_shake.mli ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_stmt_make.ml diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 42c01bce44..b7cac15ec5 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -376380,130 +376380,6 @@ let property_key (s : J.property_name) : string = | Symbol_name -> {|[Symbol.for("name")]|} end -module Js_iter -= struct -#1 "js_iter.ml" - - open J - - let option sub v = - match v with - | None -> () - | Some v -> sub v - let rec list sub v = - match v with - | [] -> () - | x::xs -> sub x ; list sub xs - class iter = object (_self : 'self_type) - method label : label -> unit = ignore -method required_modules : required_modules -> unit = (list _self#module_id) -method ident : ident -> unit = ignore -method module_id : module_id -> unit = fun { id = _x0;kind = _x1} -> begin _self#ident _x0 end -method vident : vident -> unit = function -| Id ( _x0) -> - begin _self#ident _x0 end -|Qualified ( _x0,_x1) -> - begin _self#module_id _x0 end -method exception_ident : exception_ident -> unit = _self#ident -method for_ident : for_ident -> unit = _self#ident -method for_direction : for_direction -> unit = ignore -method property_map : property_map -> unit = (list (fun ( _x0,_x1) -> begin _self#expression _x1 end)) -method length_object : length_object -> unit = ignore -method expression_desc : expression_desc -> unit = function -| Length ( _x0,_x1) -> - begin _self#expression _x0;_self#length_object _x1 end -|Char_of_int ( _x0) -> - begin _self#expression _x0 end -|Char_to_int ( _x0) -> - begin _self#expression _x0 end -|Is_null_or_undefined ( _x0) -> - begin _self#expression _x0 end -|String_append ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Bool _ -> () -|Typeof ( _x0) -> - begin _self#expression _x0 end -|Js_not ( _x0) -> - begin _self#expression _x0 end -|Seq ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Cond ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#expression _x1;_self#expression _x2 end -|Bin ( _x0,_x1,_x2) -> - begin _self#expression _x1;_self#expression _x2 end -|FlatCall ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Call ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#expression) _x1 end -|String_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Array_index ( _x0,_x1) -> - begin _self#expression _x0;_self#expression _x1 end -|Static_index ( _x0,_x1,_x2) -> - begin _self#expression _x0 end -|New ( _x0,_x1) -> - begin _self#expression _x0;(option (list _self#expression)) _x1 end -|Var ( _x0) -> - begin _self#vident _x0 end -|Fun ( _x0,_x1,_x2,_x3) -> - begin (list _self#ident) _x1;_self#block _x2 end -|Str _ -> () -|Unicode _ -> () -|Raw_js_code _ -> () -|Array ( _x0,_x1) -> - begin (list _self#expression) _x0 end -|Optional_block ( _x0,_x1) -> - begin _self#expression _x0 end -|Caml_block ( _x0,_x1,_x2,_x3) -> - begin (list _self#expression) _x0;_self#expression _x2 end -|Caml_block_tag ( _x0) -> - begin _self#expression _x0 end -|Number _ -> () -|Object ( _x0) -> - begin _self#property_map _x0 end -|Undefined -> () -|Null -> () -method for_ident_expression : for_ident_expression -> unit = _self#expression -method finish_ident_expression : finish_ident_expression -> unit = _self#expression -method statement_desc : statement_desc -> unit = function -| Block ( _x0) -> - begin _self#block _x0 end -|Variable ( _x0) -> - begin _self#variable_declaration _x0 end -|Exp ( _x0) -> - begin _self#expression _x0 end -|If ( _x0,_x1,_x2) -> - begin _self#expression _x0;_self#block _x1;_self#block _x2 end -|While ( _x0,_x1,_x2,_x3) -> - begin (option _self#label) _x0;_self#expression _x1;_self#block _x2 end -|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin (option _self#for_ident_expression) _x0;_self#finish_ident_expression _x1;_self#for_ident _x2;_self#for_direction _x3;_self#block _x4 end -|Continue ( _x0) -> - begin _self#label _x0 end -|Break -> () -|Return ( _x0) -> - begin _self#expression _x0 end -|Int_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#int_clause) _x1;(option _self#block) _x2 end -|String_switch ( _x0,_x1,_x2) -> - begin _self#expression _x0;(list _self#string_clause) _x1;(option _self#block) _x2 end -|Throw ( _x0) -> - begin _self#expression _x0 end -|Try ( _x0,_x1,_x2) -> - begin _self#block _x0;(option (fun ( _x0,_x1) -> begin _self#exception_ident _x0;_self#block _x1 end)) _x1;(option _self#block) _x2 end -|Debugger -> () -method expression : expression -> unit = fun { expression_desc = _x0;comment = _x1} -> begin _self#expression_desc _x0 end -method statement : statement -> unit = fun { statement_desc = _x0;comment = _x1} -> begin _self#statement_desc _x0 end -method variable_declaration : variable_declaration -> unit = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self#ident _x0;(option _self#expression) _x1 end -method string_clause : string_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method int_clause : int_clause -> unit = (fun ( _x0,_x1) -> begin _self#case_clause _x1 end) -method case_clause : case_clause -> unit = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self#block _x0 end -method block : block -> unit = (list _self#statement) -method program : program -> unit = fun { block = _x0;exports = _x1;export_set = _x2} -> begin _self#block _x0 end -method deps_program : deps_program -> unit = fun { program = _x0;modules = _x1;side_effect = _x2} -> begin _self#program _x0;_self#required_modules _x1 end - end - -end module Js_op_util : sig #1 "js_op_util.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -376706,6 +376582,159 @@ let of_lam_mutable_flag (x : Asttypes.mutable_flag) : Js_op.mutable_flag = | Immutable -> Immutable | Mutable -> Mutable +end +module Js_record_iter += struct +#1 "js_record_iter.ml" + + open J + let unknown _ _ = () + let option sub self = fun v -> + match v with + | None -> () + | Some v -> sub self v + let rec list sub self = fun x -> + match x with + | [] -> () + | x::xs -> + sub self x ; + list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> unit + let iter : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end ) ; + vident : vident fn = ( fun _self -> function +| Id ( _x0) -> + begin _self.ident _self _x0 end +|Qualified ( _x0,_x1) -> + begin _self.module_id _self _x0 end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function +| Length ( _x0,_x1) -> + begin _self.expression _self _x0;_self.length_object _self _x1 end +|Char_of_int ( _x0) -> + begin _self.expression _self _x0 end +|Char_to_int ( _x0) -> + begin _self.expression _self _x0 end +|Is_null_or_undefined ( _x0) -> + begin _self.expression _self _x0 end +|String_append ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Bool _ -> () +|Typeof ( _x0) -> + begin _self.expression _self _x0 end +|Js_not ( _x0) -> + begin _self.expression _self _x0 end +|Seq ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Cond ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.expression _self _x1;_self.expression _self _x2 end +|Bin ( _x0,_x1,_x2) -> + begin _self.expression _self _x1;_self.expression _self _x2 end +|FlatCall ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Call ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.expression _self arg)) _self _x1 end +|String_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Array_index ( _x0,_x1) -> + begin _self.expression _self _x0;_self.expression _self _x1 end +|Static_index ( _x0,_x1,_x2) -> + begin _self.expression _self _x0 end +|New ( _x0,_x1) -> + begin _self.expression _self _x0;option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 end +|Var ( _x0) -> + begin _self.vident _self _x0 end +|Fun ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.ident _self arg)) _self _x1;_self.block _self _x2 end +|Str _ -> () +|Unicode _ -> () +|Raw_js_code _ -> () +|Array ( _x0,_x1) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0 end +|Optional_block ( _x0,_x1) -> + begin _self.expression _self _x0 end +|Caml_block ( _x0,_x1,_x2,_x3) -> + begin list ((fun _self arg -> _self.expression _self arg)) _self _x0;_self.expression _self _x2 end +|Caml_block_tag ( _x0) -> + begin _self.expression _self _x0 end +|Number _ -> () +|Object ( _x0) -> + begin _self.property_map _self _x0 end +|Undefined -> () +|Null -> () ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function +| Block ( _x0) -> + begin _self.block _self _x0 end +|Variable ( _x0) -> + begin _self.variable_declaration _self _x0 end +|Exp ( _x0) -> + begin _self.expression _self _x0 end +|If ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;_self.block _self _x1;_self.block _self _x2 end +|While ( _x0,_x1,_x2,_x3) -> + begin option ((fun _self arg -> _self.label _self arg)) _self _x0;_self.expression _self _x1;_self.block _self _x2 end +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + begin option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end +|Continue ( _x0) -> + begin _self.label _self _x0 end +|Break -> () +|Return ( _x0) -> + begin _self.expression _self _x0 end +|Int_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.int_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|String_switch ( _x0,_x1,_x2) -> + begin _self.expression _self _x0;list ((fun _self arg -> _self.string_clause _self arg)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Throw ( _x0) -> + begin _self.expression _self _x0 end +|Try ( _x0,_x1,_x2) -> + begin _self.block _self _x0;option ((fun _self (_x0,_x1) -> begin _self.exception_ident _self _x0;_self.block _self _x1 end)) _self _x1;option ((fun _self arg -> _self.block _self arg)) _self _x2 end +|Debugger -> () ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin _self.expression_desc _self _x0 end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin _self.statement_desc _self _x0 end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option ((fun _self arg -> _self.expression _self arg)) _self _x1 end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin _self.case_clause _self _x1 end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;_self.required_modules _self _x1 end ) + } + end module Js_analyzer : sig #1 "js_analyzer.mli" @@ -376846,47 +376875,51 @@ let add_defined_idents (x : idents_stats) ident = Note such shaking is done in the toplevel, so that it requires us to flatten the statement first *) -let free_variables (stats : idents_stats) : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! variable_declaration st = - add_defined_idents stats st.ident; - match st.value with - | None - -> () - | Some v - -> - self # expression v - method! ident id = - (if not (Set_ident.mem stats.defined_idents id )then - stats.used_idents <- Set_ident.add stats.used_idents id) - - method! expression exp = - match exp.expression_desc with - | Fun(_, _,_, env) - (** a optimization to avoid walking into funciton again - if it's already comuted - *) - -> - stats.used_idents <- - Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents +let super = Js_record_iter.iter +let free_variables (stats : idents_stats) = { + super with + variable_declaration = begin fun self st -> + add_defined_idents stats st.ident; + match st.value with + | None + -> () + | Some v + -> + self.expression self v + end; + ident = begin fun _ id -> + if not (Set_ident.mem stats.defined_idents id )then + stats.used_idents <- Set_ident.add stats.used_idents id + end; + expression = begin fun self exp -> + match exp.expression_desc with + | Fun(_, _,_, env) + (** a optimization to avoid walking into funciton again + if it's already comuted + *) + -> + stats.used_idents <- + Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents + | _ + -> + super.expression self exp + end +} - | _ - -> - super#expression exp - end let free_variables_of_statement st = let init = {used_idents = Set_ident.empty; - defined_idents = Set_ident.empty} in - let _ = (free_variables init)#statement st in + defined_idents = Set_ident.empty} in + let obj = free_variables init in + obj.statement obj st ; Set_ident.diff init.used_idents init.defined_idents let free_variables_of_expression st = let init = {used_idents = Set_ident.empty; defined_idents = Set_ident.empty} in - let _ = (free_variables init)#expression st in + let obj = free_variables init in + obj.expression obj st ; Set_ident.diff init.used_idents init.defined_idents let rec no_side_effect_expression_desc (x : J.expression_desc) = @@ -376941,10 +376974,10 @@ and no_side_effect (x : J.expression) = let no_side_effect_expression (x : J.expression) = no_side_effect x -let no_side_effect_obj : Js_iter.iter = - object (self) - inherit Js_iter.iter as super - method! statement s = +let super = Js_record_iter.iter +let no_side_effect_obj = + {super with + statement = (fun self s -> match s.statement_desc with | Throw _ | Debugger @@ -376952,15 +376985,15 @@ let no_side_effect_obj : Js_iter.iter = | Variable _ | Continue _ -> raise_notrace Not_found - | Exp e -> self#expression e + | Exp e -> self.expression self e | Int_switch _ | String_switch _ | ForRange _ - | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s - method! expression s = + | If _ | While _ | Block _ | Return _ | Try _ -> super.statement self s ); + expression = begin fun _ s -> if not (no_side_effect_expression s) then raise_notrace Not_found - end + end} let no_side_effect_statement st = try - no_side_effect_obj#statement st; true + no_side_effect_obj.statement no_side_effect_obj st; true with _ -> false @@ -381627,25 +381660,30 @@ end = struct let add_lam_module_ident = Lam_module_ident.Hash_set.add let create = Lam_module_ident.Hash_set.create -let count_hard_dependencies hard_dependencies = - object - inherit Js_iter.iter as super - method! module_id vid = - add_lam_module_ident hard_dependencies vid - method! expression x = - (* check {!Js_pass_scope} when making changes *) + +let super = Js_record_iter.iter +let count_hard_dependencies hard_dependencies = { + super with + module_id = begin + fun _ vid -> + add_lam_module_ident hard_dependencies vid + end; + expression = begin + fun self x -> (match Js_block_runtime.check_additional_id x with | Some id -> add_lam_module_ident hard_dependencies (Lam_module_ident.of_runtime id) | _ -> ()); - super#expression x - end + super.expression self x + end +} let calculate_hard_dependencies block = let hard_dependencies = create 17 in - (count_hard_dependencies hard_dependencies)#block block ; + let obj = (count_hard_dependencies hard_dependencies) in + obj.block obj block ; hard_dependencies (* @@ -383846,201 +383884,187 @@ end = struct end -module Js_map +module Js_record_map = struct -#1 "js_map.ml" +#1 "js_record_map.ml" -open J -let [@inline] unknown : 'a. 'a -> 'a = fun x -> x -let [@inline] option sub = fun v -> - match v with - | None -> None - | Some v -> Some (sub v) -let rec list sub = fun v -> - match v with - | [] -> [] - | x::xs -> - let v = sub x in - v :: list sub xs - (* Note we need add [v] to enforce the evaluation order - it indeed cause different semantis here - *) -class map = object -((_self : 'self_type)) -method label : label -> label = unknown -method required_modules : required_modules -> required_modules = list (_self#module_id) -method ident : ident -> ident = unknown -method module_id : module_id -> module_id = fun { id = _x0;kind = _x1} -> let _x0 = _self#ident _x0 in {id = _x0;kind = _x1} -method vident : vident -> vident = function + open J + let [@inline] unknown _ x = x + let option sub self = fun v -> + match v with + | None -> None + | Some v -> Some (sub self v) + let rec list sub self = fun x -> + match x with + | [] -> [] + | x::xs -> + let v = sub self x in + v ::list sub self xs + + type iter = { + label : label fn; +required_modules : required_modules fn; +ident : ident fn; +module_id : module_id fn; +vident : vident fn; +exception_ident : exception_ident fn; +for_ident : for_ident fn; +for_direction : for_direction fn; +property_map : property_map fn; +length_object : length_object fn; +expression_desc : expression_desc fn; +for_ident_expression : for_ident_expression fn; +finish_ident_expression : finish_ident_expression fn; +statement_desc : statement_desc fn; +expression : expression fn; +statement : statement fn; +variable_declaration : variable_declaration fn; +string_clause : string_clause fn; +int_clause : int_clause fn; +case_clause : case_clause fn; +block : block fn; +program : program fn; +deps_program : deps_program fn + } + and 'a fn = iter -> 'a -> 'a + let super : iter = { + label : label fn = ( unknown ) ; + required_modules : required_modules fn = ( fun _self arg -> list ((fun _self arg -> _self.module_id _self arg)) _self arg ) ; + ident : ident fn = ( unknown ) ; + module_id : module_id fn = ( fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end ) ; + vident : vident fn = ( fun _self -> function | Id ( _x0) -> -let _x0 = _self#ident _x0 in -Id ( _x0) + begin let _x0 = _self.ident _self _x0 in Id ( _x0) end |Qualified ( _x0,_x1) -> -let _x0 = _self#module_id _x0 in -Qualified ( _x0,_x1) -method exception_ident : exception_ident -> exception_ident = _self#ident -method for_ident : for_ident -> for_ident = _self#ident -method for_direction : for_direction -> for_direction = unknown -method property_map : property_map -> property_map = list (fun ( _x0,_x1) -> let _x1 = _self#expression _x1 in _x0,_x1) -method length_object : length_object -> length_object = unknown -method expression_desc : expression_desc -> expression_desc = function + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end ) ; + exception_ident : exception_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_ident : for_ident fn = ( (fun _self arg -> _self.ident _self arg) ) ; + for_direction : for_direction fn = ( unknown ) ; + property_map : property_map fn = ( fun _self arg -> list ((fun _self (_x0,_x1) -> begin let _x1 = _self.expression _self _x1 in (_x0,_x1) end)) _self arg ) ; + length_object : length_object fn = ( unknown ) ; + expression_desc : expression_desc fn = ( fun _self -> function | Length ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#length_object _x1 in -Length ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.length_object _self _x1 in Length ( _x0,_x1) end |Char_of_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_of_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_of_int ( _x0) end |Char_to_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_to_int ( _x0) + begin let _x0 = _self.expression _self _x0 in Char_to_int ( _x0) end |Is_null_or_undefined ( _x0) -> -let _x0 = _self#expression _x0 in -Is_null_or_undefined ( _x0) + begin let _x0 = _self.expression _self _x0 in Is_null_or_undefined ( _x0) end |String_append ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_append ( _x0,_x1) -|Bool _ as v -> v + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_append ( _x0,_x1) end +|Bool _ as v -> v |Typeof ( _x0) -> -let _x0 = _self#expression _x0 in -Typeof ( _x0) + begin let _x0 = _self.expression _self _x0 in Typeof ( _x0) end |Js_not ( _x0) -> -let _x0 = _self#expression _x0 in -Js_not ( _x0) + begin let _x0 = _self.expression _self _x0 in Js_not ( _x0) end |Seq ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Seq ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Seq ( _x0,_x1) end |Cond ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Cond ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Cond ( _x0,_x1,_x2) end |Bin ( _x0,_x1,_x2) -> -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Bin ( _x0,_x1,_x2) + begin let _x1 = _self.expression _self _x1 in +let _x2 = _self.expression _self _x2 in Bin ( _x0,_x1,_x2) end |FlatCall ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -FlatCall ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in FlatCall ( _x0,_x1) end |Call ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#expression) _x1 in -Call ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.expression _self arg)) _self _x1 in Call ( _x0,_x1,_x2) end |String_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in String_index ( _x0,_x1) end |Array_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Array_index ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.expression _self _x1 in Array_index ( _x0,_x1) end |Static_index ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -Static_index ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in Static_index ( _x0,_x1,_x2) end |New ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = option (list (_self#expression)) _x1 in -New ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in +let _x1 = option (fun _self arg -> list ((fun _self arg -> _self.expression _self arg)) _self arg) _self _x1 in New ( _x0,_x1) end |Var ( _x0) -> -let _x0 = _self#vident _x0 in -Var ( _x0) + begin let _x0 = _self.vident _self _x0 in Var ( _x0) end |Fun ( _x0,_x1,_x2,_x3) -> -let _x1 = list (_self#ident) _x1 in -let _x2 = _self#block _x2 in -Fun ( _x0,_x1,_x2,_x3) -|Str _ as v -> v -|Unicode _ as v -> v -|Raw_js_code _ as v -> v + begin let _x1 = list ((fun _self arg -> _self.ident _self arg)) _self _x1 in +let _x2 = _self.block _self _x2 in Fun ( _x0,_x1,_x2,_x3) end +|Str _ as v -> v +|Unicode _ as v -> v +|Raw_js_code _ as v -> v |Array ( _x0,_x1) -> -let _x0 = list (_self#expression) _x0 in -Array ( _x0,_x1) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in Array ( _x0,_x1) end |Optional_block ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -Optional_block ( _x0,_x1) + begin let _x0 = _self.expression _self _x0 in Optional_block ( _x0,_x1) end |Caml_block ( _x0,_x1,_x2,_x3) -> -let _x0 = list (_self#expression) _x0 in -let _x2 = _self#expression _x2 in -Caml_block ( _x0,_x1,_x2,_x3) + begin let _x0 = list ((fun _self arg -> _self.expression _self arg)) _self _x0 in +let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end |Caml_block_tag ( _x0) -> -let _x0 = _self#expression _x0 in -Caml_block_tag ( _x0) -|Number _ as v -> v + begin let _x0 = _self.expression _self _x0 in Caml_block_tag ( _x0) end +|Number _ as v -> v |Object ( _x0) -> -let _x0 = _self#property_map _x0 in -Object ( _x0) + begin let _x0 = _self.property_map _self _x0 in Object ( _x0) end |Undefined as v -> v -|Null as v -> v -method for_ident_expression : for_ident_expression -> for_ident_expression = _self#expression -method finish_ident_expression : finish_ident_expression -> finish_ident_expression = _self#expression -method statement_desc : statement_desc -> statement_desc = function +|Null as v -> v ) ; + for_ident_expression : for_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + finish_ident_expression : finish_ident_expression fn = ( (fun _self arg -> _self.expression _self arg) ) ; + statement_desc : statement_desc fn = ( fun _self -> function | Block ( _x0) -> -let _x0 = _self#block _x0 in -Block ( _x0) + begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> -let _x0 = _self#variable_declaration _x0 in -Variable ( _x0) + begin let _x0 = _self.variable_declaration _self _x0 in Variable ( _x0) end |Exp ( _x0) -> -let _x0 = _self#expression _x0 in -Exp ( _x0) + begin let _x0 = _self.expression _self _x0 in Exp ( _x0) end |If ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#block _x1 in -let _x2 = _self#block _x2 in -If ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = _self.block _self _x1 in +let _x2 = _self.block _self _x2 in If ( _x0,_x1,_x2) end |While ( _x0,_x1,_x2,_x3) -> -let _x0 = option (_self#label) _x0 in -let _x1 = _self#expression _x1 in -let _x2 = _self#block _x2 in -While ( _x0,_x1,_x2,_x3) + begin let _x0 = option ((fun _self arg -> _self.label _self arg)) _self _x0 in +let _x1 = _self.expression _self _x1 in +let _x2 = _self.block _self _x2 in While ( _x0,_x1,_x2,_x3) end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -let _x0 = option (_self#for_ident_expression) _x0 in -let _x1 = _self#finish_ident_expression _x1 in -let _x2 = _self#for_ident _x2 in -let _x3 = _self#for_direction _x3 in -let _x4 = _self#block _x4 in -ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) + begin let _x0 = option ((fun _self arg -> _self.for_ident_expression _self arg)) _self _x0 in +let _x1 = _self.finish_ident_expression _self _x1 in +let _x2 = _self.for_ident _self _x2 in +let _x3 = _self.for_direction _self _x3 in +let _x4 = _self.block _self _x4 in ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) end |Continue ( _x0) -> -let _x0 = _self#label _x0 in -Continue ( _x0) + begin let _x0 = _self.label _self _x0 in Continue ( _x0) end |Break as v -> v |Return ( _x0) -> -let _x0 = _self#expression _x0 in -Return ( _x0) + begin let _x0 = _self.expression _self _x0 in Return ( _x0) end |Int_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#int_clause) _x1 in -let _x2 = option (_self#block) _x2 in -Int_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.int_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Int_switch ( _x0,_x1,_x2) end |String_switch ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#string_clause) _x1 in -let _x2 = option (_self#block) _x2 in -String_switch ( _x0,_x1,_x2) + begin let _x0 = _self.expression _self _x0 in +let _x1 = list ((fun _self arg -> _self.string_clause _self arg)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> -let _x0 = _self#expression _x0 in -Throw ( _x0) + begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end |Try ( _x0,_x1,_x2) -> -let _x0 = _self#block _x0 in -let _x1 = option (fun ( _x0,_x1) -> let _x0 = _self#exception_ident _x0 in let _x1 = _self#block _x1 in _x0,_x1) _x1 in -let _x2 = option (_self#block) _x2 in -Try ( _x0,_x1,_x2) -|Debugger as v -> v -method expression : expression -> expression = fun { expression_desc = _x0;comment = _x1} -> let _x0 = _self#expression_desc _x0 in {expression_desc = _x0;comment = _x1} -method statement : statement -> statement = fun { statement_desc = _x0;comment = _x1} -> let _x0 = _self#statement_desc _x0 in {statement_desc = _x0;comment = _x1} -method variable_declaration : variable_declaration -> variable_declaration = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _x0 = _self#ident _x0 in -let _x1 = option (_self#expression) _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} -method string_clause : string_clause -> string_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method int_clause : int_clause -> int_clause = fun ( _x0,_x1) -> let _x1 = _self#case_clause _x1 in _x0,_x1 -method case_clause : case_clause -> case_clause = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _x0 = _self#block _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} -method block : block -> block = list (_self#statement) -method program : program -> program = fun { block = _x0;exports = _x1;export_set = _x2} -> let _x0 = _self#block _x0 in {block = _x0;exports = _x1;export_set = _x2} -method deps_program : deps_program -> deps_program = fun { program = _x0;modules = _x1;side_effect = _x2} -> let _x0 = _self#program _x0 in -let _x1 = _self#required_modules _x1 in {program = _x0;modules = _x1;side_effect = _x2} -end - + begin let _x0 = _self.block _self _x0 in +let _x1 = option ((fun _self (_x0,_x1) -> begin let _x0 = _self.exception_ident _self _x0 in let _x1 = _self.block _self _x1 in (_x0,_x1) end)) _self _x1 in +let _x2 = option ((fun _self arg -> _self.block _self arg)) _self _x2 in Try ( _x0,_x1,_x2) end +|Debugger as v -> v ) ; + expression : expression fn = ( fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = _self.expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end ) ; + statement : statement fn = ( fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = _self.statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end ) ; + variable_declaration : variable_declaration fn = ( fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin let _x0 = _self.ident _self _x0 in +let _x1 = option ((fun _self arg -> _self.expression _self arg)) _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end ) ; + string_clause : string_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + int_clause : int_clause fn = ( (fun _self (_x0,_x1) -> begin let _x1 = _self.case_clause _self _x1 in (_x0,_x1) end) ) ; + case_clause : case_clause fn = ( fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin let _x0 = _self.block _self _x0 in {switch_body = _x0;should_break = _x1;comment = _x2} end ) ; + block : block fn = ( fun _self arg -> list ((fun _self arg -> _self.statement _self arg)) _self arg ) ; + program : program fn = ( fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin let _x0 = _self.block _self _x0 in {block = _x0;exports = _x1;export_set = _x2} end ) ; + deps_program : deps_program fn = ( fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = _self.required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end ) + } + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -384128,20 +384152,19 @@ end = struct *) module E = Js_exp_make module S = Js_stmt_make - -let flatten_map = - object(self) - inherit Js_map.map as super - method! statement x = +let super = Js_record_map.super +let flatten_map = { super with + + statement = (fun self x -> match x.statement_desc with | Exp ({expression_desc = Seq _; _} as v) -> - S.block ( List.rev_map self#statement (Js_analyzer.rev_flatten_seq v )) + S.block ( List.rev_map (fun x -> self.statement self x) (Js_analyzer.rev_flatten_seq v )) | Exp {expression_desc = Caml_block (args, _mutable_flag, _tag, _tag_info )} -> - S.block (Ext_list.map args (fun arg -> self#statement (S.exp arg))) + S.block (Ext_list.map args (fun arg -> self.statement self (S.exp arg))) | Exp ({expression_desc = Cond(a,b,c); comment} ) -> - { statement_desc = If (a, [ self#statement (S.exp b)], - [ self#statement (S.exp c)]); comment} + { statement_desc = If (a, [ self.statement self (S.exp b)], + [ self.statement self (S.exp c)]); comment} | Exp ({expression_desc = Bin(Eq, a, ({expression_desc = Seq _; _ } as v)); _} ) -> @@ -384150,8 +384173,8 @@ let flatten_map = | {statement_desc = Exp last_one ; _} :: rest_rev -> S.block (Ext_list.rev_map_append rest_rev - [self#statement @@ S.exp (E.assign a last_one)] - self#statement + [self.statement self (S.exp (E.assign a last_one))] + (fun x -> self.statement self x) ) (* TODO: here we introduce a block, should avoid it *) (* super#statement *) @@ -384161,39 +384184,39 @@ let flatten_map = end | Return {expression_desc = Cond (a,b,c); comment} -> - { statement_desc = If (a, [self#statement (S.return_stmt b)], - [ self#statement (S.return_stmt c)]); comment} + { statement_desc = If (a, [self.statement self (S.return_stmt b)], + [ self.statement self (S.return_stmt c)]); comment} | Return ({expression_desc = Seq _; _} as v) -> let block = Js_analyzer.rev_flatten_seq v in begin match block with | {statement_desc = Exp last_one ; _} :: rest_rev -> - super#statement - (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (self#statement))) + super.statement self + (S.block (Ext_list.rev_map_append rest_rev [S.return_stmt last_one] (fun x -> self.statement self x))) | _ -> assert false end | Block [x] -> - self#statement x - | _ -> super#statement x - - method! block b = + self.statement self x + | _ -> super.statement self x + ); + block = fun self b -> match b with | {statement_desc = Block bs } :: rest -> - self#block ( bs @ rest) + self.block self ( bs @ rest) | x::rest -> - let st = self#statement x in - let block = self#block rest in + let st = self.statement self x in + let block = self.block self rest in begin match st.statement_desc with | Block bs -> bs @ block | _ -> st :: block end | [] -> [] - end +} -let program ( x : J.program) = flatten_map # program x +let program ( x : J.program) = flatten_map.program flatten_map x end module Js_pass_flatten_and_mark_dead : sig @@ -384276,35 +384299,35 @@ type meta_info = | Recursive +let super = Js_record_iter.iter let mark_dead_code (js : J.program) : J.program = let ident_use_stats : meta_info Hash_ident.t = Hash_ident.create 17 in - let mark_dead : Js_iter.iter = object (self) - inherit Js_iter.iter - method! ident ident = + let mark_dead = { super with + ident = (fun _ ident -> (match Hash_ident.find_opt ident_use_stats ident with | None -> (* First time *) Hash_ident.add ident_use_stats ident Recursive (* recursive identifiers *) | Some Recursive -> () - | Some (Info x) -> Js_op_util.update_used_stats x Used ) - method! variable_declaration vd = + | Some (Info x) -> Js_op_util.update_used_stats x Used )); + variable_declaration = fun self vd -> match vd.ident_info.used_stats with | Dead_pure -> () | Dead_non_pure -> begin match vd.value with | None -> () - | Some x -> self#expression x + | Some x -> self.expression self x end | _ -> let ({ident; ident_info ; value ; _} : J.variable_declaration) = vd in let pure = match value with | None -> true - | Some x -> (self#expression x); Js_analyzer.no_side_effect_expression x in + | Some x -> self.expression self x; Js_analyzer.no_side_effect_expression x in ( let () = if Set_ident.mem js.export_set ident then @@ -384324,8 +384347,8 @@ let mark_dead_code (js : J.program) : J.program = Hash_ident.add ident_use_stats ident (Info ident_info); Js_op_util.update_used_stats ident_info (if pure then Scanning_pure else Scanning_non_pure)) - end in - let () = (mark_dead#program js) in + } in + mark_dead.program mark_dead js; Hash_ident.iter ident_use_stats (fun _id (info : meta_info) -> match info with | Info ({used_stats = Scanning_pure} as info) -> @@ -384389,17 +384412,12 @@ let mark_dead_code (js : J.program) : J.program = ]} *) -let subst_map (substitution : J.expression Hash_ident.t) = object (self) - inherit Js_map.map as super - - - - - method add_substitue (ident : Ident.t) (e:J.expression) = +let super = Js_record_map.super +let add_substitue substitution (ident : Ident.t) (e:J.expression) = Hash_ident.replace substitution ident e - - method! statement v = +let subst_map (substitution : J.expression Hash_ident.t) = { super + with statement = (fun self v -> match v.statement_desc with | Variable ({ident = _; ident_info = {used_stats = Dead_pure } ; _}) -> {v with statement_desc = Block []} @@ -384430,7 +384448,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) bottomline, when the block size is one, no need to do this *) - let v' = self#expression x in + let v' = self.expression self x in let match_id = Ext_ident.create (ident.name ^ "_" ^ @@ -384449,7 +384467,7 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) expression_desc = Caml_block(List.rev e, Immutable, tag, tag_info) } in - let () = self#add_substitue ident e in + let () = add_substitue substitution ident e in (* let bindings = !bindings in *) let original_statement = { v with @@ -384465,9 +384483,9 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) (fun (id,v) -> S.define_variable ~kind:Strict id v) ) end - | _ -> super#statement v - - method! expression x = + | _ -> super.statement self v + ); + expression = fun self x -> match x.expression_desc with | Array_index ({expression_desc = Var (Id (id))}, {expression_desc = Number (Int {i; _})}) @@ -384483,11 +384501,11 @@ let subst_map (substitution : J.expression Hash_ident.t) = object (self) | Some ({expression_desc = J.Var _ | Number _ | Str _ | Undefined} as x) -> x | None | Some _ -> - super#expression x ) - | Some _ | None -> super#expression x ) + super.expression self x ) + | Some _ | None -> super.expression self x ) - | _ -> super#expression x -end + | _ -> super.expression self x +} (* Top down or bottom up ?*) (* A pass to support nullary argument in JS @@ -384496,9 +384514,9 @@ end *) let program (js : J.program) = - js - |> (subst_map (Hash_ident.create 32) )#program - |> mark_dead_code + let obj = (subst_map (Hash_ident.create 32) ) in + let js = obj.program obj js in + mark_dead_code js (* |> mark_dead_code *) (* mark dead code twice does have effect in some cases, however, we disabled it since the benefit is not obvious @@ -385151,32 +385169,33 @@ let post_process_stats my_export_set (defined_idents : J.variable_declaration Ha since in this case it can not be global? *) +let super = Js_record_iter.iter let count_collects (* collect used status*) (stats : int Hash_ident.t) (* collect all def sites *) - (defined_idents : J.variable_declaration Hash_ident.t) : Js_iter.iter + (defined_idents : J.variable_declaration Hash_ident.t) = - object (self) - inherit Js_iter.iter - method! variable_declaration - ({ident; value ; property = _ ; ident_info = _} as v) - = + {super with + variable_declaration = (fun self + ({ident; value ; property = _ ; ident_info = _} as v) -> + Hash_ident.add defined_idents ident v; match value with | None -> () | Some x - -> self#expression x - method! ident id = add_use stats id - end + -> self.expression self x ); + ident = fun _ id -> add_use stats id + } let get_stats (program : J.program) : J.variable_declaration Hash_ident.t = let stats : int Hash_ident.t = Hash_ident.create 83 in let defined_idents : J.variable_declaration Hash_ident.t = Hash_ident.create 83 in - let my_export_set = program.export_set in - (count_collects stats defined_idents) #program program; + let my_export_set = program.export_set in + let obj = count_collects stats defined_idents in + obj.program obj program; post_process_stats my_export_set defined_idents stats end @@ -385272,13 +385291,12 @@ end = struct module S = Js_stmt_make (* module E = Js_exp_make *) +let super = Js_record_map.super +let substitue_variables (map : Ident.t Map_ident.t) = { + super with ident = fun _ id -> + Map_ident.find_default map id id -let substitue_variables (map : Ident.t Map_ident.t) = - object - inherit Js_map.map - method! ident id = - Map_ident.find_default map id id - end +} (* 1. recursive value ? let rec x = 1 :: x non-terminating @@ -385320,7 +385338,9 @@ let inline_call | _ -> map, S.define_variable ~kind:Variable param arg :: acc) in if Map_ident.is_empty map then block - else (substitue_variables map) # block block + else + let obj = substitue_variables map in + obj.block obj block (** There is a side effect when traversing dead code, since we assume that substitue a node would mark a node as dead node, @@ -385347,10 +385367,10 @@ let inline_call (when we forget to recursive apply), then some code non-dead [find_beg] will be marked as dead, while it is still called *) -let subst (export_set : Set_ident.t) stats = - object (self) - inherit Js_map.map as super - method! statement st = +let super = Js_record_map.super +let subst (export_set : Set_ident.t) stats = {super with + + statement = (fun self st -> match st.statement_desc with | Variable {value = _ ; @@ -385362,18 +385382,17 @@ let subst (export_set : Set_ident.t) stats = | Variable { ident_info = {used_stats = Dead_non_pure} ; value = Some v ; _ } -> S.exp v - | _ -> super#statement st - method! variable_declaration - ({ident; value = _ ; property = _ ; ident_info = _} as v) - = + | _ -> super.statement self st ); + variable_declaration = (fun self + ({ident; value = _ ; property = _ ; ident_info = _} as v) -> (* TODO: replacement is a bit shaky, the problem is the lambda we stored is not consistent after we did some subsititution, and the dead code removal does rely on this (otherwise, when you do beta-reduction you have to regenerate names) *) - let v = super # variable_declaration v in + let v = super . variable_declaration self v in Hash_ident.add stats ident v; (* see #278 before changes *) - v - method! block bs = + v); + block = (fun self bs -> match bs with | ({statement_desc = Variable ({value = @@ -385381,17 +385400,17 @@ let subst (export_set : Set_ident.t) stats = } as vd) ; comment = _} as st) :: rest -> let is_export = Set_ident.mem export_set vd.ident in if is_export then - self#statement st :: self#block rest + self.statement self st :: self.block self rest else begin match Hash_ident.find_opt stats vd.ident with (* TODO: could be improved as [mem] *) | None -> if Js_analyzer.no_side_effect_expression v - then S.exp v :: self#block rest - else self#block rest + then S.exp v :: self.block self rest + else self.block self rest - | Some _ -> self#statement st :: self#block rest + | Some _ -> self.statement self st :: self.block self rest end | [{statement_desc = @@ -385414,7 +385433,7 @@ let subst (export_set : Set_ident.t) stats = -> Js_op_util.update_used_stats v.ident_info Dead_pure; let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks (* Ext_list.fold_right2 params args processed_blocks @@ -385425,7 +385444,7 @@ let subst (export_set : Set_ident.t) stats = *) | (None | Some _) -> - [self#statement st ] + [self.statement self st ] end | [{statement_desc = @@ -385435,22 +385454,23 @@ let subst (export_set : Set_ident.t) stats = when Ext_list.same_length params args -> let no_tailcall = Js_fun_env.no_tailcall env in - let processed_blocks = ( self#block block) (* see #278 before changes*) in + let processed_blocks = ( self.block self block) (* see #278 before changes*) in inline_call no_tailcall params args processed_blocks | x :: xs -> - self#statement x :: self#block xs + self.statement self x :: self.block self xs | [] -> [] - - end + ) +} let tailcall_inline (program : J.program) = let stats = Js_pass_get_used.get_stats program in let export_set = program.export_set in - (subst export_set stats )#program program + let obj = (subst export_set stats ) in + obj.program obj program diff --git a/lib/4.06.1/whole_compiler.ml.d b/lib/4.06.1/whole_compiler.ml.d index 4f56853e25..2f83a8c74f 100644 --- a/lib/4.06.1/whole_compiler.ml.d +++ b/lib/4.06.1/whole_compiler.ml.d @@ -194,10 +194,8 @@ ../lib/4.06.1/whole_compiler.ml: ./core/js_fun_env.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_implementation.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_implementation.mli -../lib/4.06.1/whole_compiler.ml: ./core/js_iter.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_long.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_long.mli -../lib/4.06.1/whole_compiler.ml: ./core/js_map.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_name_of_module_id.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_name_of_module_id.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_number.ml @@ -236,6 +234,8 @@ ../lib/4.06.1/whole_compiler.ml: ./core/js_pass_tailcall_inline.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_pass_tailcall_inline.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_raw_info.ml +../lib/4.06.1/whole_compiler.ml: ./core/js_record_iter.ml +../lib/4.06.1/whole_compiler.ml: ./core/js_record_map.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_shake.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_shake.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_stmt_make.ml diff --git a/ocaml-tree/record_iter.js b/ocaml-tree/record_iter.js new file mode 100644 index 0000000000..77a9c1a67a --- /dev/null +++ b/ocaml-tree/record_iter.js @@ -0,0 +1,210 @@ +//@ts-check +var assert = require("assert"); +var node_types = require("./node_types"); +var init = node_types.init; +/** + * + * @typedef {import('./node_types').Node} Node + */ + +/** + * + * @param {{name:string, def:Node}} typedef + * @param {Set} allNames + * @returns {string} + */ +function mkMethod({ name, def }, allNames) { + return ` ${name} : ${name} fn = ( ${mkBody(def, allNames)} ) `; +} + +var skip = `unknown`; + +/** + * @param {Node} def + * @param {Set} allNames + */ +function mkBody(def, allNames) { + // @ts-ignore + assert(def !== undefined); + switch (def.type) { + case "type_constructor_path": + case "constructed_type": + case "tuple_type": + return mkStructuralTy(def, allNames).eta; + case "record_declaration": + var len = def.children.length; + var args = init(len, (i) => `_x${i}`); + var pat_exp = init(len, (i) => { + return `${def.children[i].mainText} = ${args[i]}`; + }); + + /** + * @type {string[]} + */ + var body = args + .map((x, i) => { + var ty = def.children[i].children[1]; + return mkBodyApply(ty, allNames, x); + }) + .filter(Boolean); + return `fun _self { ${pat_exp.join(";")}} -> begin ${body.join(";")} end`; + case "variant_declaration": + var len = def.children.length; + var branches = def.children.map((branch) => mkBranch(branch, allNames)); + return `fun _self -> function \n| ${branches.join("\n|")}`; + default: + throw new Error(`unkonwn ${def.type}`); + } +} + +var skip_obj = { + eta: skip, + /** + * + * @param {string} x + */ + beta(x) { + return `${skip} ${x}`; + }, +}; + +/** + * + * + * @param {Node} def + * @param {Set} allNames + * The code fragments should have two operations + * - eta-expanded + * needed due to `self` is missing + * @typedef {typeof skip_obj} Obj + * @returns {Obj} + */ +function mkStructuralTy(def, allNames) { + switch (def.type) { + case "type_constructor_path": + var basic = node_types.isSupported(def, allNames); + if (basic !== undefined) { + var code = `_self.${basic}`; + return { + eta: `(fun _self arg -> ${code} _self arg)`, + beta(x) { + return `${code} _self ${x}`; + }, + }; + } + return skip_obj; + case "constructed_type": + // FIXME + var [list, base] = [...def.children].reverse(); + switch (list.text) { + case "option": + case "list": + var inner = mkStructuralTy(base, allNames); + if (inner === skip_obj) { + return skip_obj; + } + // return `${list.text} (${inner})`; + return { + eta: `fun _self arg -> ${list.text} (${inner.eta}) _self arg`, + beta(x) { + return `${list.text} (${inner.eta}) _self ${x}`; + }, + }; + default: + throw new Error(`unsupported high order type ${list.text}`); + } + case "tuple_type": + var len = def.children.length; + var args = init(len, (i) => `_x${i}`); + var body = args + .map((x, i) => mkBodyApply(def.children[i], allNames, x)) + .filter(Boolean); + var snippet = `(${args.join(",")}) -> begin ${body.join(";")} end`; + return { + eta: `(fun _self ${snippet})`, + beta(x) { + return `(fun ${snippet}) ${x}`; // TODO: could be inlined futher + }, + }; + default: + throw new Error(`unsupported structural type ${def.type}`); + } +} +/** + * + * @param {Node} ty + * @param {Set} allNames + * @param {string} arg + */ +function mkBodyApply(ty, allNames, arg) { + var fn = mkStructuralTy(ty, allNames); + if (fn === skip_obj) { + return ``; + } + return fn.beta(arg); +} + +/** + * + * @param {Node} branch + * branch is constructor_declaration + * @param {Set} allNames + * @returns {string} + */ +function mkBranch(branch, allNames) { + // @ts-ignore + assert(branch?.type === "constructor_declaration"); + var [{ text }, ...rest] = branch.children; + // TODO: add inline record support + var len = rest.length; + if (len === 0) { + return `${text} -> ()`; + } + var args = init(len, (i) => `_x${i}`); + var pat_exp = `${text} ( ${args.join(",")}) `; + var body = args + .map((x, i) => { + var ty = rest[i]; + return mkBodyApply(ty, allNames, x); + }) + .filter(Boolean); + if (body.length === 0) { + return `${text} _ -> ()`; + } + return `${pat_exp} -> \n begin ${body.join(";")} end`; +} + +/** + * + * @param {{name : string, def: Node}[]} typedefs + * @returns {string} + */ +function make(typedefs) { + var customNames = [...new Set([...typedefs.map((x) => x.name)])]; + var allNames = new Set(customNames.concat(["option", "list"])); + var output = typedefs.map((x) => mkMethod(x, allNames)); + var o = ` + open J + let unknown _ _ = () + let option sub self = fun v -> + match v with + | None -> () + | Some v -> sub self v + let rec list sub self = fun x -> + match x with + | [] -> () + | x::xs -> + sub self x ; + list sub self xs + + type iter = { + ${customNames.map((x) => `${x} : ${x} fn`).join(";\n")} + } + and 'a fn = iter -> 'a -> unit + let iter : iter = { + ${output.join(";\n")} + } + `; + return o; +} +exports.make = make; diff --git a/ocaml-tree/record_map.js b/ocaml-tree/record_map.js new file mode 100644 index 0000000000..8868d52b85 --- /dev/null +++ b/ocaml-tree/record_map.js @@ -0,0 +1,212 @@ +//@ts-check +var assert = require("assert"); +var node_types = require("./node_types"); +var init = node_types.init; +/** + * + * @typedef {import('./node_types').Node} Node + */ + +/** + * + * @param {{name:string, def:Node}} typedef + * @param {Set} allNames + * @returns {string} + */ +function mkMethod({ name, def }, allNames) { + return ` ${name} : ${name} fn = ( ${mkBody(def, allNames)} ) `; +} + +var skip = `unknown`; + +/** + * @param {Node} def + * @param {Set} allNames + */ +function mkBody(def, allNames) { + // @ts-ignore + assert(def !== undefined); + switch (def.type) { + case "type_constructor_path": + case "constructed_type": + case "tuple_type": + return mkStructuralTy(def, allNames).eta; + case "record_declaration": + var len = def.children.length; + var args = init(len, (i) => `_x${i}`); + var pat_exp = init(len, (i) => { + return `${def.children[i].mainText} = ${args[i]}`; + }); + + /** + * @type {string[]} + */ + var body = args + .map((x, i) => { + var ty = def.children[i].children[1]; + return mkBodyApply(ty, allNames, x); + }) + .filter(Boolean); + return `fun _self { ${pat_exp.join(";")}} -> begin ${body.join( + "\n" + )} {${pat_exp.join(";")}} end`; + case "variant_declaration": + var len = def.children.length; + var branches = def.children.map((branch) => mkBranch(branch, allNames)); + return `fun _self -> function \n| ${branches.join("\n|")}`; + default: + throw new Error(`unkonwn ${def.type}`); + } +} + +var skip_obj = { + eta: skip, + /** + * + * @param {string} x + */ + beta(x) { + return `${skip} ${x}`; + }, +}; + +/** + * + * + * @param {Node} def + * @param {Set} allNames + * The code fragments should have two operations + * - eta-expanded + * needed due to `self` is missing + * @typedef {typeof skip_obj} Obj + * @returns {Obj} + */ +function mkStructuralTy(def, allNames) { + switch (def.type) { + case "type_constructor_path": + var basic = node_types.isSupported(def, allNames); + if (basic !== undefined) { + var code = `_self.${basic}`; + return { + eta: `(fun _self arg -> ${code} _self arg)`, + beta(x) { + return `let ${x} = ${code} _self ${x} in `; + }, + }; + } + return skip_obj; + case "constructed_type": + // FIXME + var [list, base] = [...def.children].reverse(); + switch (list.text) { + case "option": + case "list": + var inner = mkStructuralTy(base, allNames); + if (inner === skip_obj) { + return skip_obj; + } + // return `${list.text} (${inner})`; + return { + eta: `fun _self arg -> ${list.text} (${inner.eta}) _self arg`, + beta(x) { + return `let ${x} = ${list.text} (${inner.eta}) _self ${x} in `; + }, + }; + default: + throw new Error(`unsupported high order type ${list.text}`); + } + case "tuple_type": + var len = def.children.length; + var args = init(len, (i) => `_x${i}`); + var body = args + .map((x, i) => mkBodyApply(def.children[i], allNames, x)) + .filter(Boolean); + var snippet = `(${args.join(",")}) -> begin ${body.join(" ")} (${args.join(",")}) end`; + return { + eta: `(fun _self ${snippet})`, + beta(x) { + return `let ${x} = (fun ${snippet}) ${x} in`; // TODO: could be inlined futher + }, + }; + default: + throw new Error(`unsupported structural type ${def.type}`); + } +} +/** + * + * @param {Node} ty + * @param {Set} allNames + * @param {string} arg + */ +function mkBodyApply(ty, allNames, arg) { + var fn = mkStructuralTy(ty, allNames); + if (fn === skip_obj) { + return ``; + } + return fn.beta(arg); +} + +/** + * + * @param {Node} branch + * branch is constructor_declaration + * @param {Set} allNames + * @returns {string} + */ +function mkBranch(branch, allNames) { + // @ts-ignore + assert(branch?.type === "constructor_declaration"); + var [{ text }, ...rest] = branch.children; + // TODO: add inline record support + var len = rest.length; + if (len === 0) { + return `${text} as v -> v`; + } + var args = init(len, (i) => `_x${i}`); + var pat_exp = `${text} ( ${args.join(",")}) `; + var body = args + .map((x, i) => { + var ty = rest[i]; + return mkBodyApply(ty, allNames, x); + }) + .filter(Boolean); + if (body.length === 0) { + return `${text} _ as v -> v`; + } + return `${pat_exp} -> \n begin ${body.join("\n")} ${pat_exp} end`; +} + +/** + * + * @param {{name : string, def: Node}[]} typedefs + * @returns {string} + */ +function make(typedefs) { + var customNames = [...new Set([...typedefs.map((x) => x.name)])]; + var allNames = new Set(customNames.concat(["option", "list"])); + var output = typedefs.map((x) => mkMethod(x, allNames)); + var o = ` + open J + let [@inline] unknown _ x = x + let option sub self = fun v -> + match v with + | None -> None + | Some v -> Some (sub self v) + let rec list sub self = fun x -> + match x with + | [] -> [] + | x::xs -> + let v = sub self x in + v ::list sub self xs + + type iter = { + ${customNames.map((x) => `${x} : ${x} fn`).join(";\n")} + } + and 'a fn = iter -> 'a -> 'a + let super : iter = { + ${output.join(";\n")} + } + `; + return o; +} +exports.make = make; diff --git a/ocaml-tree/test.js b/ocaml-tree/test.js index 768fd7c6ef..6849037898 100644 --- a/ocaml-tree/test.js +++ b/ocaml-tree/test.js @@ -62,12 +62,14 @@ var y = p.parse(fs.readFileSync(path.join(j_dir, "j.ml"), "utf8")); */ var typedefs = getTypedefs(y); - var map_maker = require("./map_maker"); var fold_maker = require("./fold_maker"); var iter_maker = require("./iter_maker"); var fold = fold_maker.make(typedefs); var map = map_maker.make(typedefs); var iter = iter_maker.make(typedefs); +var record_iter = require("./record_iter"); +var record_map = require("./record_map"); +var riter = record_map.make(typedefs); // console.log(fold, map); -fs.writeFileSync(path.join(j_dir, "js_iter.ml"), iter, "utf8"); +fs.writeFileSync(path.join(j_dir, "js_record_map.ml"), riter, "utf8");